packages feed

core-program 0.4.6.4 → 0.5.0.1

raw patch · 10 files changed

+400/−142 lines, 10 filesdep −chronologiquedep ~core-datadep ~core-textPVP ok

version bump matches the API change (PVP)

Dependencies removed: chronologique

Dependency ranges changed: core-data, core-text

API changes (from Hackage documentation)

- Core.Program: Boom :: Boom
- Core.Program: data Boom
- Core.Program.Execute: catchesAsync :: (MonadCatch m, MonadThrow m) => m a -> [Handler m a] -> m a
- Core.Program.Execute: tryAsync :: (MonadCatch m, Exception e) => m a -> m (Either e a)
- Core.System.Base: bracket :: MonadMask m => m a -> (a -> m b) -> (a -> m c) -> m c
- Core.System.Base: catch :: (MonadCatch m, Exception e) => m a -> (e -> m a) -> m a
- Core.System.Base: finally :: MonadMask m => m a -> m b -> m a
- Core.System.Base: impureThrow :: Exception e => e -> a
- Core.System.Base: throw :: (MonadThrow m, Exception e) => e -> m a
- Core.System.External: TimeStamp :: Int64 -> TimeStamp
- Core.System.External: [unTimeStamp] :: TimeStamp -> Int64
- Core.System.External: getCurrentTimeNanoseconds :: IO TimeStamp
- Core.System.External: newtype TimeStamp
+ Core.Program.Exceptions: Boom :: Boom
+ Core.Program.Exceptions: bracket :: Program τ ρ -> (ρ -> Program τ γ) -> (ρ -> Program τ α) -> Program τ α
+ Core.Program.Exceptions: catch :: Exception ε => Program τ α -> (ε -> Program τ α) -> Program τ α
+ Core.Program.Exceptions: data Boom
+ Core.Program.Exceptions: finally :: Program τ α -> Program τ γ -> Program τ α
+ Core.Program.Exceptions: instance GHC.Exception.Type.Exception Core.Program.Exceptions.Boom
+ Core.Program.Exceptions: instance GHC.Show.Show Core.Program.Exceptions.Boom
+ Core.Program.Exceptions: onException :: Program τ α -> Program τ γ -> Program τ α
+ Core.Program.Exceptions: throw :: Exception ε => ε -> Program τ α
+ Core.Program.Exceptions: try :: Exception ε => Program τ α -> Program τ (Either ε α)
- Core.Program: Context :: MVar Rope -> Int -> Bool -> Version -> Config -> [Exporter] -> Parameters -> MVar ExitCode -> MVar TimeStamp -> MVar Verbosity -> TQueue (Maybe Rope) -> TQueue (Maybe Datum) -> Maybe Forwarder -> MVar Datum -> MVar τ -> Context τ
+ Core.Program: Context :: MVar Rope -> Int -> Bool -> Version -> Config -> [Exporter] -> Parameters -> MVar ExitCode -> MVar Time -> MVar Verbosity -> TQueue (Maybe Rope) -> TQueue (Maybe Datum) -> Maybe Forwarder -> MVar Datum -> MVar τ -> Context τ
- Core.Program: Datum :: Maybe Span -> Rope -> Maybe Rope -> TimeStamp -> Maybe Trace -> Maybe Span -> Maybe Int64 -> Map JsonKey JsonValue -> Datum
+ Core.Program: Datum :: Maybe Span -> Rope -> Maybe Rope -> Time -> Maybe Trace -> Maybe Span -> Maybe Int64 -> Map JsonKey JsonValue -> Datum
- Core.Program: [$sel:spanTimeFrom:Datum] :: Datum -> TimeStamp
+ Core.Program: [$sel:spanTimeFrom:Datum] :: Datum -> Time
- Core.Program: [$sel:startTimeFrom:Context] :: Context τ -> MVar TimeStamp
+ Core.Program: [$sel:startTimeFrom:Context] :: Context τ -> MVar Time
- Core.Program.Execute: catch :: (MonadCatch m, Exception e) => m a -> (e -> m a) -> m a
+ Core.Program.Execute: catch :: Exception ε => Program τ α -> (ε -> Program τ α) -> Program τ α
- Core.Program.Execute: throw :: (MonadThrow m, Exception e) => e -> m a
+ Core.Program.Execute: throw :: Exception ε => ε -> Program τ α
- Core.Program.Execute: try :: (MonadCatch m, Exception e) => m a -> m (Either e a)
+ Core.Program.Execute: try :: Exception ε => Program τ α -> Program τ (Either ε α)

Files

core-program.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           core-program-version:        0.4.6.4+version:        0.5.0.1 synopsis:       Opinionated Haskell Interoperability description:    A library to help build command-line programs, both tools and                 longer-running daemons.@@ -27,7 +27,7 @@ license-file:   LICENSE build-type:     Simple tested-with:-    GHC == 8.10.7+    GHC == 8.10.7, GHC == 9.2.2  source-repository head   type: git@@ -39,6 +39,7 @@       Core.Program.Arguments       Core.Program.Context       Core.Program.Execute+      Core.Program.Exceptions       Core.Program.Logging       Core.Program.Metadata       Core.Program.Notify@@ -57,9 +58,8 @@       async     , base >=4.11 && <5     , bytestring-    , chronologique-    , core-data >=0.3.2.2-    , core-text >=0.3.7.0+    , core-data >=0.3.3+    , core-text >=0.3.7     , directory     , exceptions     , filepath
lib/Core/Program.hs view
@@ -24,6 +24,7 @@     module Core.Program.Threads,     module Core.Program.Unlift,     module Core.Program.Metadata,+    module Core.Program.Exceptions,      -- * Command-line argument parsing @@ -48,9 +49,10 @@ where  import Core.Program.Arguments+import Core.Program.Context+import Core.Program.Exceptions import Core.Program.Execute import Core.Program.Logging-import Core.Program.Context import Core.Program.Metadata import Core.Program.Notify import Core.Program.Threads
lib/Core/Program/Context.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}@@ -34,32 +35,31 @@     getContext,     fmapContext,     subProgram,-    Boom (..), ) where -import Chrono.TimeStamp (TimeStamp, getCurrentTimeNanoseconds) import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, readMVar) import Control.Concurrent.STM.TQueue (TQueue, newTQueueIO)-import qualified Control.Exception.Safe as Safe (throw)+import Control.Exception.Safe qualified as Safe (throw) import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow (throwM)) import Control.Monad.Reader.Class (MonadReader (..)) import Control.Monad.Trans.Reader (ReaderT (..))+import Core.Data.Clock import Core.Data.Structures import Core.Encoding.Json import Core.Program.Arguments import Core.Program.Metadata-import Core.System.Base hiding (catch, throw)+import Core.System.Base import Core.Text.Rope import Data.Foldable (foldrM)-import System.IO (hIsTerminalDevice) import Data.Int (Int64) import Data.String (IsString) import Prettyprinter (LayoutOptions (..), PageWidth (..), layoutPretty) import Prettyprinter.Render.Text (renderIO)-import qualified System.Console.Terminal.Size as Terminal (Window (..), size)+import System.Console.Terminal.Size qualified as Terminal (Window (..), size) import System.Environment (getArgs, getProgName, lookupEnv) import System.Exit (ExitCode (..), exitWith)-import qualified System.Posix.Process as Posix (exitImmediately)+import System.IO (hIsTerminalDevice)+import System.Posix.Process qualified as Posix (exitImmediately) import Prelude hiding (log)  {- |@@ -75,7 +75,7 @@     { spanIdentifierFrom :: Maybe Span     , spanNameFrom :: Rope     , serviceNameFrom :: Maybe Rope-    , spanTimeFrom :: TimeStamp+    , spanTimeFrom :: Time     , traceIdentifierFrom :: Maybe Trace     , parentIdentifierFrom :: Maybe Span     , durationFrom :: Maybe Int64@@ -89,7 +89,7 @@         { spanIdentifierFrom = Nothing         , spanNameFrom = emptyRope         , serviceNameFrom = Nothing-        , spanTimeFrom = 0+        , spanTimeFrom = epochTime         , traceIdentifierFrom = Nothing         , parentIdentifierFrom = Nothing         , durationFrom = Nothing@@ -162,25 +162,19 @@ -- that field name as a local variable name. -- data Context τ = Context-    { -- runtime properties-      programNameFrom :: MVar Rope+    { programNameFrom :: MVar Rope     , terminalWidthFrom :: Int     , terminalColouredFrom :: Bool     , versionFrom :: Version-    , -- only used during initial setup-      initialConfigFrom :: Config+    , initialConfigFrom :: Config -- only used during initial setup     , initialExportersFrom :: [Exporter]-    , -- derived at startup-      commandLineFrom :: Parameters-    , -- operational state-      exitSemaphoreFrom :: MVar ExitCode-    , startTimeFrom :: MVar TimeStamp+    , commandLineFrom :: Parameters -- derived at startup+    , exitSemaphoreFrom :: MVar ExitCode+    , startTimeFrom :: MVar Time     , verbosityLevelFrom :: MVar Verbosity-    , -- communication channels-      outputChannelFrom :: TQueue (Maybe Rope)-    , telemetryChannelFrom :: TQueue (Maybe Datum)-    , -- machinery for telemetry-      telemetryForwarderFrom :: Maybe Forwarder+    , outputChannelFrom :: TQueue (Maybe Rope) -- communication channels+    , telemetryChannelFrom :: TQueue (Maybe Datum) -- machinery for telemetry+    , telemetryForwarderFrom :: Maybe Forwarder     , currentDatumFrom :: MVar Datum     , applicationDataFrom :: MVar τ     }@@ -398,13 +392,11 @@             Nothing -> 80     return columns - getConsoleColoured :: IO Bool getConsoleColoured = do     terminal <- hIsTerminalDevice stdout     pure terminal - {- | Process the command line options and arguments. If an invalid option is encountered or a [mandatory] argument is missing, then the program will@@ -536,22 +528,3 @@         case target == codenameFrom exporter of             False -> lookupExporter target exporters             True -> Just exporter--{- |-A utility exception for those occasions when you just need to go "boom".--@-    case 'Core.Data.Structures.containsKey' \"James Bond\" agents of-        False -> do-            evilPlan-        True ->  do-            'Core.Program.Logging.write' \"No Mr Bond, I expect you to die!\"-            'Core.System.Base.throw' 'Boom'-@--@since 0.3.2--}-data Boom = Boom-    deriving (Show)--instance Exception Boom
+ lib/Core/Program/Exceptions.hs view
@@ -0,0 +1,289 @@+{-# LANGUAGE ImportQualifiedPost #-}++{- |+Facilities for handling exceptions.++The Haskell language itself doesn't treat exceptions specially, but the+Haskell /runtime/ does. Any I/O action can result in exceptions being thrown+and frequently do. Developers can define exceptions too, and use them to+signal anomolies.++In order to catch an exception you need to know the /type/ of that exception.+The way this is typically done is with the @ScopedTypeVariables@ extension+turned on and then adding a type annotation around the @e@ variable in the+lambda passed to 'catch'.++@+    'catch'+        (do+            performSong \"This is my party and I\'ll cry if I want to\"+        )+        (\\(e :: FirstWorldProblem) -> do+            'Core.Program.Logging.critical' \"Someone is crying\"+            'Core.Program.Logging.debug' "e" ('Control.Exception.displayException' e)+            'Core.Program.Execute.terminate' 1+        )+@++which would work on the assumption that somewhere you have defined:++@+data FirstWorldProblem+    = PersonCrying+    | MyToastIsBurnt+    | SomeoneWrongOnInternet 'Core.Text.Rope'+    deriving 'Show'++instance 'Control.Exception.Exception' FirstWorldProblem+@++and that the @performSong@ function at some point does something like:++@+performSong :: Lyrics -> 'Program' 'Core.Program.Execute.None' ()+performSong lyrics = do+    ...+    'throw' PersonCrying+@++Keep in mind that exceptions are really for signalling failure and aren't+generally that recoverable. Their utility is that they unwind the call stack+from the point that failure occurs and get you back to somewhere you can+handle it, but in Haskell \"handling it\" really just means that you log the+problem and either go on to processing the next request or then outright+terminate the program.++Thus a good pattern for using exceptions effectively is to use small blocks of+pure code which can fail in the type 'Either' 'Core.Text.Rope' @a@, then+pattern matching on what you get back: if you get a 'Left' back then you+'throw' an exception, otherwise you return the value with 'pure' and continue:++@+    result <- case calculateInterestingThing inputs of+        'Left' problem -> 'throw' (SomeoneWrongOnInternet problem)+        'Right' value -> 'pure' value+    ...+@++this works rather nicely especially when you're doing lots of parsing; small+things that can fail but it's all pure code. In conjunction with the 'Either'+monad you can quickly work through getting the values you need knowing it will+fail fast if something goes wrong and you can get an appropriate error message+back to the surface (in our case the 'Program' @τ@ monad) and you can 'throw'+from there.+-}+module Core.Program.Exceptions (+    catch,+    try,+    throw,+    bracket,+    finally,+    onException,+    Boom (..),+) where++import Control.Exception qualified as Base (+    Exception,+ )+import Control.Exception.Safe qualified as Safe (+    bracket,+    catch,+    finally,+    onException,+    throw,+    try,+ )+import Core.Program.Context (+    Program,+ )++{- |+Catch an exception.++Some care must be taken. Remember that even though it is constrained by the+'Control.Exception.Exception' typeclass, @ε@ does /not/ stand for \"any\"+exception type; is has a concrete type when it gets to being used in your+code. Things are fairly straight-forward if you know exactly the exception you+are looking for:++@+    'catch'+        action+        (\\(e :: FirstWorldProblem) -> do+            ...+        )+@++but more awkward when you don't.++If you just need to catch all exceptions, the pattern for that is as follows:++@+    'catch'+        action+        (\\(e :: 'Control.Exception.SomeException') -> do+            ...+        )+@++The 'Control.Exception.SomeException' type is the root type of all exceptions;+or rather, all types that have an instance of 'Control.Exception.Exception'+can be converted into this root type. Thus you /can/ catch all synchronous+exceptions but you can't tell which type of exception it was originally; you+rely on the 'Show' instance (which is the default that+'Control.Exception.displayException' falls back to) to display a message which+will hopefully be of enough utility to figure out what the problem is. In+fairness it usually is. (This all seems a bit of a deficiency in the+underlying exception machinery but it's what we have)++This 'catch' function will /not/ catch asynchonous exceptions. If you need to+do that, see the more comprehensive exception handling facilities offered by+__safe-exceptions__, which in turn builds on __exceptions__ and __base__).+Note that 'Program' implements 'Control.Monad.Catch.MonadCatch' so you can use+the full power available there if required.++@since 0.5.0+-}+catch :: Base.Exception ε => Program τ α -> (ε -> Program τ α) -> Program τ α+catch = Safe.catch++{- |+Catch an exception. Instead of handling an exception in a supplied function,+however, return from executing the sub-program with the outcome in an+'Either', with the exception being on the 'Left' side if one is thrown. If the+sub-program completes normally its result is in the 'Right' side.++(this is a wrapper around calling __safe-exceptions__\'s+'Control.Exceptions.Safe.try' function, which in turn wraps __exceptions__\'s+'Control.Exceptions.try', which...)++@since 0.5.0+-}+try :: Base.Exception ε => Program τ α -> Program τ (Either ε α)+try = Safe.try++{- |+Throw an exception.++This will be thrown as a normal synchronous exception that can be caught with+'catch' or 'try' above.++Don't try and use this from pure code! A common temptation is to be in the+middle of a computation, hit a problem, and think \"oh, that's bad. I guess+I'll throw an exception!\". You /can\'t/. Surface the problem back to the I/O+level code that 'Program' @τ@ monad provides, and /then/ you can throw an+exception if appropriate.++When you /do/ throw an exception, we recommend you go to some trouble to make+sure that the string or otherwise descriptive message is unique in your+codebase. If you do so then when the problem arises you will be able to+quickly search for that string and find the place where the exception arose+from, even without the benefit of stack traces. For example,++@+    'throw' (SomeoneWrongOnInternet \"Ashley thinks there are more than three Star Wars movies\")+@++which will get you a nice crash message as your world falls down around you:++@+22:54:39Z (00.002) SomeoneWrongOnInternet \"Ashley thinks there are more than three Star Wars movies\"+$+@++but if you're in a hurry and don't want to define a local exception type to+use,++@+    'throw' 'Boom'+@++will work.++(experienced users will note that 'Program' implements+'Control.Monad.Catch.MonadThrow' and as such this is just a wrapper around+calling __safe-exceptions__'s 'Control.Exceptions.Safe.throw' function)++@since 0.5.0+-}+throw :: Base.Exception ε => ε -> Program τ α+throw = Safe.throw++{- |+Acquire a resource, use it, then release it back.++The bracket pattern is common in Haskell for getting a resource @ρ@ needed for+a computation, preforming that computation, then returning the resource back+to the system. Common examples are when making database connections and doing+file or network operations, where you need to make sure you "close" the+connection afterward before continuing the program so that scare resources+like file handles are released.++Typically you have an open and close action that return and take a resource+respectively, so you can use those directly, and use a lambda in the third+action to actally get at the resource and do something with it when you need+it:++@+    'bracket'+        (openConnection)+        (closeConnection)+        (\c -> do+            this+            thatAndNow+            theOtherThingThatNeeds c+        )+@++Note that 'bracket' does /not/ catch the exception if one is thrown! The+finalizer will run, but then the exception will continue to propogate its way+out of your program's call stack. Note also that the result of the cleanup+action @γ@ is ignored (it can be @()@ or anythign else; it will be discarded).++@since 0.5.0+-}+bracket :: Program τ ρ -> (ρ -> Program τ γ) -> (ρ -> Program τ α) -> Program τ α+bracket = Safe.bracket++{- |+Run an action and then, run a finalizer afterwards. The second action will run+whether or not an exception was raised by the first one. This is like+'bracket' above, but can be used when you know you have cleanup steps to take+after your computation which /do/ have to be run even if (especially if!) an+exception is thrown but that that cleanup doesn't depend on the result of that+computation or the resources used to do it. The return value @γ@ of the+subsequent action is ignored.++@since 0.5.0+-}+finally :: Program τ α -> Program τ γ -> Program τ α+finally = Safe.finally++{- |+Run an action and then, if an exception was raised (and only if an exception+was raised), run the second action. The return value @γ@ of the subsequent+action is is ignored.++@since 0.5.0+-}+onException :: Program τ α -> Program τ γ -> Program τ α+onException = Safe.onException++{- |+A utility exception for those occasions when you just need to go "boom".++@+    case 'Core.Data.Structures.containsKey' \"James Bond\" agents of+        'False' -> do+            evilPlan+        'True' ->  do+            'Core.Program.Logging.write' \"No Mr Bond, I expect you to die!\"+            'throw' 'Boom'+@++@since 0.3.2+-}+data Boom = Boom+    deriving (Show)++instance Base.Exception Boom
lib/Core/Program/Execute.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}@@ -83,12 +84,10 @@     resetTimer,     trap_, -    -- * Re-exports from safe-exports-    Safe.catch,-    Safe.catchesAsync,-    Safe.throw,-    Safe.try,-    Safe.tryAsync,+    -- * Exception handling+    catch,+    throw,+    try,      -- * Internals     Context,@@ -104,12 +103,11 @@     lookupEnvironmentValue, ) where -import Chrono.TimeStamp (getCurrentTimeNanoseconds) import Control.Concurrent (threadDelay) import Control.Concurrent.Async (     ExceptionInLinkedThread (..),  )-import qualified Control.Concurrent.Async as Async (+import Control.Concurrent.Async qualified as Async (     async,     cancel,     race,@@ -132,32 +130,46 @@     unGetTQueue,     writeTQueue,  )-import qualified Control.Exception as Base (throwIO)-import qualified Control.Exception.Safe as Safe (catch, catchesAsync, throw, try, tryAsync)+import Control.Exception qualified as Base (throwIO)+import Control.Exception.Safe qualified as Safe (+    catch,+    catchesAsync,+    throw,+ ) import Control.Monad (     void,     when,  ) import Control.Monad.Catch (Handler (..)) import Control.Monad.Reader.Class (MonadReader (ask))+import Core.Data.Clock import Core.Data.Structures import Core.Program.Arguments import Core.Program.Context+import Core.Program.Exceptions import Core.Program.Logging import Core.Program.Signal-import Core.System.Base+import Core.System.Base (+    Exception,+    Handle,+    SomeException,+    displayException,+    hFlush,+    liftIO,+    stdout,+ ) import Core.Text.Bytes import Core.Text.Rope-import qualified Data.ByteString as B (hPut)-import qualified Data.ByteString.Char8 as C (singleton)-import qualified Data.List as List (intersperse)+import Data.ByteString qualified as B (hPut)+import Data.ByteString.Char8 qualified as C (singleton)+import Data.List qualified as List (intersperse) import GHC.Conc (getNumProcessors, numCapabilities, setNumCapabilities) import GHC.IO.Encoding (setLocaleEncoding, utf8) import System.Directory (     findExecutable,  ) import System.Exit (ExitCode (..))-import qualified System.Posix.Process as Posix (exitImmediately)+import System.Posix.Process qualified as Posix (exitImmediately) import System.Process.Typed (closed, proc, readProcess, setStdin) import Prelude hiding (log) @@ -397,7 +409,7 @@         -- handle it and loop         Just items -> do             start <- getCurrentTimeNanoseconds-            catch+            Safe.catch                 ( do                     action (reverse items)                     reportStatus start (length items)@@ -550,7 +562,7 @@ 'setApplicationState'.  @-    state <- getApplicationState+    settings <- 'getApplicationState' @ -} getApplicationState :: Program τ τ@@ -564,8 +576,8 @@ Update the user supplied top-level application state.  @-    let state' = state { answer = 42 }-    setApplicationState state'+    let settings' = settings { answer = 42 }+    'setApplicationState' settings' @ -} setApplicationState :: τ -> Program τ ()@@ -648,7 +660,7 @@                 findExecutable cmd'             case probe of                 Nothing -> do-                    throw (CommandNotFound cmd)+                    Safe.throw (CommandNotFound cmd)                 Just _ -> do                     (exit, out, err) <- liftIO $ do                         readProcess task1
lib/Core/Program/Logging.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK prune #-}@@ -147,7 +148,6 @@     isInternal, ) where -import Chrono.TimeStamp (TimeStamp (..), getCurrentTimeNanoseconds) import Control.Concurrent.MVar (readMVar) import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TQueue (writeTQueue)@@ -155,16 +155,17 @@ import Control.Monad (when) import Control.Monad.Reader.Class (MonadReader (ask)) import Data.Fixed-import Data.Hourglass (TimeFormatElem (..), timePrint)-import qualified Data.Text.Short as S (replicate)+import Data.Hourglass qualified as H (ElapsedP, TimeFormatElem (..), timePrint)+import Data.Text.Short qualified as S (replicate) +import Core.Data.Clock import Core.Program.Context import Core.System.Base import Core.Text.Colour import Core.Text.Rope import Core.Text.Utilities -data Message = Message TimeStamp Severity Rope (Maybe Rope)+data Message = Message Time Severity Rope (Maybe Rope)  data Severity     = SeverityNone@@ -193,20 +194,20 @@     atomically $ do         writeTQueue output (Just result) -formatLogMessage :: TimeStamp -> TimeStamp -> Bool -> Severity -> Rope -> Rope+formatLogMessage :: Time -> Time -> Bool -> Severity -> Rope -> Rope formatLogMessage start now coloured severity message =-    let !start' = unTimeStamp start-        !now' = unTimeStamp now+    let !start' = unTime start+        !now' = unTime now         !stampZ =-            timePrint-                [ Format_Hour-                , Format_Text ':'-                , Format_Minute-                , Format_Text ':'-                , Format_Second-                , Format_Text 'Z'+            H.timePrint+                [ H.Format_Hour+                , H.Format_Text ':'+                , H.Format_Minute+                , H.Format_Text ':'+                , H.Format_Second+                , H.Format_Text 'Z'                 ]-                now+                (fromTime now :: H.ElapsedP)          -- I hate doing math in Haskell         !elapsed = fromRational (toRational (now' - start') / 1e9) :: Fixed E3@@ -334,7 +335,7 @@ (potentially detrimentally).  @-     warn "You left the lights on again"+     'warn' "You left the lights on again" @  Warnings are worthy of note if you are looking into the behaviour of the@@ -367,7 +368,7 @@ Report an anomoly or condition critical to the ongoing health of the program.  @-     critical "Unable to do hostname lookups"      -- Yup, it was DNS. It's always DNS.+     'critical' "Unable to do hostname lookups"      -- Yup, it was DNS. It's always DNS. @  The term \"critical\" generally means the program is now in an unexpected or@@ -470,7 +471,7 @@              let columns = terminalWidthFrom context -            -- TODO take into account 22 width already consumed by timestamp+            -- TODO take into account 22 width already consumed by Time             -- TODO move render to putMessage? putMessageR?             let value = render columns thing             !value' <- evaluate value
lib/Core/Program/Threads.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}@@ -43,8 +44,8 @@     unThread, ) where -import Control.Concurrent.Async (Async, AsyncCancelled, cancel)-import qualified Control.Concurrent.Async as Async (+import Control.Concurrent.Async (Async, AsyncCancelled)+import Control.Concurrent.Async qualified as Async (     async,     cancel,     concurrently,@@ -59,7 +60,7 @@     newMVar,     readMVar,  )-import qualified Control.Exception.Safe as Safe (catch, catchAsync)+import Control.Exception.Safe qualified as Safe (catch, catchAsync, throw) import Control.Monad (     void,  )@@ -139,7 +140,7 @@                             subProgram context' $ do                                 warn "Uncaught exception in thread"                                 debug "e" text-                            throw e+                            Safe.throw e                 )          return (Thread a)@@ -167,8 +168,8 @@     Safe.catchAsync         (Async.wait a)         ( \(e :: AsyncCancelled) -> do-            cancel a-            throw e+            Async.cancel a+            Safe.throw e         )  {- |@@ -219,8 +220,8 @@             pure result         )         ( \(e :: AsyncCancelled) -> do-            cancel a-            throw e+            Async.cancel a+            Safe.throw e         )  {- |@@ -273,8 +274,8 @@             pure results         )         ( \(e :: AsyncCancelled) -> do-            mapM_ cancel as-            throw e+            mapM_ Async.cancel as+            Safe.throw e         )  {- |@@ -364,9 +365,9 @@ @     result <- 'raceThreads' one two     case result of-        Left a -> do+        'Left' a -> do             -- one finished first-        Right b -> do+        'Right' b -> do             -- two finished first @ 
lib/Core/System.hs view
@@ -1,22 +1,25 @@+{-# OPTIONS_GHC -Wno-dodgy-exports #-}+{-# OPTIONS_GHC -Wno-unused-imports #-} {-# OPTIONS_HADDOCK not-home #-} --- |--- Common elements from the rest of the Haskell ecosystem. This is mostly--- about re-exports. There are numerous types and functions that are more or--- less assumed to be in scope when you're doing much of anything in Haskell;--- this module is a convenience to pull in the ones we rely on for the rest of--- this library.------ You can just import this directly:------ @--- import "Core.System"--- @------ as there's no particular benefit to cherry-picking the various sub-modules.-module Core.System-  ( -- * Base libraries+{- |+Common elements from the rest of the Haskell ecosystem. This is mostly about+re-exports. There are numerous types and functions that are more or less+assumed to be in scope when you're doing much of anything in Haskell; this+module is a convenience to pull in the ones we rely on for the rest of this+library. +You can just import this directly:++@+import "Core.System"+@++as there's no particular benefit to cherry-picking the various sub-modules.+-}+module Core.System (+    -- * Base libraries+     -- |     -- Re-exports from foundational libraries supplied by the compiler runtime,     -- or from re-implementations of those areas.@@ -39,8 +42,7 @@     -- pretty printed. There are a large family of combinators used when doing     -- this. For convenience they are exposed here.     module Core.System.Pretty,-  )-where+) where  import Core.System.Base import Core.System.External
lib/Core/System/Base.hs view
@@ -28,26 +28,13 @@      -- * Exception handling -    -- ** from Control.Exception.Safe--    -- | Re-exported from "Control.Exception.Safe" in the __safe-exceptions__ package:     Exception (..),     SomeException,-    throw,-    impureThrow,-    bracket,-    catch,-    finally, ) where -import Control.Exception.Safe (+import Control.Exception (     Exception (..),     SomeException,-    bracket,-    catch,-    finally,-    impureThrow,-    throw,  ) import Control.Monad.IO.Class (MonadIO, liftIO) import System.IO (Handle, IOMode (..), hFlush, stderr, stdin, stdout, withFile)
lib/Core/System/External.hs view
@@ -4,13 +4,4 @@ Re-exports of dependencies from various external libraries. -} module Core.System.External (-    -- * Time--    -- ** from Chrono.TimeStamp--    -- | Re-exported from "Chrono.TimeStamp" in __chronologique__:-    TimeStamp (..),-    getCurrentTimeNanoseconds,-) where--import Chrono.TimeStamp (TimeStamp (..), getCurrentTimeNanoseconds)+    ) where