extensible-effects-concurrent 0.30.0 → 0.31.0

raw patch · 34 files changed

+641/−680 lines, 34 filesdep ~monad-controlPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: monad-control

API changes (from Hackage documentation)

Files

• ChangeLog.md +15/−0
• examples/example-2/Main.hs +3/−3
• examples/example-3/Main.hs +3/−4
• extensible-effects-concurrent.cabal +11/−11
• src/Control/Eff/Concurrent.hs +3/−7
• src/Control/Eff/Concurrent/Process/ForkIOScheduler.hs +12/−11
• src/Control/Eff/Concurrent/Process/SingleThreadedScheduler.hs +15/−12
• src/Control/Eff/Concurrent/Protocol/Broker.hs +3/−3
• src/Control/Eff/Concurrent/Protocol/CallbackServer.hs +11/−11
• src/Control/Eff/Concurrent/Protocol/EffectfulServer.hs +6/−6
• src/Control/Eff/Concurrent/Protocol/Observer/Queue.hs +9/−9
• src/Control/Eff/Concurrent/Protocol/StatefulServer.hs +4/−5
• src/Control/Eff/Concurrent/Protocol/Watchdog.hs +8/−8
• src/Control/Eff/Concurrent/SingleThreaded.hs +1/−1
• src/Control/Eff/Log.hs +9/−8
• src/Control/Eff/Log/Examples.hs +60/−62
• src/Control/Eff/Log/Handler.hs +85/−80
• src/Control/Eff/Log/MessageRenderer.hs +41/−17
• src/Control/Eff/Log/Writer.hs +65/−152
• src/Control/Eff/LogWriter/Async.hs +10/−10
• src/Control/Eff/LogWriter/Capture.hs +0/−37
• src/Control/Eff/LogWriter/Console.hs +17/−21
• src/Control/Eff/LogWriter/DebugTrace.hs +8/−8
• src/Control/Eff/LogWriter/File.hs +23/−16
• src/Control/Eff/LogWriter/IO.hs +0/−89
• src/Control/Eff/LogWriter/Rich.hs +59/−0
• src/Control/Eff/LogWriter/UDP.hs +7/−7
• src/Control/Eff/LogWriter/UnixSocket.hs +7/−7
• test/Common.hs +4/−21
• test/GenServerTests.hs +2/−2
• test/LoggingTests.hs +104/−18
• test/LoopTests.hs +5/−5
• test/ObserverTests.hs +2/−2
• test/ProcessBehaviourTestCases.hs +29/−27

@@ -1,5 +1,20 @@ # Changelog for extensible-effects-concurrent +## 0.31.0++- **Logging**+   - Fix runtime crash caused by logging+     See: [#2](https://github.com/sheyll/extensible-effects-concurrent/issues/2)            +    - Replace polymorphic `LogWriter` with+      a monomorphic one based on `IO`+    - Rename type aliases:+       - `LogsTo` -> `FilteredLogging`+       - `LogIo` -> `IoLogging`+    - Remove `Capturing` log writer+    - Remove `Capturing` log writer+    - Fix ghci log buffering issue +       [#1](https://github.com/sheyll/extensible-effects-concurrent/issues/1) +     ## 0.30.0 - Improve inline code documentation - **Supervisor:** 

@@ -89,7 +89,7 @@  type instance ToPretty (Counter, ObserverRegistry CounterChanged, SupiDupi) = PutStr "supi-counter" -instance (LogIo q) => Server SupiCounter (Processes q) where+instance (IoLogging q) => Server SupiCounter (Processes q) where    newtype instance Model SupiCounter = SupiCounterModel     ( Integer@@ -148,14 +148,14 @@     (\(SupiCounterModel (_,_,z)) -> z)     (\(SupiCounterModel (x,y,_)) z -> SupiCounterModel (x,y,z)) -spawnCounter :: (LogIo q) => Eff (Processes q) ( Endpoint SupiCounter )+spawnCounter :: (IoLogging q) => Eff (Processes q) ( Endpoint SupiCounter ) spawnCounter = startLink MkEmptySupiCounter   deriving instance Show (Pdu Counter x)  logCounterObservations-  :: (LogIo q, Typeable q)+  :: (IoLogging q, Typeable q)   => Eff (Processes q) (Endpoint (Observer CounterChanged)) logCounterObservations = startLink OCCStart 

@@ -3,17 +3,16 @@ import           Control.Eff import           Control.Eff.Log import           Control.Eff.LogWriter.File-import           Control.Eff.LogWriter.IO+import           Control.Eff.LogWriter.Rich import           Control.Eff.LogWriter.DebugTrace import           Control.Lens  main :: IO () main =   runLift-  $  withSomeLogging @(Lift IO)-  $  withFileLogWriter  "extensible-effects-concurrent-example-3.log"+  $  withFileLogging  "extensible-effects-concurrent-example-3.log" "test-app" local0 allLogMessages renderConsoleMinimalisticWide   $  addLogWriter (filteringLogWriter severeMessages (mappingLogWriter (lmMessage %~ ("traced: " <>)) (debugTraceLogWriter renderRFC5424)))-  $  modifyLogWriter (defaultIoLogWriter "example-3" local0)+  $  modifyLogWriter (richLogWriter "example-3" local0)   $  addLogWriter (filteringLogWriter severeMessages (mappingLogWriter (lmMessage %~ ("traced without timestamp: " <>)) (debugTraceLogWriter renderRFC5424)))   $  do         logEmergency "test emergencySeverity 1"

@@ -1,6 +1,6 @@ cabal-version:  2.0 name:           extensible-effects-concurrent-version:        0.30.0+version:        0.31.0 description:    Please see the README on GitHub at <https://github.com/sheyll/extensible-effects-concurrent#readme> synopsis:       Message passing concurrency as extensible-effect homepage:       https://github.com/sheyll/extensible-effects-concurrent#readme@@ -71,10 +71,9 @@                   Control.Eff.Log.Writer,                   Control.Eff.LogWriter.Async,                   Control.Eff.LogWriter.Console,-                  Control.Eff.LogWriter.Capture,                   Control.Eff.LogWriter.DebugTrace,                   Control.Eff.LogWriter.File,-                  Control.Eff.LogWriter.IO,+                  Control.Eff.LogWriter.Rich,                   Control.Eff.LogWriter.UDP,                   Control.Eff.LogWriter.UnixSocket,                   Control.Eff.Concurrent,@@ -311,24 +310,25 @@   build-depends:                 async               , base+              , containers               , data-default               , deepseq               , extensible-effects-concurrent               , extensible-effects+              , filepath+              , hostname+              , HUnit+              , lens+              , monad-control+              , pretty-types >= 0.2.3.1 && < 0.4+              , QuickCheck+              , stm               , tasty               , tasty-discover               , tasty-hunit               , text-              , containers-              , QuickCheck-              , lens-              , HUnit-              , stm               , text               , time-              , filepath-              , hostname-              , pretty-types >= 0.2.3.1 && < 0.4   default-language: Haskell2010   default-extensions:   AllowAmbiguousTypes                       , BangPatterns

@@ -38,7 +38,7 @@     module Control.Eff.Concurrent.Protocol.Observer   ,     -- * Utilities-    -- ** Logging Effect+    -- ** FilteredLogging Effect     module Control.Eff.Log   ,     -- ** Log Writer@@ -54,14 +54,11 @@     -- *** UDP     module Control.Eff.LogWriter.UDP -  , -- *** Non-IO Log Message Capturing-    module Control.Eff.LogWriter.Capture-   , -- *** "Debug.Trace"     module Control.Eff.LogWriter.DebugTrace    , -- *** Generic IO-    module Control.Eff.LogWriter.IO+    module Control.Eff.LogWriter.Rich    , -- *** Unix Domain Socket     module Control.Eff.LogWriter.UnixSocket@@ -253,11 +250,10 @@                                                 ) import           Control.Eff.Log import           Control.Eff.LogWriter.Async-import           Control.Eff.LogWriter.Capture import           Control.Eff.LogWriter.Console import           Control.Eff.LogWriter.DebugTrace import           Control.Eff.LogWriter.File-import           Control.Eff.LogWriter.IO+import           Control.Eff.LogWriter.Rich import           Control.Eff.LogWriter.UDP import           Control.Eff.LogWriter.UnixSocket import           Control.Eff.Loop

@@ -31,7 +31,6 @@                                                 ( ) import           Control.Eff.Extend import           Control.Eff.Log-import           Control.Eff.LogWriter.IO import           Control.Eff.LogWriter.Console import           Control.Eff.LogWriter.Async import           Control.Eff.Reader.Strict     as Reader@@ -119,11 +118,11 @@     return (np, pt, pct, pm, nm)   logDebug "ForkIO Scheduler info"   logDebug $ "nextPid: " <> np-  logDebug $ "process table:"+  logDebug "process table:"   traverse_ logDebug pt-  logDebug $ "process cancellation table:"+  logDebug "process cancellation table:"   traverse_ logDebug pct-  logDebug $ "process monitors:"+  logDebug "process monitors:"   traverse_ logDebug pm   logDebug $ "nextMonitorIndex: " <> nm @@ -149,7 +148,7 @@                check (   targetState == ProcessShuttingDown                       || targetState == ProcessBusyReceiving                       || targetState == ProcessIdle)-               if targetState /= ProcessShuttingDown then do+               if targetState /= ProcessShuttingDown then                 insertMonitoringReference >> pure 1                else                 processAlreadyDead >> pure 2@@ -175,7 +174,7 @@   monRefs <- readTVar (schedulerState ^. processMonitors)   catMaybes <$> traverse go (toList monRefs)  where-  go (mr, owner) = do+  go (mr, owner) =     if monitoredProcess mr == downPid      then do         let processDownMessage = ProcessDown mr reason downPid@@ -293,12 +292,14 @@ -- | Start the message passing concurrency system then execute a 'Process' on -- top of 'BaseEffects' effect. All logging is sent to standard output. defaultMain :: HasCallStack => Eff Effects () -> IO ()-defaultMain = defaultMainWithLogWriter consoleLogWriter+defaultMain e = do+  lw <- consoleLogWriter+  defaultMainWithLogWriter lw e  -- | Start the message passing concurrency system then execute a 'Process' on -- top of 'BaseEffects' effect. All logging is sent to standard output. defaultMainWithLogWriter-  :: HasCallStack => LogWriter (Lift IO) -> Eff Effects () -> IO ()+  :: HasCallStack => LogWriter -> Eff Effects () -> IO () defaultMainWithLogWriter lw =   runLift . withLogging lw . withAsyncLogWriter (1024 :: Int) . schedule @@ -555,7 +556,7 @@         >>= lift         .   atomically         .   enqueueMessageOtherProcess toPid msg-    interpretSendShutdownOrInterrupt !toPid !msg = do+    interpretSendShutdownOrInterrupt !toPid !msg =       setMyProcessState           (either (const ProcessBusySendingShutdown)                   (const ProcessBusySendingInterrupt)@@ -682,7 +683,7 @@     let addProcessId = over           lmProcessId           (maybe (Just (T.pack (show title ++ show pid))) Just)-    in  censorLogs @(Lift IO) addProcessId+    in  censorLogs addProcessId   triggerProcessLinksAndMonitors     :: ProcessId -> Interrupt 'NoRecovery -> TVar (Set ProcessId) -> Eff BaseEffects ()   triggerProcessLinksAndMonitors !pid !reason !linkSetVar = do@@ -730,7 +731,7 @@         )       )       res-    when (not (null downMessageSendResults)) $+    unless (null downMessageSendResults) $       logWarning         (  "failed to enqueue monitor down messages for: "         <> T.pack(show downMessageSendResults)

@@ -24,7 +24,6 @@ import           Control.Eff.Concurrent.Misc import           Control.Eff.Concurrent.Process import           Control.Eff.Log-import           Control.Eff.LogWriter.IO import           Control.Eff.LogWriter.Console import           Control.Lens            hiding ( (|>)                                                 , Empty@@ -112,7 +111,7 @@     toPS p =       ( p ^. processInfoTitle       , p ^. processInfoDetails-      , case (p ^. processInfoMessageQ) -- TODO get more detailed state+      , case p ^. processInfoMessageQ -- TODO get more detailed state               of           _ :<| _ -> ProcessBusy           _ -> ProcessIdle)@@ -220,9 +219,9 @@ -- -- @since 0.3.0.2 schedulePure-  :: Eff (Processes '[Logs, LogWriterReader Logs]) a+  :: Eff (Processes PureBaseEffects) a   -> Either (Interrupt 'NoRecovery) a-schedulePure e = run (scheduleM (withSomeLogging @Logs) (return ()) e)+schedulePure e = run (scheduleM withoutLogging (return ()) e)  -- | Invoke 'scheduleM' with @lift 'Control.Concurrent.yield'@ as yield effect. -- @scheduleIO runEff == 'scheduleM' (runLift . runEff) (liftIO 'yield')@@@ -256,7 +255,7 @@ -- @since 0.4.0.0 scheduleIOWithLogging   :: HasCallStack-  => LogWriter (Lift IO)+  => LogWriter   -> Eff EffectsIo a   -> IO (Either (Interrupt 'NoRecovery) a) scheduleIOWithLogging h = scheduleIO (withLogging h)@@ -600,17 +599,21 @@ -- -- To use another 'LogWriter' use 'defaultMainWithLogWriter' instead. defaultMain :: HasCallStack => Eff EffectsIo () -> IO ()-defaultMain =-  void-    . runLift-    . withLogging consoleLogWriter-    . scheduleMonadIOEff+defaultMain e =+  consoleLogWriter >>=+  (\lw ->+      void+        . runLift+        . withLogging lw+        . scheduleMonadIOEff+        $ e) + -- | Execute a 'Process' using 'scheduleM' on top of 'Lift' @IO@. -- All logging is written using the given 'LogWriter'. -- -- @since 0.25.0-defaultMainWithLogWriter :: HasCallStack => LogWriter (Lift IO) -> Eff EffectsIo () -> IO ()+defaultMainWithLogWriter :: HasCallStack => LogWriter -> Eff EffectsIo () -> IO () defaultMainWithLogWriter lw =   void     . runLift@@ -637,7 +640,7 @@ -- 'Logs' and the 'LogWriterReader' for 'PureLogWriter'. -- -- @since 0.25.0-type PureBaseEffects = '[Logs, LogWriterReader Logs]+type PureBaseEffects = '[Logs, LogWriterReader]  -- | Constraint for the existence of the underlying scheduler effects. --

@@ -108,7 +108,7 @@ startLink   :: forall p e   . ( HasCallStack-    , LogIo (Processes e)+    , IoLogging (Processes e)     , TangibleBroker p     , Stateful.Server (Broker p) (Processes e)     )@@ -124,7 +124,7 @@ statefulChild   :: forall p e   . ( HasCallStack-    , LogIo (Processes e)+    , IoLogging (Processes e)     , TangibleBroker (Stateful.Stateful p)     , Stateful.Server (Broker (Stateful.Stateful p)) (Processes e)     )@@ -436,7 +436,7 @@   instance-  ( LogIo q+  ( IoLogging q   , TangibleBroker p   , Tangible (ChildId p)   , Typeable (Effectful.ServerPdu p)

@@ -41,11 +41,11 @@ -- -- @since 0.29.1 start-  :: forall (tag :: Type) eLoop q h e.+  :: forall (tag :: Type) eLoop q e.      ( HasCallStack      , TangibleCallbacks tag eLoop q      , E.Server (Server tag eLoop) (Processes q)-     , LogsTo h (Processes q)+     , FilteredLogging (Processes q)      , HasProcesses e q      )   => CallbacksEff tag eLoop q@@ -57,11 +57,11 @@ -- -- @since 0.29.1 startLink-  :: forall (tag :: Type) eLoop q h e.+  :: forall (tag :: Type) eLoop q e.      ( HasCallStack      , TangibleCallbacks tag eLoop q      , E.Server (Server tag eLoop) (Processes q)-     , LogsTo h (Processes q)+     , FilteredLogging (Processes q)      , HasProcesses e q      )   => CallbacksEff tag eLoop q@@ -136,11 +136,11 @@ -- -- @since 0.29.1 callbacks-  :: forall tag q h.+  :: forall tag q.      ( HasCallStack      , TangibleCallbacks tag (Processes q) q      , E.Server (Server tag (Processes q)) (Processes q)-     , LogsTo h q+     , FilteredLogging q      )   => (Endpoint tag -> Event tag -> Eff (Processes q) ())   -> ServerId tag@@ -151,11 +151,11 @@ -- -- @since 0.29.1 onEvent-  :: forall tag q h.+  :: forall tag q .      ( HasCallStack      , TangibleCallbacks tag (Processes q) q      , E.Server (Server tag (Processes q)) (Processes q)-     , LogsTo h q+     , FilteredLogging q      )   => (Event tag -> Eff (Processes q) ())   -> ServerId (tag :: Type)@@ -175,11 +175,11 @@ -- -- @since 0.29.1 callbacksEff-  :: forall tag eLoop q h.+  :: forall tag eLoop q.      ( HasCallStack      , TangibleCallbacks tag eLoop q      , E.Server (Server tag eLoop) (Processes q)-     , LogsTo h q+     , FilteredLogging q      )   => (forall x . Endpoint tag -> Eff eLoop x -> Eff (Processes q) x)   -> (Endpoint tag -> Event tag -> Eff eLoop ())@@ -195,7 +195,7 @@     ( HasCallStack     , TangibleCallbacks tag eLoop q     , E.Server (Server tag eLoop) (Processes q)-    , LogsTo h q+    , FilteredLogging q     )   => (forall a. Eff eLoop a -> Eff (Processes q) a)   -> (Event tag -> Eff eLoop ())

@@ -83,11 +83,11 @@ -- -- @since 0.24.0 start-  :: forall a r q h+  :: forall a r q   . ( Server a (Processes q)     , Typeable a     , Typeable (ServerPdu a)-    , LogsTo h (Processes q)+    , FilteredLogging (Processes q)     , HasProcesses (ServerEffects a (Processes q)) q     , HasProcesses r q     , HasCallStack)@@ -99,11 +99,11 @@ -- -- @since 0.24.0 startLink-  :: forall a r q h+  :: forall a r q   . ( Typeable a     , Typeable (ServerPdu a)     , Server a (Processes q)-    , LogsTo h (Processes q)+    , FilteredLogging (Processes q)     , HasProcesses (ServerEffects a (Processes q)) q     , HasProcesses r q     , HasCallStack)@@ -115,9 +115,9 @@ -- -- @since 0.24.0 protocolServerLoop-     :: forall q h a+     :: forall q a      . ( Server a (Processes q)-       , LogsTo h (Processes q)+       , FilteredLogging (Processes q)        , HasProcesses (ServerEffects a (Processes q)) q        , Typeable a        , Typeable (ServerPdu a)

@@ -125,12 +125,12 @@ -- -- @since 0.28.0 observe-  :: forall event eventSource e q len b h+  :: forall event eventSource e q len b   . ( HasCallStack     , HasProcesses e q-    , LogsTo h e-    , LogsTo h q-    , LogsTo h (Processes q)+    , FilteredLogging e+    , FilteredLogging q+    , FilteredLogging (Processes q)     , Lifted IO e     , Lifted IO q     , IsObservable eventSource event@@ -178,10 +178,10 @@ -- -- @since 0.28.0 spawnWriter-  :: forall event r q h+  :: forall event r q    . ( Member Logs q      , Lifted IO q-     , LogsTo h (Processes q)+     , FilteredLogging (Processes q)      , HasProcesses r q      , Typeable event      , HasCallStack@@ -190,7 +190,7 @@   => ObservationQueue event   -> Eff r (Endpoint (Observer event)) spawnWriter q =-  startLink @_ @r @q @h (MkObservationQueue q)+  startLink @_ @r @q (MkObservationQueue q)  -- | Spawn a process that can be used as an 'Observer' that enqueues the observations into an --   'ObservationQueue'. See 'withObservationQueue'.@@ -201,11 +201,11 @@ -- -- @since 0.28.0 withWriter-  :: forall event eventSource e q b h+  :: forall event eventSource e q b   . ( HasCallStack     , HasProcesses e q     , Lifted IO q-    , LogsTo h (Processes q)+    , FilteredLogging (Processes q)     , Member Logs q     , IsObservable eventSource event     , Member (Reader event) e

@@ -137,10 +137,10 @@ -- -- @since 0.24.0 startLink-  :: forall a r q h+  :: forall a r q   . ( HasCallStack     , Typeable a-    , LogsTo h (Processes q)+    , FilteredLogging (Processes q)     , Effectful.Server (Stateful a) (Processes q)     , Server a (Processes q)     , HasProcesses r q@@ -152,13 +152,12 @@ -- -- @since 0.24.0 start-  :: forall a r q h+  :: forall a r q   . ( HasCallStack     , Typeable a     , Effectful.Server (Stateful a) (Processes q)     , Server a (Processes q)-    , HandleLogWriter h-    , LogsTo h (Processes q)+    , FilteredLogging (Processes q)     , HasProcesses r q     )   => StartArgument a (Processes q) -> Eff r (Endpoint (Protocol a))

@@ -84,10 +84,10 @@ -- -- @since 0.30.0 startLink-  :: forall child e q h+  :: forall child e q   . ( HasCallStack     , Typeable child-    , LogsTo h (Processes q)+    , FilteredLogging (Processes q)     , Member Logs q     , HasProcesses e q     , Tangible (Broker.ChildId child)@@ -104,9 +104,9 @@ -- -- @since 0.30.0 attachTemporary-  :: forall child q e h+  :: forall child q e   . ( HasCallStack-    , LogsTo h e+    , FilteredLogging e     , Typeable child     , HasPdu (Effectful.ServerPdu child)     , Tangible (Broker.ChildId child)@@ -123,9 +123,9 @@ -- -- @since 0.30.0 attachPermanent-  :: forall child q e h+  :: forall child q e   . ( HasCallStack-    , LogsTo h e+    , FilteredLogging e     , Typeable child     , HasPdu (Effectful.ServerPdu child)     , Tangible (Broker.ChildId child)@@ -142,9 +142,9 @@ -- -- @since 0.30.0 getCrashReports-  :: forall child q e h+  :: forall child q e   . ( HasCallStack-    , LogsTo h e+    , FilteredLogging e     , Typeable child     , HasPdu (Effectful.ServerPdu child)     , Tangible (Broker.ChildId child)

@@ -48,7 +48,7 @@ -- @since 0.25.0 schedule   :: HasCallStack-  => LogWriter (Lift IO)+  => LogWriter   -> Eff Effects a   -> IO (Either (Interrupt 'NoRecovery) a) schedule = scheduleIOWithLogging

@@ -1,6 +1,6 @@--- | Logging via @extensible-effects@+-- | FilteredLogging via @extensible-effects@ ----- Logging consist of __two__ effects:+-- FilteredLogging consist of __two__ effects: -- -- * __Receiving__ log messages sent by the code using e.g. 'logInfo'; this also include deep evaluation and --    dropping messages not satisfying the current 'LogPredicate'.@@ -64,10 +64,10 @@ -- -- === 'LogWriter's ----- * Logging in a 'Control.Concurrent.Async.withAsync' spawned thread is done using 'withAsyncLogging'.+-- * FilteredLogging in a 'Control.Concurrent.Async.withAsync' spawned thread is done using 'withAsyncLogging'.  module Control.Eff.Log-  ( -- * Logging API+  ( -- * FilteredLogging API     -- ** Sending Log Messages #SendingLogs#     logMsg   , logWithSeverity@@ -109,14 +109,15 @@      -- *** Log Message Modification   , censorLogs-  , censorLogsM+  , censorLogsIo      -- ** 'Logs' Effect Handling   , Logs()-  , LogsTo-  , LogIo+  , FilteredLogging+  , IoLogging+  , LoggingAndIo   , withLogging-  , withSomeLogging+  , withoutLogging      -- ** Low-Level API for Custom Extensions     -- *** Log Message Interception

@@ -1,11 +1,11 @@--- | Examples for Logging.+-- | Examples for FilteredLogging. module Control.Eff.Log.Examples-  ( -- * Example Code for Logging+  ( -- * Example Code for FilteredLogging     exampleLogging   , exampleWithLogging   , exampleWithSomeLogging-  , exampleLogPredicate-  , exampleLogCapture+  , exampleSetLogWriter+  , exampleLogTrace   , exampleAsyncLogging   , exampleRFC5424Logging   , exampleRFC3164WithRFC5424TimestampsLogging@@ -23,8 +23,7 @@ import           Control.Eff.LogWriter.Async import           Control.Eff.LogWriter.Console import           Control.Eff.LogWriter.DebugTrace-import           Control.Eff.LogWriter.Capture-import           Control.Eff.LogWriter.IO+import           Control.Eff.LogWriter.Rich import           Control.Eff.LogWriter.UnixSocket import           Control.Eff.LogWriter.UDP import           Control.Eff@@ -32,16 +31,14 @@                                                 , (%~)                                                 , to                                                 )-import           Data.Text                     as T-import           Data.Text.IO                  as T import           GHC.Stack --- * Logging examples+-- * FilteredLogging examples  -- | Example code for: -- --  * 'withConsoleLogging'---  * 'mkLogWriterIO'+--  * 'MkLogWriter' -- See 'loggingExampleClient' exampleLogging :: HasCallStack => IO () exampleLogging = runLift@@ -52,73 +49,74 @@ --  * 'withLogging' --  * 'consoleLogWriter' exampleWithLogging :: HasCallStack => IO ()-exampleWithLogging =-  runLift $ withLogging consoleLogWriter $ logDebug "Oh, hi there"+exampleWithLogging = do+  lw <- consoleLogWriter+  runLift $ withLogging lw $ logDebug "Oh, hi there"  -- | Example code for: -----  * 'withSomeLogging'+--  * 'withoutLogging' --  * 'logDebug' exampleWithSomeLogging :: HasCallStack => () exampleWithSomeLogging =-  run $ withSomeLogging @Logs $ logDebug "Oh, hi there"+  run $ withoutLogging $ logDebug "Oh, hi there" --- | Example code for:+-- | Example code for: 'setLogWriter' -----  * 'setLogPredicate'---  * 'modifyLogPredicate'---  * 'lmMessageStartsWith'---  * 'lmSeverityIs'---  * 'lmSeverityIsAtLeast'---  * 'includeLogMessages'---  * 'excludeLogMessages'-exampleLogPredicate :: HasCallStack => IO Int-exampleLogPredicate =+-- Also used:+--  * 'stdoutLogWriter'+--  * 'renderConsoleMinimalisticWide'+--  * 'consoleLogWriter'+--  * 'logAlert'+--  * 'withLogging'+exampleSetLogWriter :: HasCallStack => IO ()+exampleSetLogWriter = do+  lw1 <- stdoutLogWriter renderConsoleMinimalisticWide+  lw2 <- consoleLogWriter   runLift-    $ withSomeLogging @(Lift IO)-    $ setLogWriter consoleLogWriter-    $ logPredicatesExampleClient+    $ withLogging lw1+    $ do  logAlert "test with log writer 1"+          setLogWriter lw2 (logAlert "test with log writer 2")+          logAlert "test with log writer 1 again" + -- | Example code for: -- --  * 'runCaptureLogWriter' --  * 'captureLogWriter' --  * 'mappingLogWriter' --  * 'filteringLogWriter'-exampleLogCapture :: IO ()-exampleLogCapture = go >>= T.putStrLn- where-  go =-    fmap (T.unlines . Prelude.map renderLogMessageConsoleLog . snd)-      $ runLift-      $ runCaptureLogWriter-      $ withLogging captureLogWriter-      $ addLogWriter-          (mappingLogWriter (lmMessage %~ ("CAPTURED " <>)) captureLogWriter)-      $ addLogWriter-          (filteringLogWriter-            severeMessages-            (mappingLogWriter (lmMessage %~ ("TRACED " <>))-                              (debugTraceLogWriter renderRFC5424)-            )+exampleLogTrace :: IO ()+exampleLogTrace = do+  lw <- consoleLogWriter+  runLift+    $ withRichLogging lw "test-app" local7 allLogMessages+    $ addLogWriter+        (filteringLogWriter+          severeMessages+          (mappingLogWriter (lmMessage %~ ("TRACED " <>))+                            (debugTraceLogWriter renderRFC5424)           )-      $ do-          logEmergency "test emergencySeverity 1"-          logCritical "test criticalSeverity 2"-          logAlert "test alertSeverity 3"-          logError "test errorSeverity 4"-          logWarning "test warningSeverity 5"-          logInfo "test informationalSeverity 6"-          logDebug "test debugSeverity 7"-  severeMessages = view (lmSeverity . to (<= errorSeverity))+        )+    $ do+        logEmergency "test emergencySeverity 1"+        logCritical "test criticalSeverity 2"+        logAlert "test alertSeverity 3"+        logError "test errorSeverity 4"+        logWarning "test warningSeverity 5"+        logInfo "test informationalSeverity 6"+        logDebug "test debugSeverity 7"+  where+    severeMessages = view (lmSeverity . to (<= errorSeverity))   -- | Example code for: -- --  * 'withAsyncLogging' exampleAsyncLogging :: IO ()-exampleAsyncLogging =-  runLift $ withLogging consoleLogWriter $ withAsyncLogWriter (1000 :: Int) $ do+exampleAsyncLogging = do+  lw <- stdoutLogWriter renderConsoleMinimalisticWide+  runLift $ withLogging lw $ withAsyncLogWriter (1000 :: Int) $ do     logInfo "test 1"     logInfo "test 2"     logInfo "test 3"@@ -128,19 +126,19 @@ exampleRFC5424Logging :: IO Int exampleRFC5424Logging =   runLift-    $ withSomeLogging @(Lift IO)+    $ withoutLogging     $ setLogWriter-        (defaultIoLogWriter "myapp" local2 (debugTraceLogWriter renderRFC5424))-    $ logPredicatesExampleClient+        (richLogWriter "myapp" local2 (debugTraceLogWriter renderRFC5424))+      logPredicatesExampleClient  -- | Example code for RFC3164 with RFC5424 time stamp formatted logs. exampleRFC3164WithRFC5424TimestampsLogging :: IO Int exampleRFC3164WithRFC5424TimestampsLogging =   runLift-    $ withSomeLogging @(Lift IO)+    $ withoutLogging     $ setLogWriter-        (defaultIoLogWriter "myapp" local2 (debugTraceLogWriter renderRFC3164WithRFC5424Timestamps))-    $ logPredicatesExampleClient+        (richLogWriter "myapp" local2 (debugTraceLogWriter renderRFC3164WithRFC5424Timestamps))+      logPredicatesExampleClient  -- | Example code logging via a unix domain socket to @/dev/log@. exampleDevLogSyslogLogging :: IO Int@@ -186,7 +184,7 @@ --  * 'logWarning' --  * 'logCritical' --  * 'lmMessage'-loggingExampleClient :: (HasCallStack, Monad (LogWriterM h), LogsTo h e) => Eff e ()+loggingExampleClient :: (HasCallStack, IoLogging e) => Eff e () loggingExampleClient = do   logDebug "test 1.1"   logError "test 1.2"@@ -209,7 +207,7 @@ --  * 'lmSeverityIsAtLeast' --  * 'includeLogMessages' --  * 'excludeLogMessages'-logPredicatesExampleClient :: (HasCallStack, Monad (LogWriterM h), LogsTo h e) => Eff e Int+logPredicatesExampleClient :: (HasCallStack, IoLogging e) => Eff e Int logPredicatesExampleClient = do   logInfo "test"   setLogPredicate

@@ -5,7 +5,7 @@ -- Good support for logging to a file or to the network, -- as well as asynchronous logging in another thread. module Control.Eff.Log.Handler-  ( -- * Logging API+  ( -- * FilteredLogging API     -- ** Sending Log Messages     logMsg   , logWithSeverity@@ -46,18 +46,20 @@    -- *** Log Message Modification   , censorLogs-  , censorLogsM+  , censorLogsIo    -- ** 'Logs' Effect Handling   , Logs()-  , LogsTo-  , LogIo+  , FilteredLogging+  , IoLogging+  , LoggingAndIo   , withLogging-  , withSomeLogging+  , withoutLogging    -- ** Low-Level API for Custom Extensions   -- *** Log Message Interception   , runLogs+  , runLogsWithoutLogging   , respondToLogMessage   , interceptLogMessages @@ -111,34 +113,34 @@ -- | This instance allows lifting the 'Logs' effect into a base monad, e.g. 'IO'. -- This instance needs a 'LogWriterReader' in the base monad, -- that is capable to handle 'logMsg' invocations.-instance forall m e. (MonadBase m m, LiftedBase m e, LogsTo (Lift m) (Logs ': e))+instance forall m e. (MonadBase m IO, MonadBaseControl IO (Eff e), LiftedBase m e, Lifted IO e, IoLogging (Logs ': e))   => MonadBaseControl m (Eff (Logs ': e)) where     type StM (Eff (Logs ': e)) a =  StM (Eff e) a     liftBaseWith f = do       lf <- askLogPredicate-      raise (liftBaseWith (\runInBase -> f (runInBase . runLogs @(Lift m) lf)))+      raise (liftBaseWith (\runInBase -> f (runInBase . runLogs lf)))     restoreM = raise . restoreM  instance (LiftedBase m e, Catch.MonadThrow (Eff e))   => Catch.MonadThrow (Eff (Logs ': e)) where   throwM exception = raise (Catch.throwM exception) -instance (Applicative m, LiftedBase m e, Catch.MonadCatch (Eff e), LogsTo (Lift m) (Logs ': e))+instance (Applicative m, MonadBaseControl IO (Eff e), LiftedBase m e, Catch.MonadCatch (Eff e), IoLogging (Logs ': e), Lifted IO e)   => Catch.MonadCatch (Eff (Logs ': e)) where   catch effect handler = do     lf <- askLogPredicate-    let lower                   = runLogs @(Lift m) lf+    let lower                   = runLogs lf         nestedEffects           = lower effect         nestedHandler exception = lower (handler exception)     raise (Catch.catch nestedEffects nestedHandler) -instance (Applicative m, LiftedBase m e, Catch.MonadMask (Eff e), LogsTo (Lift m) (Logs ': e))+instance (Applicative m, MonadBaseControl IO (Eff e), LiftedBase m e, Catch.MonadMask (Eff e), IoLogging (Logs ': e), Lifted IO e)   => Catch.MonadMask (Eff (Logs ': e)) where   mask maskedEffect = do     lf <- askLogPredicate     let       lower :: Eff (Logs ': e) a -> Eff e a-      lower = runLogs @(Lift m) lf+      lower = runLogs lf     raise         (Catch.mask           (\nestedUnmask -> lower@@ -151,7 +153,7 @@     lf <- askLogPredicate     let       lower :: Eff (Logs ': e) a -> Eff e a-      lower = runLogs @(Lift m) lf+      lower = runLogs lf     raise         (Catch.uninterruptibleMask           (\nestedUnmask -> lower@@ -164,7 +166,7 @@     lf <- askLogPredicate     let       lower :: Eff (Logs ': e) a -> Eff e a-      lower = runLogs @(Lift m) lf+      lower = runLogs lf     raise         (Catch.generalBracket           (lower acquire)@@ -172,42 +174,42 @@           (lower . useIt)       ) ---- | A constraint alias for effects that requires a 'LogWriterReader', as well as that the--- contained 'LogWriterReader' has a 'HandleLogWriter' instance.+-- | A constraint that requires @'Logs' e@ and @'Lifted' 'IO' e@. ----- The requirements of this constraint are provided by:+-- Provided by 'withLogging' and 'runLogs'. ----- * 'withIoLogging'--- * 'withLogging'--- * 'withSomeLogging'+-- It contains 'FilteredLogging' and allows in addition: ---type LogsTo h e =-  ( Member Logs e-  , HandleLogWriter h-  , Member h e-  , SetMember LogWriterReader (LogWriterReader h) e-  )---- | This instance is for pure logging - i.e. discarding all messages.+-- * censorLogsIo ----- @since 0.29.1-instance HandleLogWriter Logs where-  data LogWriterM Logs a = MkPureLogging deriving (Functor)-  handleLogWriterEffect = const (pure ())--instance Applicative (LogWriterM Logs) where-  pure = const MkPureLogging-  MkPureLogging <*> MkPureLogging = MkPureLogging+-- Don't infect everything with 'IO', if you can fall back to+-- 'FilteredLogging'.+--+-- @since 0.24.0+type IoLogging e = (FilteredLogging e, Lifted IO e) -instance Monad (LogWriterM Logs) where-  MkPureLogging >>= _ = MkPureLogging+-- | A constraint that requires 'Logs' and 'LogWriterReader',+-- and hence supports the functions to filter and modify+-- logs:+--+-- * setLogWriter+-- * addLogWriter+-- * modifyLogWriter+-- * censorLogs+--+-- Provided by 'withLogging', 'runLogs', and also+-- 'withoutLogging' and 'runLogsWithoutLogging'.+--+-- @since 0.31.0+type FilteredLogging e = (Member Logs e, Member LogWriterReader e) --- | A constraint that required @'LogsTo' 'IO' e@ and @'Lifted' 'IO' e@.+-- | The concrete list of 'Eff'ects for logging with a+-- 'LogWriter', and a 'LogWriterReader'. ----- @since 0.24.0-type LogIo e = (LogsTo (Lift IO) e, Lifted IO e)+-- This also provides both 'IoLogging' and 'FilteredLogging'.+type LoggingAndIo = '[Logs, LogWriterReader, Lift IO] + -- | Handle the 'Logs' and 'LogWriterReader' effects. -- -- It installs the given 'LogWriter', which determines the underlying@@ -221,44 +223,57 @@ -- >   $ withLogging consoleLogWriter -- >   $ logDebug "Oh, hi there" ---withLogging ::-     forall h e a. (Applicative (LogWriterM h), LogsTo h (Logs ': LogWriterReader h ': e))-  => LogWriter h -> Eff (Logs ': LogWriterReader h ': e) a -> Eff e a+-- This provides the 'IoLogging' and 'FilteredLogging' effects.+--+-- See also 'runLogs'.+--+withLogging :: Lifted IO e => LogWriter -> Eff (Logs ': LogWriterReader ': e) a -> Eff e a withLogging lw = runLogWriterReader lw . runLogs allLogMessages --- | Handles the 'Logs' and 'LogWriterReader' effects.------ By default it uses the 'noOpLogWriter', but using 'setLogWriter' the--- 'LogWriter' can be replaced.+-- | Handles the 'Logs' and 'LogWriterReader' effects, while not invoking the 'LogWriter' at all. ----- This is like 'withLogging' applied to 'noOpLogWriter'+-- There is no way to get log output when this logger is used. -- -- Example: -- -- > exampleWithSomeLogging :: () -- > exampleWithSomeLogging = -- >     run--- >   $ withSomeLogging @PureLogWriter--- >   $ logDebug "Oh, hi there"+-- >   $ withoutLogging+-- >   $ logDebug "Oh, hi there" -- Nothing written ---withSomeLogging ::-     forall h e a.-     (Applicative (LogWriterM h), LogsTo h (Logs ': LogWriterReader h ': e))-  => Eff (Logs ': LogWriterReader h ': e) a-  -> Eff e a-withSomeLogging = withLogging (noOpLogWriter @h)+-- This provides the 'FilteredLogging' effect.+--+-- See also 'runLogsWithoutLogging'.+--+withoutLogging :: Eff (Logs ': LogWriterReader ': e) a -> Eff e a+withoutLogging = runLogWriterReader mempty . runLogsWithoutLogging noLogMessages  -- | Raw handling of the 'Logs' effect. -- Exposed for custom extensions, if in doubt use 'withLogging'. runLogs-  :: forall h e b .-     (LogsTo h (Logs ': e))+  :: forall e b .+     ( Member LogWriterReader (Logs ': e)+     , Lifted IO e+     )   => LogPredicate   -> Eff (Logs ': e) b   -> Eff e b runLogs p m =   fix (handle_relay (\a _ -> return a)) (sendLogMessageToLogWriter  m) p +-- | Raw handling of the 'Logs' effect.+-- Exposed for custom extensions, if in doubt use 'withoutLogging'.+runLogsWithoutLogging+  :: forall e b .+     ( Member LogWriterReader (Logs ': e)+     )+  => LogPredicate+  -> Eff (Logs ': e) b+  -> Eff e b+runLogsWithoutLogging p m =+  fix (handle_relay (\a _ -> return a)) m p+ -- | Log a message. -- -- All logging goes through this function.@@ -475,7 +490,7 @@  -- | Issue a log statement for each item in the list prefixed with a line number and a message hash. ----- When several concurrent processes issue log statements, multiline log statements are often+-- When several concurrent processes issue log statements, multi line log statements are often -- interleaved. -- -- In order to make the logs easier to read, this function will count the items and calculate a unique@@ -539,8 +554,8 @@ -- -- E.g. to keep only messages which begin with @"OMG"@: ----- > exampleLogPredicate :: IO Int--- > exampleLogPredicate =+-- > exampleSetLogWriter :: IO Int+-- > exampleSetLogWriter = -- >     runLift -- >   $ withLogging consoleLogWriter -- >   $ do logMsg "test"@@ -678,38 +693,30 @@ interceptLogMessages f = respondToLogMessage (f >=> logMsg)  -- | Internal function.-sendLogMessageToLogWriter-  :: forall h e b . (LogsTo h e) => Eff e b -> Eff e b+sendLogMessageToLogWriter :: IoLogging e => Eff e b -> Eff e b sendLogMessageToLogWriter = respondToLogMessage liftWriteLogMessage  -- | Change the current 'LogWriter'.-modifyLogWriter-  :: forall h e a-   . (LogsTo h e)-  => (LogWriter h -> LogWriter h)-  -> Eff e a-  -> Eff e a+modifyLogWriter :: IoLogging e => (LogWriter -> LogWriter) -> Eff e a -> Eff e a modifyLogWriter f = localLogWriterReader f . sendLogMessageToLogWriter  -- | Replace the current 'LogWriter'. -- To add an additional log message consumer use 'addLogWriter'-setLogWriter :: forall h e a. (LogsTo h e) => LogWriter h -> Eff e a -> Eff e a+setLogWriter :: IoLogging e => LogWriter -> Eff e a -> Eff e a setLogWriter = modifyLogWriter  . const  -- | Modify the the 'LogMessage's written in the given sub-expression. -- -- Note: This is equivalent to @'modifyLogWriter' . 'mappingLogWriter'@-censorLogs :: (LogsTo h e) => (LogMessage -> LogMessage) -> Eff e a -> Eff e a+censorLogs :: IoLogging e => (LogMessage -> LogMessage) -> Eff e a -> Eff e a censorLogs = modifyLogWriter . mappingLogWriter  -- | Modify the the 'LogMessage's written in the given sub-expression, as in 'censorLogs' -- but with a effectful function. ----- Note: This is equivalent to @'modifyLogWriter' . 'mappingLogWriterM'@-censorLogsM-  :: (LogsTo h e, Monad (LogWriterM h))-  => (LogMessage -> LogWriterM h LogMessage) -> Eff e a -> Eff e a-censorLogsM = modifyLogWriter . mappingLogWriterM+-- Note: This is equivalent to @'modifyLogWriter' . 'mappingLogWriterIO'@+censorLogsIo :: IoLogging e => (LogMessage -> IO LogMessage) -> Eff e a -> Eff e a+censorLogsIo = modifyLogWriter . mappingLogWriterIO  -- | Combine the effects of a given 'LogWriter' and the existing one. --@@ -735,7 +742,5 @@ -- >        severeMessages = view (lmSeverity . to (<= errorSeverity)) -- > ---addLogWriter :: forall h e a .-     (HasCallStack, LogsTo h e, Monad (LogWriterM h))-  => LogWriter h -> Eff e a -> Eff e a+addLogWriter :: IoLogging e => LogWriter -> Eff e a -> Eff e a addLogWriter lw2 = modifyLogWriter (\lw1 -> MkLogWriter (\m -> runLogWriter lw1 m >> runLogWriter lw2 m))

@@ -5,8 +5,10 @@    -- * Log Message Text Rendering     LogMessageRenderer+  , LogMessageTextRenderer   , renderLogMessageSyslog   , renderLogMessageConsoleLog+  , renderConsoleMinimalisticWide   , renderRFC3164   , renderRFC3164WithRFC5424Timestamps   , renderRFC3164WithTimestamp@@ -46,6 +48,11 @@ -- | 'LogMessage' rendering function type LogMessageRenderer a = LogMessage -> a +-- | 'LogMessage' to 'T.Text' rendering function.+--+-- @since 0.31.0+type LogMessageTextRenderer = LogMessageRenderer T.Text+ -- | A rendering function for the 'lmTimestamp' field. newtype LogMessageTimeRenderer =   MkLogMessageTimeRenderer { renderLogMessageTime :: UTCTime -> T.Text }@@ -76,14 +83,14 @@   mkLogMessageTimeRenderer (iso8601DateFormat (Just "%H:%M:%S%6Q"))  -- | Print the thread id, the message and the source file location, seperated by simple white space.-renderLogMessageBody :: LogMessageRenderer T.Text+renderLogMessageBody :: LogMessageTextRenderer renderLogMessageBody = T.unwords . filter (not . T.null) <$> sequence   [ renderLogMessageBodyNoLocation   , fromMaybe "" <$> renderLogMessageSrcLoc   ]  -- | Print the thread id, the message and the source file location, seperated by simple white space.-renderLogMessageBodyNoLocation :: LogMessageRenderer T.Text+renderLogMessageBodyNoLocation :: LogMessageTextRenderer renderLogMessageBodyNoLocation = T.unwords . filter (not . T.null) <$> sequence   [ renderShowMaybeLogMessageLens "" lmThreadId   , view lmMessage@@ -91,7 +98,7 @@  -- | Print the /body/ of a 'LogMessage' with fix size fields (60) for the message itself -- and 30 characters for the location-renderLogMessageBodyFixWidth :: LogMessageRenderer T.Text+renderLogMessageBodyFixWidth :: LogMessageTextRenderer renderLogMessageBodyFixWidth l@(MkLogMessage _f _s _ts _hn _an _pid _mi _sd ti _ msg)   = T.unwords $ filter     (not . T.null)@@ -102,7 +109,7 @@  -- | Render a field of a 'LogMessage' using the corresponsing lens. renderMaybeLogMessageLens-  :: T.Text -> Getter LogMessage (Maybe T.Text) -> LogMessageRenderer T.Text+  :: T.Text -> Getter LogMessage (Maybe T.Text) -> LogMessageTextRenderer renderMaybeLogMessageLens x l = fromMaybe x . view l  -- | Render a field of a 'LogMessage' using the corresponsing lens.@@ -110,7 +117,7 @@   :: Show a   => T.Text   -> Getter LogMessage (Maybe a)-  -> LogMessageRenderer T.Text+  -> LogMessageTextRenderer renderShowMaybeLogMessageLens x l =   renderMaybeLogMessageLens x (l . to (fmap (T.pack . show))) @@ -133,7 +140,7 @@ -- Render e.g. as @\<192\>@. -- -- Useful as header for syslog compatible log output.-renderSyslogSeverityAndFacility :: LogMessageRenderer T.Text+renderSyslogSeverityAndFacility :: LogMessageTextRenderer renderSyslogSeverityAndFacility (MkLogMessage !f !s _ _ _ _ _ _ _ _ _) =   "<" <> T.pack (show (fromSeverity s + fromFacility f * 8)) <> ">" @@ -144,7 +151,7 @@ -- Render the header using 'renderSyslogSeverity' -- -- Useful for logging to @/dev/log@-renderLogMessageSyslog :: LogMessageRenderer T.Text+renderLogMessageSyslog :: LogMessageTextRenderer renderLogMessageSyslog l@(MkLogMessage _ _ _ _ an _ mi _ _ _ _)   = renderSyslogSeverityAndFacility l <> (T.unwords     . filter (not . T.null)@@ -154,30 +161,47 @@       ])  -- | Render a 'LogMessage' human readable, for console logging-renderLogMessageConsoleLog :: LogMessageRenderer T.Text-renderLogMessageConsoleLog l@(MkLogMessage _ _ ts _ _ pd _ sd _ _ _) =+renderLogMessageConsoleLog :: LogMessageTextRenderer+renderLogMessageConsoleLog l@(MkLogMessage _ _ ts _ _ _ _ sd _ _ _) =   T.unwords $ filter     (not . T.null)-    [ view (lmSeverity . to (T.pack . show)) l-    , fromMaybe " no proc " pd+    [ T.pack (show (view lmSeverity  l))+    , let p = fromMaybe "no process" (l ^. lmProcessId)+      in p <> T.replicate (max 0 (55 - T.length p)) " "     , maybe "" (renderLogMessageTime rfc5424Timestamp) ts     , renderLogMessageBodyFixWidth l     , if null sd then "" else T.concat (renderSdElement <$> sd)     ] +-- | Render a 'LogMessage' human readable, for console logging+--+-- @since 0.31.0+renderConsoleMinimalisticWide :: LogMessageRenderer T.Text+renderConsoleMinimalisticWide l =+  T.unwords $ filter+    (not . T.null)+    [ let s = T.pack (show (view lmSeverity  l))+      in s <> T.replicate (max 0 (15 - T.length s)) " "+    , let p = fromMaybe "no process" (l ^. lmProcessId)+      in p <> T.replicate (max 0 (55 - T.length p)) " "+    , let msg = l^.lmMessage+      in  msg <> T.replicate (max 0 (100 - T.length msg)) " "+    -- , fromMaybe "" (renderLogMessageSrcLoc l)+    ]+ -- | Render a 'LogMessage' according to the rules in the RFC-3164.-renderRFC3164 :: LogMessageRenderer T.Text+renderRFC3164 :: LogMessageTextRenderer renderRFC3164 = renderRFC3164WithTimestamp rfc3164Timestamp  -- | Render a 'LogMessage' according to the rules in the RFC-3164 but use -- RFC5424 time stamps.-renderRFC3164WithRFC5424Timestamps :: LogMessageRenderer T.Text+renderRFC3164WithRFC5424Timestamps :: LogMessageTextRenderer renderRFC3164WithRFC5424Timestamps =   renderRFC3164WithTimestamp rfc5424Timestamp  -- | Render a 'LogMessage' according to the rules in the RFC-3164 but use the custom -- 'LogMessageTimeRenderer'.-renderRFC3164WithTimestamp :: LogMessageTimeRenderer -> LogMessageRenderer T.Text+renderRFC3164WithTimestamp :: LogMessageTimeRenderer -> LogMessageTextRenderer renderRFC3164WithTimestamp renderTime l@(MkLogMessage _ _ ts hn an pid mi _ _ _ _) =   T.unwords     . filter (not . T.null)@@ -196,7 +220,7 @@ -- Equivalent to @'renderRFC5424Header' <> const " " <> 'renderLogMessageBody'@. -- -- @since 0.21.0-renderRFC5424 :: LogMessageRenderer T.Text+renderRFC5424 :: LogMessageTextRenderer renderRFC5424  = renderRFC5424Header <> const " " <> renderLogMessageBody  -- | Render a 'LogMessage' according to the rules in the RFC-5424, like 'renderRFC5424' but@@ -205,14 +229,14 @@ -- Equivalent to @'renderRFC5424Header' <> const " " <> 'renderLogMessageBodyNoLocation'@. -- -- @since 0.21.0-renderRFC5424NoLocation :: LogMessageRenderer T.Text+renderRFC5424NoLocation :: LogMessageTextRenderer renderRFC5424NoLocation  = renderRFC5424Header <> const " " <> renderLogMessageBodyNoLocation  -- | Render the header and strucuted data of  a 'LogMessage' according to the rules in the RFC-5424, but do not -- render the 'lmMessage'. -- -- @since 0.22.0-renderRFC5424Header :: LogMessageRenderer T.Text+renderRFC5424Header :: LogMessageTextRenderer renderRFC5424Header l@(MkLogMessage _ _ ts hn an pid mi sd _ _ _) =   T.unwords     . filter (not . T.null)

@@ -1,9 +1,5 @@ {-# LANGUAGE UndecidableInstances #-}--- | The 'LogWriter' type encapsulates an effectful function to write 'LogMessage's.------ Used in conjunction with the 'HandleLogWriter' class, it--- can be used to write messages from within an effectful--- computation.+-- | The 'LogWriter' type encapsulates an 'IO' action to write 'LogMessage's. module Control.Eff.Log.Writer   (   -- * 'LogWriter' Definition@@ -13,192 +9,109 @@   , localLogWriterReader   , askLogWriter   , runLogWriterReader-  -- * LogWriter Handler Class-  , HandleLogWriter(..)-  , LogWriterM(..)+  -- * LogWriter utilities+  , liftWriteLogMessage   , noOpLogWriter-  -- ** Writer Combinator-  -- *** Pure Writer Combinator   , filteringLogWriter   , mappingLogWriter-  -- *** Impure Writer Combinator-  , mappingLogWriterM+  , mappingLogWriterIO+  , ioHandleLogWriter+  , stdoutLogWriter   ) where  import           Control.Eff-import           Control.Eff.Extend+import           Control.Eff.Reader.Strict import           Control.Eff.Log.Message-import           Data.Default-import           Data.Function                  ( fix )+import           Control.Eff.Log.MessageRenderer import           Control.Monad                  ( (>=>)                                                 , when                                                 )-import           Control.Monad.Base             ( MonadBase() )-import qualified Control.Monad.Catch           as Catch-import           Control.Monad.Trans.Control    ( MonadBaseControl-                                                  ( restoreM-                                                  , liftBaseWith-                                                  , StM-                                                  )-                                                )-import           Control.Eff.Writer.Strict      ( Writer, tell, runListWriter )-import           Data.Kind-import           Data.Foldable                  (traverse_)+import qualified Data.Text.IO as Text+import           Data.Text (Text)+import qualified System.IO as IO  -- | A function that takes a log message and returns an effect that -- /logs/ the message.-newtype LogWriter writerM = MkLogWriter-  { runLogWriter :: LogMessage -> LogWriterM writerM ()+newtype LogWriter = MkLogWriter+  { runLogWriter :: LogMessage -> IO ()   } -instance Applicative (LogWriterM w) => Default (LogWriter w) where-  def = MkLogWriter (const (pure ()))+instance Semigroup LogWriter where+  (MkLogWriter l) <> (MkLogWriter r) = MkLogWriter (l >> r) +instance Monoid LogWriter where+  mempty = MkLogWriter (const (pure ()))++-- | A 'Reader' effect for 'LogWriter's.+--+-- @since 0.31.0+type LogWriterReader = Reader LogWriter+ -- | Provide the 'LogWriter' -- -- Exposed for custom extensions, if in doubt use 'withLogging'.-runLogWriterReader :: LogWriter h -> Eff (LogWriterReader h ': e) a -> Eff e a-runLogWriterReader e m = fix (handle_relay (\x _ -> return x)) m e+runLogWriterReader :: LogWriter -> Eff (Reader LogWriter ': e) a -> Eff e a+runLogWriterReader = runReader  -- | Get the current 'LogWriter'.-askLogWriter-  :: SetMember LogWriterReader (LogWriterReader h) e => Eff e (LogWriter h)-askLogWriter = send AskLogWriter+askLogWriter :: Member LogWriterReader e => Eff e LogWriter+askLogWriter = ask  -- | Modify the current 'LogWriter'. localLogWriterReader-  :: forall h e a-   . SetMember LogWriterReader (LogWriterReader h) e-  => (LogWriter h -> LogWriter h)+  :: forall e a+   . Member LogWriterReader e+  => (LogWriter -> LogWriter)   -> Eff e a   -> Eff e a-localLogWriterReader f m =-  f-    <$> askLogWriter-    >>= fix (respond_relay @(LogWriterReader h) (\x _ -> return x)) m---- | A Reader specialized for 'LogWriter's------ The existing @Reader@ couldn't be used together with 'SetMember', so this--- lazy reader was written, specialized to reading 'LogWriter'.-data LogWriterReader h v where-  AskLogWriter :: LogWriterReader h (LogWriter h)--instance Handle (LogWriterReader h) e a (LogWriter h -> k) where-  handle k q AskLogWriter lw = k (q ^$ lw) lw--instance forall h m r. (MonadBase m m, LiftedBase m r)-  => MonadBaseControl m (Eff (LogWriterReader h ': r)) where-  type StM (Eff (LogWriterReader h ': r)) a =  StM (Eff r) a-  liftBaseWith f = do-    lf <- askLogWriter-    raise (liftBaseWith (\runInBase -> f (runInBase . runLogWriterReader lf)))-  restoreM = raise . restoreM--instance (LiftedBase m e, Catch.MonadThrow (Eff e))-  => Catch.MonadThrow (Eff (LogWriterReader h ': e)) where-  throwM exception = raise (Catch.throwM exception)--instance (Applicative m, LiftedBase m e, Catch.MonadCatch (Eff e))-  => Catch.MonadCatch (Eff (LogWriterReader h ': e)) where-  catch effect handler = do-    lf <- askLogWriter-    let lower         = runLogWriterReader lf-        nestedEffects = lower effect-        nestedHandler exception = lower (handler exception)-    raise (Catch.catch nestedEffects nestedHandler)--instance (Applicative m, LiftedBase m e, Catch.MonadMask (Eff e))-  => Catch.MonadMask (Eff (LogWriterReader h ': e)) where-  mask maskedEffect = do-    lf <- askLogWriter-    let lower :: Eff (LogWriterReader h ': e) a -> Eff e a-        lower = runLogWriterReader lf-    raise-      (Catch.mask-        (\nestedUnmask -> lower (maskedEffect (raise . nestedUnmask . lower)))-      )-  uninterruptibleMask maskedEffect = do-    lf <- askLogWriter-    let lower :: Eff (LogWriterReader h ': e) a -> Eff e a-        lower = runLogWriterReader lf-    raise-      (Catch.uninterruptibleMask-        (\nestedUnmask -> lower (maskedEffect (raise . nestedUnmask . lower)))-      )-  generalBracket acquire release useIt = do-    lf <- askLogWriter-    let lower :: Eff (LogWriterReader h ': e) a -> Eff e a-        lower = runLogWriterReader lf-    raise-      (Catch.generalBracket (lower acquire)-                            (((.) . (.)) lower release)-                            (lower . useIt)-      )---- * 'LogWriter' Zoo---- | The instances of this class are the monads that define (side-) effect(s) of writting logs.-class HandleLogWriter (writer :: Type -> Type) where-  -- | The 'Eff'ects required by the 'handleLogWriterEffect' method.-  ---  -- @since 0.29.1-  data family LogWriterM writer a--  -- | Run the side effect of a 'LogWriter' in a compatible 'Eff'.-  handleLogWriterEffect :: (Member writer e) => LogWriterM writer () -> Eff e ()--  -- | Write a message using the 'LogWriter' found in the environment.-  ---  -- The semantics of this function are a combination of 'runLogWriter' and 'handleLogWriterEffect',-  -- with the 'LogWriter' read from a 'LogWriterReader'.-  liftWriteLogMessage :: ( SetMember LogWriterReader (LogWriterReader writer) e-                         , Member writer e-                         )-                      => LogMessage-                      -> Eff e ()-  liftWriteLogMessage m = do-    w <- askLogWriter-    handleLogWriterEffect (runLogWriter w m)---- | Embed 'IO' actions consuming all 'LogMessage's------ @since 0.29.1-instance HandleLogWriter (Lift IO) where-  newtype instance LogWriterM (Lift IO) a = IOLogWriter { runIOLogWriter :: IO a }-          deriving (Applicative, Functor, Monad)-  handleLogWriterEffect = send . Lift . runIOLogWriter-+localLogWriterReader = local --- | A 'LogWriter' monad for capturing messages using a 'Writer'.------ The 'HandleLogWriter' instance for this type assumes a 'Writer' effect.-instance HandleLogWriter (Writer LogMessage) where-  -- | A 'LogWriter' monad that provides pure logging by capturing via the 'Writer' effect.-  newtype LogWriterM (Writer LogMessage) a = MkCaptureLogs { unCaptureLogs :: Eff '[Writer LogMessage] a }-    deriving (Functor, Applicative, Monad)-  handleLogWriterEffect =-    traverse_ (tell @LogMessage) . snd . run . runListWriter . unCaptureLogs+-- | Write a message using the 'LogWriter' found in the environment.+liftWriteLogMessage+  :: ( Member LogWriterReader  e, Lifted IO e)+  => LogMessage+  -> Eff e ()+liftWriteLogMessage m = do+  w <- askLogWriter+  lift (runLogWriter w m)  -- | This 'LogWriter' will discard all messages. ----- NOTE: This is just an alias for 'def'-noOpLogWriter :: Applicative (LogWriterM m) => LogWriter m-noOpLogWriter = def+-- NOTE: This is just an alias for 'mempty'+noOpLogWriter :: LogWriter+noOpLogWriter = mempty  -- | A 'LogWriter' that applies a predicate to the 'LogMessage' and delegates to -- to the given writer of the predicate is satisfied.-filteringLogWriter :: Monad (LogWriterM e) => LogPredicate -> LogWriter e -> LogWriter e+filteringLogWriter :: LogPredicate -> LogWriter -> LogWriter filteringLogWriter p lw =   MkLogWriter (\msg -> when (p msg) (runLogWriter lw msg))  -- | A 'LogWriter' that applies a function to the 'LogMessage' and delegates the result to -- to the given writer.-mappingLogWriter :: (LogMessage -> LogMessage) -> LogWriter e -> LogWriter e+mappingLogWriter :: (LogMessage -> LogMessage) -> LogWriter -> LogWriter mappingLogWriter f lw = MkLogWriter (runLogWriter lw . f)  -- | Like 'mappingLogWriter' allow the function that changes the 'LogMessage' to have effects.-mappingLogWriterM-  :: Monad (LogWriterM e) => (LogMessage -> LogWriterM e LogMessage) -> LogWriter e -> LogWriter e-mappingLogWriterM f lw = MkLogWriter (f >=> runLogWriter lw)+mappingLogWriterIO+  :: (LogMessage -> IO LogMessage) -> LogWriter -> LogWriter+mappingLogWriterIO f lw = MkLogWriter (f >=> runLogWriter lw)++-- | Append the 'LogMessage' to an 'IO.Handle' after rendering it.+--+-- @since 0.31.0+ioHandleLogWriter :: IO.Handle -> LogMessageRenderer Text -> LogWriter+ioHandleLogWriter outH r = MkLogWriter (Text.hPutStrLn outH . r)++-- | Render a 'LogMessage' to 'IO.stdout'.+--+-- This function will also set the 'IO.BufferMode' of 'IO.stdout' to 'IO.LineBuffering'.+--+-- See 'ioHandleLogWriter'.+--+-- @since 0.31.0+stdoutLogWriter :: LogMessageRenderer Text -> IO LogWriter+stdoutLogWriter render = do+  IO.hSetBuffering IO.stdout IO.LineBuffering+  return (ioHandleLogWriter IO.stdout render)

@@ -10,7 +10,7 @@ import           Control.DeepSeq import           Control.Eff                   as Eff import           Control.Eff.Log-import           Control.Eff.LogWriter.IO+import           Control.Eff.LogWriter.Rich import           Control.Exception              ( evaluate ) import           Control.Monad                  ( unless ) import           Control.Monad.Trans.Control    ( MonadBaseControl@@ -21,7 +21,7 @@ import           Data.Text                     as T  --- | This is a wrapper around 'withAsyncLogWriter' and 'withIoLogging'.+-- | This is a wrapper around 'withAsyncLogWriter' and 'withRichLogging'. -- -- Example: --@@ -36,17 +36,17 @@ -- withAsyncLogging   :: (Lifted IO e, MonadBaseControl IO (Eff e), Integral len)-  => LogWriter (Lift IO)+  => LogWriter   -> len -- ^ Size of the log message input queue. If the queue is full, message          -- are dropped silently.   -> Text -- ^ The default application name to put into the 'lmAppName' field.   -> Facility -- ^ The default RFC-5424 facility to put into the 'lmFacility' field.   -> LogPredicate -- ^ The inital predicate for log messages, there are some pre-defined in "Control.Eff.Log.Message#PredefinedPredicates"-  -> Eff (Logs : LogWriterReader (Lift IO) : e) a+  -> Eff (Logs : LogWriterReader : e) a   -> Eff e a withAsyncLogging lw queueLength a f p e = liftBaseOp-  (withAsyncLogChannel queueLength (runIOLogWriter . runLogWriter lw . force))-  (\lc -> withIoLogging (makeLogChannelWriter lc) a f p e)+  (withAsyncLogChannel queueLength (runLogWriter lw . force))+  (\lc -> withRichLogging (makeLogChannelWriter lc) a f p e)   -- | /Move/ the current 'LogWriter' into its own thread.@@ -72,14 +72,14 @@ -- > -- withAsyncLogWriter-  :: (LogIo e, MonadBaseControl IO (Eff e), Integral len)+  :: (IoLogging e, MonadBaseControl IO (Eff e), Integral len)   => len -- ^ Size of the log message input queue. If the queue is full, message          -- are dropped silently.   -> Eff e a   -> Eff e a withAsyncLogWriter queueLength e = do   lw <- askLogWriter-  liftBaseOp (withAsyncLogChannel queueLength (runIOLogWriter . runLogWriter lw . force))+  liftBaseOp (withAsyncLogChannel queueLength (runLogWriter lw . force))              (\lc -> setLogWriter (makeLogChannelWriter lc) e)  withAsyncLogChannel@@ -101,8 +101,8 @@     traverse_ ioWriter ms     logLoop tq -makeLogChannelWriter :: LogChannel -> LogWriter (Lift IO)-makeLogChannelWriter lc = mkLogWriterIO logChannelPutIO+makeLogChannelWriter :: LogChannel -> LogWriter+makeLogChannelWriter lc = MkLogWriter logChannelPutIO  where   logChannelPutIO (force -> me) = do     !m <- evaluate me

@@ -1,37 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--- | Capture 'LogMessage's to a 'Writer'.------ See 'Control.Eff.Log.Examples.exampleLogCapture'-module Control.Eff.LogWriter.Capture-  ( captureLogWriter-  , CaptureLogs-  , CaptureLogWriter-  , runCaptureLogWriter-  )-where--import           Control.Eff                   as Eff-import           Control.Eff.Log-import           Control.Eff.Writer.Strict      ( Writer-                                                , tell-                                                , runListWriter-                                                )---- | A 'LogWriter' monad that provides pure logging by capturing via the 'Writer' effect.------ See 'Control.Eff.Log.Examples.exampleLogCapture'-captureLogWriter :: LogWriter CaptureLogWriter-captureLogWriter = MkLogWriter (MkCaptureLogs . tell)---- | A 'LogWriter' monad that provides pure logging by capturing via the 'Writer' effect.-type CaptureLogs a = LogWriterM CaptureLogWriter a---- | Run a 'Writer' for 'LogMessage's.------ Such a 'Writer' is needed to handle 'CaptureLogWriter'-runCaptureLogWriter-  :: Eff (CaptureLogWriter ': e) a -> Eff e (a, [LogMessage])-runCaptureLogWriter = runListWriter---- | Alias for the 'Writer' that contains the captured 'LogMessage's from 'CaptureLogs'.-type CaptureLogWriter = Writer LogMessage

@@ -3,18 +3,15 @@   ( withConsoleLogWriter   , withConsoleLogging   , consoleLogWriter-  , stdoutLogWriter   ) where  import Control.Eff as Eff import Control.Eff.Log-import Control.Eff.LogWriter.IO+import Control.Eff.LogWriter.Rich import Data.Text-import qualified Data.Text.IO                  as T-import qualified System.IO                     as IO  -- | Enable logging to @standard output@ using the 'consoleLogWriter', with some 'LogMessage' fields preset--- as in 'withIoLogging'.+-- as in 'withRichLogging'. -- -- Log messages are rendered using 'renderLogMessageConsoleLog'. --@@ -26,17 +23,17 @@ -- >   $ withConsoleLogging "my-app" local7 allLogMessages -- >   $ logInfo "Oh, hi there" ----- To vary the 'LogWriter' use 'withIoLogging'.+-- To vary the 'LogWriter' use 'withRichLogging'. withConsoleLogging   :: Lifted IO e   => Text -- ^ The default application name to put into the 'lmAppName' field.   -> Facility -- ^ The default RFC-5424 facility to put into the 'lmFacility' field.   -> LogPredicate -- ^ The inital predicate for log messages, there are some pre-defined in "Control.Eff.Log.Message#PredefinedPredicates"-  -> Eff (Logs : LogWriterReader (Lift IO) : e) a+  -> Eff (Logs : LogWriterReader : e) a   -> Eff e a withConsoleLogging a b c d = do-  lift (IO.hSetBuffering IO.stdout IO.LineBuffering)-  withIoLogging consoleLogWriter a b c d+  lw <- lift consoleLogWriter+  withRichLogging lw a b c d   -- | Enable logging to @standard output@ using the 'consoleLogWriter'.@@ -48,22 +45,21 @@ -- > exampleWithConsoleLogWriter :: IO () -- > exampleWithConsoleLogWriter = -- >     runLift--- >   $ withSomeLogging @IO+-- >   $ withoutLogging @IO -- >   $ withConsoleLogWriter -- >   $ logInfo "Oh, hi there" withConsoleLogWriter-  :: (LogIo e)+  :: (IoLogging e)   => Eff e a -> Eff e a withConsoleLogWriter e = do-  lift (IO.hSetBuffering IO.stdout IO.LineBuffering)-  addLogWriter consoleLogWriter e+  lw <- lift consoleLogWriter+  addLogWriter lw e --- | Write 'LogMessage's to standard output, formatted with 'printLogMessage'.------ It uses 'stdoutLogWriter' with 'renderLogMessageConsoleLog'.-consoleLogWriter :: LogWriter (Lift IO)-consoleLogWriter = mkLogWriterIO (T.putStrLn . renderLogMessageConsoleLog) --- | A 'LogWriter' that uses a 'LogMessageRenderer' to render, and 'T.putStrLn' to print it.-stdoutLogWriter :: LogMessageRenderer Text -> LogWriter (Lift IO)-stdoutLogWriter render = mkLogWriterIO (T.putStrLn . render)+-- | Render a 'LogMessage' to 'IO.stdout' using 'renderLogMessageConsoleLog'.+--+-- See 'stdoutLogWriter'.+--+-- @since 0.31.0+consoleLogWriter :: IO LogWriter+consoleLogWriter = stdoutLogWriter renderLogMessageConsoleLog

@@ -9,11 +9,11 @@ import           Debug.Trace import           Control.Eff                   as Eff import           Control.Eff.Log-import           Control.Eff.LogWriter.IO+import           Control.Eff.LogWriter.Rich import           Data.Text                     as T  -- | Enable logging via 'traceM' using the 'debugTraceLogWriter', with some 'LogMessage' fields preset--- as in 'withIoLogging'.+-- as in 'withRichLogging'. -- -- Log messages are rendered using 'renderLogMessageConsoleLog'. --@@ -29,9 +29,9 @@   => Text -- ^ The default application name to put into the 'lmAppName' field.   -> Facility -- ^ The default RFC-5424 facility to put into the 'lmFacility' field.   -> LogPredicate -- ^ The inital predicate for log messages, there are some pre-defined in "Control.Eff.Log.Message#PredefinedPredicates"-  -> Eff (Logs : LogWriterReader (Lift IO) : e) a+  -> Eff (Logs : LogWriterReader : e) a   -> Eff e a-withTraceLogging = withIoLogging (debugTraceLogWriter renderLogMessageConsoleLog)+withTraceLogging = withRichLogging (debugTraceLogWriter renderLogMessageConsoleLog)   -- | Enable logging via 'traceM' using the 'debugTraceLogWriter'. The@@ -44,12 +44,12 @@ -- > exampleWithTraceLogWriter :: IO () -- > exampleWithTraceLogWriter = -- >     runLift--- >   $ withSomeLogging @IO+-- >   $ withoutLogging @IO -- >   $ withTraceLogWriter -- >   $ logInfo "Oh, hi there"-withTraceLogWriter :: forall h e a . (Monad (LogWriterM h), LogsTo h e) => Eff e a -> Eff e a-withTraceLogWriter = addLogWriter @h (debugTraceLogWriter renderLogMessageConsoleLog)+withTraceLogWriter :: IoLogging e => Eff e a -> Eff e a+withTraceLogWriter = addLogWriter (debugTraceLogWriter renderLogMessageConsoleLog)  -- | Write 'LogMessage's  via 'traceM'.-debugTraceLogWriter :: forall h . (Monad (LogWriterM h)) => LogMessageRenderer Text -> LogWriter h+debugTraceLogWriter :: LogMessageTextRenderer -> LogWriter debugTraceLogWriter render = MkLogWriter (traceM . T.unpack . render)

@@ -7,7 +7,7 @@  import           Control.Eff                   as Eff import           Control.Eff.Log-import           Control.Eff.LogWriter.IO+import           Control.Eff.LogWriter.Rich import           GHC.Stack import           Data.Text                     as T import qualified System.IO                     as IO@@ -22,7 +22,7 @@                                                 )  -- | Enable logging to a file, with some 'LogMessage' fields preset--- as described in 'withIoLogging'.+-- as described in 'withRichLogging'. -- -- If the file or its directory does not exist, it will be created. --@@ -31,20 +31,21 @@ -- > exampleWithFileLogging :: IO () -- > exampleWithFileLogging = -- >     runLift--- >   $ withFileLogging "/var/log/my-app.log" "my-app" local7 allLogMessages+-- >   $ withFileLogging "/var/log/my-app.log" "my-app" local7 allLogMessages renderLogMessageConsoleLog -- >   $ logInfo "Oh, hi there" ----- To vary the 'LogWriter' use 'withIoLogging'.+-- To vary the 'LogWriter' use 'withRichLogging'. withFileLogging-  :: (Lifted IO e, MonadBaseControl IO (Eff e))+  :: (Lifted IO e, MonadBaseControl IO (Eff e), HasCallStack)   => FilePath -- ^ Path to the log-file.   -> Text -- ^ The default application name to put into the 'lmAppName' field.   -> Facility -- ^ The default RFC-5424 facility to put into the 'lmFacility' field.   -> LogPredicate -- ^ The inital predicate for log messages, there are some pre-defined in "Control.Eff.Log.Message#PredefinedPredicates"-  -> Eff (Logs : LogWriterReader (Lift IO) : e) a+  -> LogMessageTextRenderer -- ^ The 'LogMessage' render function+  -> Eff (Logs : LogWriterReader : e) a   -> Eff e a-withFileLogging fnIn a f p e = do-  liftBaseOp (withOpenedLogFile fnIn) (\lw -> withIoLogging lw a f p e)+withFileLogging fnIn a f p render e = do+  liftBaseOp (withOpenedLogFile fnIn render) (\lw -> withRichLogging lw a f p e)   -- | Enable logging to a file.@@ -55,19 +56,25 @@ -- > exampleWithFileLogWriter :: IO () -- > exampleWithFileLogWriter = -- >     runLift--- >   $ withSomeLogging @IO--- >   $ withFileLogWriter "test.log"+-- >   $ withoutLogging+-- >   $ withFileLogWriter "test.log" renderLogMessageConsoleLog -- >   $ logInfo "Oh, hi there" withFileLogWriter-  :: (LogIo e, MonadBaseControl IO (Eff e))+  :: (IoLogging e, MonadBaseControl IO (Eff e), HasCallStack)   => FilePath -- ^ Path to the log-file.+  -> LogMessageTextRenderer   -> Eff e b   -> Eff e b-withFileLogWriter fnIn e =-  liftBaseOp (withOpenedLogFile fnIn) (`addLogWriter` e)+withFileLogWriter fnIn render e =+  liftBaseOp (withOpenedLogFile fnIn render) (`addLogWriter` e) -withOpenedLogFile :: HasCallStack => FilePath -> (LogWriter (Lift IO) -> IO a) -> IO a-withOpenedLogFile fnIn ioE = Safe.bracket+withOpenedLogFile+  :: HasCallStack+  => FilePath+  -> LogMessageTextRenderer+  -> (LogWriter -> IO a)+  -> IO a+withOpenedLogFile fnIn render ioE = Safe.bracket   (do     fnCanon <- canonicalizePath fnIn     createDirectoryIfMissing True (takeDirectory fnCanon)@@ -76,4 +83,4 @@     return h   )   (\h -> Safe.try @IO @Catch.SomeException (IO.hFlush h) >> IO.hClose h)-  (\h -> ioE (ioHandleLogWriter h))+  (\h -> ioE (ioHandleLogWriter h render))

@@ -1,89 +0,0 @@--- | Functions for generic, IO-based 'LogWriter's.------ This module is more low-level than the others in this directory.-module Control.Eff.LogWriter.IO-  ( mkLogWriterIO-  , ioHandleLogWriter-  , defaultIoLogWriter-  , withIoLogging-  , LoggingAndIo-  , printLogMessage-  )-where--import           Control.Eff                   as Eff-import           Control.Eff.Log-import           Control.Monad                  ( (>=>) )-import           Control.Lens                   (set)-import           Data.Text-import qualified System.IO                     as IO-import           GHC.Stack-import qualified Data.Text.IO                  as T---- | A 'LogWriter' that uses an 'IO' action to write the message.------ This is just an alias for 'MkLogWriter' but with @IO@ as parameter. This reduces the need to--- apply something to the extra type argument @\@IO@.------ Example use cases for this function are the 'consoleLogWriter' and the 'ioHandleLogWriter'.-mkLogWriterIO :: HasCallStack => (LogMessage -> IO ()) -> LogWriter (Lift IO)-mkLogWriterIO f = MkLogWriter (IOLogWriter . f)---- | A 'LogWriter' that renders 'LogMessage's to strings via 'renderLogMessageConsoleLog'--- and prints them to an 'IO.Handle' using 'hPutStrLn'.-ioHandleLogWriter :: HasCallStack => IO.Handle -> LogWriter (Lift IO)-ioHandleLogWriter h =-  mkLogWriterIO (T.hPutStrLn h . renderLogMessageConsoleLog)---- | Enable logging to IO using the 'defaultIoLogWriter'.------ Example:------ > exampleWithIoLogging :: IO ()--- > exampleWithIoLogging =--- >     runLift--- >   $ withIoLogging debugTraceLogWriter--- >                   "my-app"--- >                   local7--- >                   (lmSeverityIsAtLeast informationalSeverity)--- >   $ logInfo "Oh, hi there"----withIoLogging-  :: Lifted IO e-  => LogWriter (Lift IO) -- ^ The 'LogWriter' that will be used to write log messages.-  -> Text -- ^ The default application name to put into the 'lmAppName' field.-  -> Facility -- ^ The default RFC-5424 facility to put into the 'lmFacility' field.-  -> LogPredicate -- ^ The inital predicate for log messages, there are some pre-defined in "Control.Eff.Log.Message#PredefinedPredicates"-  -> Eff (Logs : LogWriterReader (Lift IO) : e) a-  -> Eff e a-withIoLogging lw appName facility defaultPredicate =-  withLogging (defaultIoLogWriter appName facility lw)-    . setLogPredicate defaultPredicate---- | Decorate an IO based 'LogWriter' to fill out these fields in 'LogMessage's:------ * The messages will carry the given application name in the 'lmAppName' field.--- * The 'lmTimestamp' field contains the UTC time of the log event--- * The 'lmHostname' field contains the FQDN of the current host--- * The 'lmFacility' field contains the given 'Facility'------ It works by using 'mappingLogWriterM'.-defaultIoLogWriter-  :: Text -- ^ The default application name to put into the 'lmAppName' field.-  -> Facility -- ^ The default RFC-5424 facility to put into the 'lmFacility' field.-  -> LogWriter (Lift IO )-- ^ The IO based writer to decorate-  -> LogWriter (Lift IO)-defaultIoLogWriter appName facility = mappingLogWriterM-  (   (IOLogWriter . setLogMessageTimestamp)-  >=> (IOLogWriter . setLogMessageHostname)-  >=> pure-  .   set lmFacility facility-  .   set lmAppName  (Just appName)-  )---- | The concrete list of 'Eff'ects for logging with an IO based 'LogWriter', and a 'LogWriterReader'.-type LoggingAndIo = '[Logs, LogWriterReader (Lift IO), Lift IO]---- | Render a 'LogMessage' but set the timestamp and thread id fields.-printLogMessage :: LogMessage -> IO ()-printLogMessage = T.putStrLn . renderLogMessageConsoleLog

@@ -0,0 +1,59 @@+-- | Enrich 'LogMessage's with timestamps and OS dependent information.+module Control.Eff.LogWriter.Rich+  ( richLogWriter+  , withRichLogging+  , stdoutLogWriter+  )+where++import           Control.Eff                   as Eff+import           Control.Eff.Log+import           Control.Monad                  ( (>=>) )+import           Control.Lens                   (set)+import           Data.Text++-- | Enable logging to IO using the 'richLogWriter'.+--+-- Example:+--+-- > exampleWithIoLogging :: IO ()+-- > exampleWithIoLogging =+-- >     runLift+-- >   $ withRichLogging debugTraceLogWriter+-- >                   "my-app"+-- >                   local7+-- >                   (lmSeverityIsAtLeast informationalSeverity)+-- >   $ logInfo "Oh, hi there"+--+withRichLogging+  :: Lifted IO e+  => LogWriter -- ^ The 'LogWriter' that will be used to write log messages.+  -> Text -- ^ The default application name to put into the 'lmAppName' field.+  -> Facility -- ^ The default RFC-5424 facility to put into the 'lmFacility' field.+  -> LogPredicate -- ^ The inital predicate for log messages, there are some pre-defined in "Control.Eff.Log.Message#PredefinedPredicates"+  -> Eff (Logs : LogWriterReader : e) a+  -> Eff e a+withRichLogging lw appName facility defaultPredicate =+  withLogging (richLogWriter appName facility lw)+    . setLogPredicate defaultPredicate++-- | Decorate an IO based 'LogWriter' to fill out these fields in 'LogMessage's:+--+-- * The messages will carry the given application name in the 'lmAppName' field.+-- * The 'lmTimestamp' field contains the UTC time of the log event+-- * The 'lmHostname' field contains the FQDN of the current host+-- * The 'lmFacility' field contains the given 'Facility'+--+-- It works by using 'mappingLogWriterIO'.+richLogWriter+  :: Text -- ^ The default application name to put into the 'lmAppName' field.+  -> Facility -- ^ The default RFC-5424 facility to put into the 'lmFacility' field.+  -> LogWriter -- ^ The IO based writer to decorate+  -> LogWriter+richLogWriter appName facility = mappingLogWriterIO+  (   setLogMessageTimestamp+  >=> setLogMessageHostname+  >=> pure+  .   set lmFacility facility+  .   set lmAppName  (Just appName)+  )

@@ -7,7 +7,7 @@  import           Control.Eff                   as Eff import           Control.Eff.Log-import           Control.Eff.LogWriter.IO+import           Control.Eff.LogWriter.Rich import           Data.Text                     as T import           Data.Text.Encoding            as T import qualified Control.Exception.Safe        as Safe@@ -21,7 +21,7 @@ import           Network.Socket.ByteString  -- | Enable logging to a remote host via __UDP__, with some 'LogMessage' fields preset--- as in 'withIoLogging'.+-- as in 'withRichLogging'. -- -- See 'Control.Eff.Log.Examples.exampleUdpRFC3164Logging' withUDPLogging@@ -32,18 +32,18 @@   -> Text -- ^ The default application name to put into the 'lmAppName' field.   -> Facility -- ^ The default RFC-5424 facility to put into the 'lmFacility' field.   -> LogPredicate -- ^ The inital predicate for log messages, there are some pre-defined in "Control.Eff.Log.Message#PredefinedPredicates"-  -> Eff (Logs : LogWriterReader (Lift IO) : e) a+  -> Eff (Logs : LogWriterReader : e) a   -> Eff e a withUDPLogging render hostname port a f p e = liftBaseOp   (withUDPSocket render hostname port)-  (\lw -> withIoLogging lw a f p e)+  (\lw -> withRichLogging lw a f p e)   -- | Enable logging to a (remote-) host via UDP. -- -- See 'Control.Eff.Log.Examples.exampleUdpRFC3164Logging' withUDPLogWriter-  :: (LogIo e, MonadBaseControl IO (Eff e), HasCallStack)+  :: (IoLogging e, MonadBaseControl IO (Eff e), HasCallStack)   => (LogMessage -> Text) -- ^ 'LogMessage' rendering function   -> String -- ^ Hostname or IP   -> String -- ^ Port e.g. @"514"@@@ -58,7 +58,7 @@   => (LogMessage -> Text) -- ^ 'LogMessage' rendering function   -> String -- ^ Hostname or IP   -> String -- ^ Port e.g. @"514"@-  -> (LogWriter (Lift IO) -> IO a)+  -> (LogWriter -> IO a)   -> IO a withUDPSocket render hostname port ioE = Safe.bracket   (do@@ -72,7 +72,7 @@       let addr = addrAddress a       in         ioE-          (mkLogWriterIO+          (MkLogWriter             (\lmStr ->               void $ sendTo s (T.encodeUtf8 (render lmStr)) addr             )

@@ -7,7 +7,7 @@  import           Control.Eff                   as Eff import           Control.Eff.Log-import           Control.Eff.LogWriter.IO+import           Control.Eff.LogWriter.Rich import           Data.Text                     as T import           Data.Text.Encoding            as T import qualified Control.Exception.Safe        as Safe@@ -21,7 +21,7 @@ import           Network.Socket.ByteString  -- | Enable logging to a /unix domain socket/, with some 'LogMessage' fields preset--- as in 'withIoLogging'.+-- as in 'withRichLogging'. -- -- See 'Control.Eff.Log.Examples.exampleDevLogSyslogLogging' withUnixSocketLogging@@ -31,17 +31,17 @@   -> Text -- ^ The default application name to put into the 'lmAppName' field.   -> Facility -- ^ The default RFC-5424 facility to put into the 'lmFacility' field.   -> LogPredicate -- ^ The inital predicate for log messages, there are some pre-defined in "Control.Eff.Log.Message#PredefinedPredicates"-  -> Eff (Logs : LogWriterReader (Lift IO) : e) a+  -> Eff (Logs : LogWriterReader : e) a   -> Eff e a withUnixSocketLogging render socketPath a f p e = liftBaseOp   (withUnixSocketSocket render socketPath)-  (\lw -> withIoLogging lw a f p e)+  (\lw -> withRichLogging lw a f p e)  -- | Enable logging to a (remote-) host via UnixSocket. -- -- See 'Control.Eff.Log.Examples.exampleDevLogSyslogLogging' withUnixSocketLogWriter-  :: (LogIo e, MonadBaseControl IO (Eff e), HasCallStack)+  :: (IoLogging e, MonadBaseControl IO (Eff e), HasCallStack)   => LogMessageRenderer Text -- ^ 'LogMessage' rendering function   -> FilePath -- ^ Path to the socket file   -> Eff e b@@ -53,7 +53,7 @@   :: HasCallStack   => LogMessageRenderer Text -- ^ 'LogMessage' rendering function   -> FilePath -- ^ Path to the socket file-  -> (LogWriter (Lift IO) -> IO a)+  -> (LogWriter -> IO a)   -> IO a withUnixSocketSocket render socketPath ioE = Safe.bracket   (socket AF_UNIX Datagram defaultProtocol)@@ -62,7 +62,7 @@       let addr = SockAddrUnix socketPath       in         ioE-          (mkLogWriterIO+          (MkLogWriter             (\lmStr ->               void $ sendTo s (T.encodeUtf8 (render lmStr)) addr             )

@@ -33,13 +33,11 @@                                                as Scheduler import           Control.Eff.Extend import           Control.Monad-import           Control.Lens import           Data.Default import           Data.Foldable import           Data.Text                      ( Text                                                 , pack                                                 )-import qualified Data.Text                     as T import           Data.Typeable           hiding ( cast ) import           GHC.Stack import           Test.Tasty              hiding ( Timeout@@ -67,29 +65,14 @@ runTestCase :: TestName -> Eff Effects () -> TestTree runTestCase msg et =   testCase msg $ do-    IO.hSetBuffering IO.stdout IO.LineBuffering+    lw <- stdoutLogWriter renderConsoleMinimalisticWide     runLift-      $ withIoLogging (stdoutLogWriter renderMinimalisticWide) "unit-tests" local0 allLogMessages+      $ withRichLogging lw "unit-tests" local0 allLogMessages       $ Scheduler.schedule       $ handleInterrupts onInt         et   where onInt = lift . assertFailure . show --- | Render a 'LogMessage' human readable, for console logging-renderMinimalisticWide :: LogMessageRenderer T.Text-renderMinimalisticWide l =-  T.unwords $ filter-    (not . T.null)-    [ let s = l ^. lmSeverity . to (T.pack . show)-      in s <> T.replicate (max 0 (15 - T.length s)) " "-    , let p = fromMaybe " no proc " (l ^. lmProcessId)-      in p <> T.replicate (max 0 (55 - T.length p)) " "-    , let msg = l^.lmMessage-      in  msg <> T.replicate (max 0 (100 - T.length msg)) " "-    -- , fromMaybe "" (renderLogMessageSrcLoc l)-    ]-- withTestLogC :: (e -> IO ()) -> (IO (e -> IO ()) -> TestTree) -> TestTree withTestLogC doSchedule k = k (return doSchedule) @@ -102,7 +85,7 @@  scheduleAndAssert   :: forall r-   . (LogIo r)+   . (IoLogging r)   => IO (Eff (Processes r) () -> IO ())   -> ((String -> Bool -> Eff (Processes r) ()) -> Eff (Processes r) ())   -> IO ()@@ -121,7 +104,7 @@  applySchedulerFactory   :: forall r-   . (LogIo r)+   . (IoLogging r)   => IO (Eff (Processes r) () -> IO ())   -> Eff (Processes r) ()   -> IO ()

@@ -32,7 +32,7 @@  -- ---------------------------------------------------------------------------- -instance LogIo e => S.Server Small (Processes e) where+instance IoLogging e => S.Server Small (Processes e) where   data StartArgument Small (Processes e) = MkSmall   newtype instance Model Small = SmallModel String deriving Default   update _me MkSmall x =@@ -76,7 +76,7 @@  -- ---------------------------------------------------------------------------- -instance LogIo e => S.Server Big (Processes e) where+instance IoLogging e => S.Server Big (Processes e) where   data instance StartArgument Big (Processes e) = MkBig   newtype Model Big = BigModel String deriving Default   update me MkBig = \case

@@ -1,44 +1,130 @@ module LoggingTests where  import           Control.Eff+import qualified Control.Eff.LogWriter.UDP as UDP+import qualified Control.Eff.LogWriter.Async as Async import           Control.Eff.Concurrent import           Test.Tasty import           Test.Tasty.HUnit import           Common-import           Control.Lens       ((.~))+import           Control.Lens+import           Control.Monad.Trans.Control (liftBaseOp)   test_Logging :: TestTree-test_Logging = setTravisTestOptions $ testGroup "Logging"-  [ basics+test_Logging = setTravisTestOptions $ testGroup "logging"+  [ cencoredLogging   , strictness+  , testGroup "IO"+    [ liftedIoLogging+    , udpLogging+    , udpNestedLogging+    , asyncLogging+    , asyncNestedLogging+    ]   ] --basics :: HasCallStack => TestTree-basics =-  testCase "basic logging works" $-      pureLogs demo @?= (lmSrcLoc .~ Nothing) <$> [infoMessage "jo", debugMessage "oh"]+cencoredLogging :: HasCallStack => TestTree+cencoredLogging =+  testCase "log cencorship works" $ do+      res <- fmap (view lmMessage) <$> censoredLoggingTestImpl demo+      res @?=+        view lmMessage <$>+        [ infoMessage "1"+        , debugMessage "2"+        , infoMessage "x 1"+        , debugMessage "x 2"+        , infoMessage "x y 1"+        , debugMessage "x y 2"+        , infoMessage "x 1"+        , debugMessage "x 2"+        , infoMessage "1"+        , debugMessage "2"+        ]  where      demo :: ('[Logs] <:: e) => Eff e ()     demo = do-      logInfo "jo"-      logDebug "oh"+      logDebug "2"+      logInfo "1" -    pureLogs :: Eff '[Logs, LogWriterReader CaptureLogWriter, CaptureLogWriter] a -> [LogMessage]-    pureLogs =-        snd-      . run-      . runCaptureLogWriter-      . withLogging captureLogWriter-      . censorLogs @CaptureLogWriter (lmSrcLoc .~ Nothing)+    censoredLoggingTestImpl :: Eff '[Logs, LogWriterReader, Lift IO] () -> IO [LogMessage]+    censoredLoggingTestImpl e = do+      logs <- newMVar []+      runLift+       $ withLogging (MkLogWriter (\lm -> modifyMVar_ logs (\lms -> return (lm : lms))))+       $ do+           e+           censorLogs (lmMessage %~ ("x " <>)) $ do+              e+              censorLogs (lmMessage %~ ("y " <>)) e+              e+           e+      takeMVar logs  strictness :: HasCallStack => TestTree strictness =   testCase "messages failing the predicate are not deeply evaluated"     $ runLift-    $ withLogging consoleLogWriter+    $ withConsoleLogging "test-app" local0 allLogMessages     $ excludeLogMessages (lmSeverityIs errorSeverity)     $ do logDebug "test"          logError' ("test" <> error "TEST FAILED: this log statement should not have been evaluated deeply")+++liftedIoLogging :: HasCallStack => TestTree+liftedIoLogging =+  testCase "logging vs. MonadBaseControl"+    $ do outVar <- newEmptyMVar+         runLift+          $ withConsoleLogging "test-app" local0 allLogMessages+          $ (\ e -> liftBaseOp+                      (testWriter outVar)+                      (\doWrite ->+                            addLogWriter (MkLogWriter doWrite) e))+          $ logDebug "test"+         actual <- takeMVar outVar+         assertEqual "wrong log message" "test" actual+   where+     testWriter :: MVar String -> ((LogMessage -> IO ()) -> IO ()) -> IO ()+     testWriter outVar withWriter =+       withWriter (putMVar outVar . show)++test1234 :: Member Logs e => Eff e ()+test1234 = do+  logNotice "~~~~~~~~~~~~~~~~~~~~~~~~~~test 1~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"+  logNotice "~~~~~~~~~~~~~~~~~~~~~~~~~~test 2~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"+  logNotice "~~~~~~~~~~~~~~~~~~~~~~~~~~test 3~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"+  logNotice "~~~~~~~~~~~~~~~~~~~~~~~~~~test 4~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"++udpLogging :: HasCallStack => TestTree+udpLogging =+  testCase "udp logging"+    $ runLift+    $ UDP.withUDPLogging renderRFC5424NoLocation "localhost" "9999" "test-app" local0 allLogMessages+      test1234++udpNestedLogging :: HasCallStack => TestTree+udpNestedLogging =+  testCase "udp nested filteredlogging"+    $ runLift+        $ withConsoleLogging "test-app" local0 allLogMessages+        $ UDP.withUDPLogWriter renderRFC5424 "localhost" "9999"+          test1234++asyncLogging :: HasCallStack => TestTree+asyncLogging =+  testCase "async filteredlogging"+    $ do lw <- consoleLogWriter+         runLift+            $ Async.withAsyncLogging lw (1000::Int) "app-name" local0 allLogMessages+              test1234++asyncNestedLogging :: HasCallStack => TestTree+asyncNestedLogging =+  testCase "async nested filteredlogging"+    $ do lw <- consoleLogWriter+         runLift+          $ withLogging lw+          $ Async.withAsyncLogWriter (1000::Int)+            test1234

@@ -18,9 +18,9 @@             "Loops without space leaks"             [ testCase                     "scheduleMonadIOEff with many yields from replicateCheapM_"-                $ do+                $ do  lw <- consoleLogWriter                       res <--                          Scheduler.scheduleIOWithLogging  consoleLogWriter+                          Scheduler.scheduleIOWithLogging  lw                               $ replicateCheapM_ soMany yieldProcess                       res @=? Right ()             , testCase@@ -38,7 +38,7 @@             , testCase                     "'foreverCheap' inside a child process and 'replicateCheapM_' in the main process"                 $ do-                      res <- Scheduler.scheduleIOWithLogging  (mkLogWriterIO (T.putStrLn . (">>> " <>) . renderLogMessageConsoleLog))+                      res <- Scheduler.scheduleIOWithLogging  (MkLogWriter (T.putStrLn . (">>> " <>) . renderLogMessageConsoleLog))                               $ do                                     me <- self                                     spawn_ "test" (foreverCheap $ sendMessage me ())@@ -59,7 +59,7 @@             [ testCase "scheduleMonadIOEff with many yields from replicateM_"                 $ do                       res <--                          Scheduler.scheduleIOWithLogging  (mkLogWriterIO (T.putStrLn . (">>> " <>) . renderLogMessageConsoleLog))+                          Scheduler.scheduleIOWithLogging  (MkLogWriter (T.putStrLn . (">>> " <>) . renderLogMessageConsoleLog))                               $ replicateM_ soMany yieldProcess                       res @=? Right ()             , testCase@@ -79,7 +79,7 @@                     "'forever' inside a child process and 'replicateM_' in the main process"                 $ do                       res <--                          Scheduler.scheduleIOWithLogging  (mkLogWriterIO (T.putStrLn . (">>> " <>) . renderLogMessageConsoleLog))+                          Scheduler.scheduleIOWithLogging  (MkLogWriter (T.putStrLn . (">>> " <>) . renderLogMessageConsoleLog))                               $ do                                     me <- self                                     spawn_ "test" (forever $ sendMessage me ())

@@ -297,7 +297,7 @@   show StopTestObservable = "StopTestObservable"   show (TestObsReg x) = "TestObsReg " ++ show x -instance (LogIo r, HasProcesses r q) => S.Server TestObservable r where+instance (IoLogging r, HasProcesses r q) => S.Server TestObservable r where   data Init TestObservable r = TestObservableServerInit   type ServerEffects TestObservable r = ObserverRegistryState String ': r   runEffects _ _ = evalObserverRegistryState@@ -341,7 +341,7 @@   fromPdu _ = Nothing  -instance (LogIo r, HasProcesses r q) => M.Server TestObserver r where+instance (IoLogging r, HasProcesses r q) => M.Server TestObserver r where   data StartArgument TestObserver r = MkTestObserver   newtype instance Model TestObserver = TestObserverModel {fromTestObserverModel :: [String]} deriving Default   update _ MkTestObserver e =

@@ -10,7 +10,6 @@ import qualified Control.Eff.Concurrent.Process.SingleThreadedScheduler                                                as SingleThreaded import           Control.Applicative-import           Control.Lens                   ( view ) import           Data.List                      ( sort ) import           Data.Foldable                  ( traverse_ ) import           Data.Maybe@@ -24,14 +23,15 @@  test_forkIo :: TestTree test_forkIo = setTravisTestOptions $ withTestLogC-  (\c ->-    runLift-      $ withLogging-          (filteringLogWriter (lmSeverityIsAtLeast errorSeverity)-                              consoleLogWriter-          )-      $ withAsyncLogWriter (100 :: Int)-      $ ForkIO.schedule c+  (\c -> do+            lw <- stdoutLogWriter renderConsoleMinimalisticWide+            runLift+              $ withLogging+                  (filteringLogWriter (lmSeverityIsAtLeast errorSeverity)+                                      lw+                  )+              $ withAsyncLogWriter (100 :: Int)+              $ ForkIO.schedule c   )   (\factory -> testGroup "ForkIOScheduler" [allTests factory]) @@ -40,17 +40,19 @@ test_singleThreaded = setTravisTestOptions $ withTestLogC   (\e ->     let runEff :: Eff LoggingAndIo a -> IO a-        runEff = runLift . withLogging-          (mkLogWriterIO-            (\m -> when (view lmSeverity m < errorSeverity) (printLogMessage m))-          )+        runEff e' = do+          lw <- stdoutLogWriter renderConsoleMinimalisticWide+          runLift+           $ withLogging+               (filteringLogWriter (lmSeverityIsAtLeast errorSeverity) lw)+               e'     in  void $ SingleThreaded.scheduleM runEff yield e   )   (\factory -> testGroup "SingleThreadedScheduler" [allTests factory])  allTests   :: forall r-   . (LogIo r, Typeable r)+   . (IoLogging r, Typeable r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree allTests schedulerFactory = localOption@@ -111,7 +113,7 @@  returnToSenderServer   :: forall q-   . (HasCallStack, LogIo q, Typeable q)+   . (HasCallStack, IoLogging q, Typeable q)   => Eff (Processes q) (Endpoint ReturnToSender) returnToSenderServer = Callback.startLink @ReturnToSender $ Callback.onEvent   (\evt -> case evt of@@ -128,7 +130,7 @@  selectiveReceiveTests   :: forall r-   . (LogIo r, Typeable r)+   . (IoLogging r, Typeable r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree selectiveReceiveTests schedulerFactory = setTravisTestOptions@@ -208,7 +210,7 @@   delayTests-  :: forall r . (LogIo r) => IO (Eff (Processes r) () -> IO ()) -> TestTree+  :: forall r . (IoLogging r) => IO (Eff (Processes r) () -> IO ()) -> TestTree delayTests schedulerFactory =   let maxN = 100000   in  setTravisTestOptions@@ -262,7 +264,7 @@         )  yieldLoopTests-  :: forall r . (LogIo r) => IO (Eff (Processes r) () -> IO ()) -> TestTree+  :: forall r . (IoLogging r) => IO (Eff (Processes r) () -> IO ()) -> TestTree yieldLoopTests schedulerFactory =   let maxN = 100000   in  setTravisTestOptions@@ -301,7 +303,7 @@ instance NFData Pong  pingPongTests-  :: forall r . (LogIo r) => IO (Eff (Processes r) () -> IO ()) -> TestTree+  :: forall r . (IoLogging r) => IO (Eff (Processes r) () -> IO ()) -> TestTree pingPongTests schedulerFactory = testGroup   "Yield Tests"   [ testCase "ping pong a message between two processes, both don't yield"@@ -373,7 +375,7 @@   ]  errorTests-  :: forall r . (LogIo r) => IO (Eff (Processes r) () -> IO ()) -> TestTree+  :: forall r . (IoLogging r) => IO (Eff (Processes r) () -> IO ()) -> TestTree errorTests schedulerFactory = testGroup   "causing and handling errors"   [ testGroup@@ -416,7 +418,7 @@   ]  concurrencyTests-  :: forall r . (LogIo r) => IO (Eff (Processes r) () -> IO ()) -> TestTree+  :: forall r . (IoLogging r) => IO (Eff (Processes r) () -> IO ()) -> TestTree concurrencyTests schedulerFactory =   let n = 100   in@@ -533,7 +535,7 @@       ]  exitTests-  :: forall r . (LogIo r) => IO (Eff (Processes r) () -> IO ()) -> TestTree+  :: forall r . (IoLogging r) => IO (Eff (Processes r) () -> IO ()) -> TestTree exitTests schedulerFactory =   testGroup "process exit tests"     $ [ testGroup@@ -705,7 +707,7 @@   sendShutdownTests-  :: forall r . (LogIo r) => IO (Eff (Processes r) () -> IO ()) -> TestTree+  :: forall r . (IoLogging r) => IO (Eff (Processes r) () -> IO ()) -> TestTree sendShutdownTests schedulerFactory = testGroup   "sendShutdown"   [ testCase "... self" $ applySchedulerFactory schedulerFactory $ do@@ -801,7 +803,7 @@   ]  linkingTests-  :: forall r . (LogIo r) => IO (Eff (Processes r) () -> IO ()) -> TestTree+  :: forall r . (IoLogging r) => IO (Eff (Processes r) () -> IO ()) -> TestTree linkingTests schedulerFactory = setTravisTestOptions   (testGroup     "process linking tests"@@ -1021,7 +1023,7 @@   )  monitoringTests-  :: forall r . (LogIo r) => IO (Eff (Processes r) () -> IO ()) -> TestTree+  :: forall r . (IoLogging r) => IO (Eff (Processes r) () -> IO ()) -> TestTree monitoringTests schedulerFactory = setTravisTestOptions   (testGroup     "process monitoring tests"@@ -1123,7 +1125,7 @@   )  timerTests-  :: forall r . (LogIo r) => IO (Eff (Processes r) () -> IO ()) -> TestTree+  :: forall r . (IoLogging r) => IO (Eff (Processes r) () -> IO ()) -> TestTree timerTests schedulerFactory = setTravisTestOptions   (testGroup     "process timer tests"@@ -1179,7 +1181,7 @@   )  processDetailsTests-  :: forall r . (LogIo r) => IO (Eff (Processes r) () -> IO ()) -> TestTree+  :: forall r . (IoLogging r) => IO (Eff (Processes r) () -> IO ()) -> TestTree processDetailsTests schedulerFactory = setTravisTestOptions   (testGroup     "process info tests"