extensible-effects-concurrent 0.19.1 → 0.20.0

raw patch · 5 files changed

+295/−211 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• README.md +71/−23
• extensible-effects-concurrent.cabal +1/−1
• src/Control/Eff/Log/Handler.hs +33/−125
• src/Control/Eff/Log/Writer.hs +186/−62

@@ -1,5 +1,9 @@ # Changelog for extensible-effects-concurrent +## 0.20.0++- Rewrite Logging API so that usage is not as bloated+ ## 0.19.1  - Fix Travis build

@@ -1,29 +1,80 @@ # extensible-effects-concurrent -Message passing concurrency with 'forkIO' and 'extensible-effects' inspired by Erlang.- [![Build Status](https://travis-ci.org/sheyll/extensible-effects-concurrent.svg?branch=master)](https://travis-ci.org/sheyll/extensible-effects-concurrent)  [![Hackage](https://img.shields.io/hackage/v/extensible-effects-concurrent.svg?style=flat)](http://hackage.haskell.org/package/extensible-effects-concurrent) -Also included:+## From Erlang to Haskell -- Logging+This project is an attempt to implement core ideas learned from the **Erlang/OTP**  +framework in Haskell using **`extensible-effects`**. -- Memory Leak Free `forever`+This library sketches my personal history of working on a large, real world Erlang+application, trying to bring some of the ideas over to Haskell. -## GHC Extensions+I know about cloud-haskell and transient, but I wanted something based on +'extensible-effects', and I also wanted to deepen my understanding of it. -In order to use the library you might need to activate some extension-in order to fight some ambiguous types, stemming from the flexibility to-choose different Scheduler implementations.+### Modeling an Application with Processes -- AllowAmbiguousTypes-- TypeApplications+The fundamental approach to modelling applications in Erlang is+based on the concept of concurrent, communicating processes, without+shared state.  +**`Processes`** are at the center of that contraption. All *actions*+happens in processes, and all *interactions* happen via messages sent+between processes.  -## Example+This is called **Message Passing Concurrency**;+in this library it is provided via the **`Process`** effect.  +The **`Process`** effect itself is just an *abstract interface*.++There are two schedulers, that *interpret* the `Process` effect:++- A *multi-threaded* scheduler, based on the `async`+- A *pure* single-threaded scheduler, based on coroutines++### Process Life-Cycles and Interprocess Links++All processes except the first process are **`spawned`** by existing +processes.++When a process **`spawns`** a new process, both are mutually **linked**, and+the former is called *parent* and the other *child*.++Process links form a trees.++When a parent process dies, the child processes dies as well.++If on the other hand a child dies, the parent will not die unless the+child *crashed*. ++A parent might also react by *restarting* the child from a defined starting+state.++Because processes never share memory, the internal - possibly broken - state of +a process is gone, when a process exits; hence restarting a process will not+be bothered by left-over, possibly inconsistent, state. ++Erlang such parent processes are call *supervisor* processes in Erlang.++In order to build **supervision trees** the `Process` effect allows:++- Interrupting and killing Processes+- Process Monitoring+- Process Linking+- Timers and Timeouts++These facilities are very important to build **non-defensive**, **let-it-crash**+applications, resilient to runtime errors.   ++Currently a custom **logging effect** is also part of the code base.++## Usage and Implementation++### Example Code+ ```haskell module Main where @@ -76,21 +127,18 @@ NOTICE    all processes cancelled                                                  ForkIOScheduler.hs line 179 ``` -## TODO--### Stackage+### Required GHC Extensions -Still todo...+In order to use the library you might need to activate some extension+in order to fight some ambiguous types, stemming from the flexibility to+choose different Scheduler implementations. -[![extensible-effects-concurrent LTS](http://stackage.org/package/extensible-effects-concurrent/badge/lts)](http://stackage.org/lts/package/extensible-effects-concurrent)+- AllowAmbiguousTypes+- TypeApplications  -### Other+## Planned Features -- Process Linking/Monitoring+- Stackage [![extensible-effects-concurrent LTS](http://stackage.org/package/extensible-effects-concurrent/badge/lts)](http://stackage.org/lts/package/extensible-effects-concurrent)  - Scheduler `ekg` Monitoring--- Timers and Timeouts (e.g. in `receive`)--- Rename stuff

@@ -1,6 +1,6 @@ cabal-version:  2.0 name:           extensible-effects-concurrent-version:        0.19.1+version:        0.20.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

@@ -29,15 +29,14 @@   -- * Log Handling API    -- ** Writing Logs-  , LogWriterReader   , setLogWriter   , addLogWriter+  , modifyLogWriter+   -- *** Log Message Modification   , withLogFileAppender   , censorLogs   , censorLogsM-  , askLogWriter-  , modifyLogWriter    -- ** 'Logs' Effect Handling   , Logs()@@ -52,8 +51,6 @@   , runLogs   , respondToLogMessage   , interceptLogMessages-  -- *** LogWriter Handling-  , runLogWriterReader    ) where@@ -104,13 +101,10 @@   handle h q AskLogFilter p         = h (q ^$ p ) p   handle h q (WriteLogMessage _) p  = h (q ^$ ()) p --- | This instance allows lifting to the 'Logs' effect, they do, however, need a--- 'LogWriter' in the base monad, in order to be able to handle 'logMsg' invocations.------ The 'LogWriterReader' effect is must be available to get to the 'LogWriter'.------ Otherwise there is no way to preserve to log messages.-instance forall m e. (MonadBase m m, LiftedBase m e, SupportsLogger m (Logs ': e), SetMember LogWriterReader (LogWriterReader m) (Logs ': e))+-- | 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 m (Logs ': e))   => MonadBaseControl m (Eff (Logs ': e)) where     type StM (Eff (Logs ': e)) a =  StM (Eff e) a     liftBaseWith f = do@@ -122,7 +116,7 @@   => Catch.MonadThrow (Eff (Logs ': e)) where   throwM exception = raise (Catch.throwM exception) -instance (Applicative m, LiftedBase m e, Catch.MonadCatch (Eff e), SupportsLogger m (Logs ': e), SetMember LogWriterReader (LogWriterReader m) (Logs ': e))+instance (Applicative m, LiftedBase m e, Catch.MonadCatch (Eff e), LogsTo m (Logs ': e))   => Catch.MonadCatch (Eff (Logs ': e)) where   catch effect handler = do     lf <- askLogPredicate@@ -131,7 +125,7 @@         nestedHandler exception = lower (handler exception)     raise (Catch.catch nestedEffects nestedHandler) -instance (Applicative m, LiftedBase m e, Catch.MonadMask (Eff e), SupportsLogger m (Logs ': e), SetMember LogWriterReader (LogWriterReader m) (Logs ': e))+instance (Applicative m, LiftedBase m e, Catch.MonadMask (Eff e), LogsTo m (Logs ': e))   => Catch.MonadMask (Eff (Logs ': e)) where   mask maskedEffect = do     lf <- askLogPredicate@@ -173,17 +167,18 @@   -- | A constraint alias for effects that requires a 'LogWriterReader', as well as that the--- contained 'LogWriterReader' has a 'SupportsLogger' instance.+-- contained 'LogWriterReader' has a 'HandleLogWriter' instance. -- -- The requirements of this constraint are provided by:--- * 'withStdOutLogging'+--+-- * 'withConsoleLogging' -- * 'withIoLogging' -- * 'withLogging' -- * 'withSomeLogging' ---type LogsTo h e = (Member Logs e, SupportsLogger h e, SetMember LogWriterReader (LogWriterReader h) e)+type LogsTo h e = (Member Logs e, HandleLogWriter h, LogWriterEffects h <:: e, SetMember LogWriterReader (LogWriterReader h) e) --- | Enable logging to @stdout@ using the 'defaultIoLogWriter' in combination with+-- | Enable logging to @standard output@ using the 'defaultIoLogWriter' in combination with -- the 'consoleLogWriter'. -- -- Example:@@ -197,9 +192,9 @@ -- To vary the 'LogWriter' use 'withIoLogging'. withConsoleLogging   :: SetMember Lift (Lift IO) e-  => String-  -> Facility-  -> LogPredicate+  => String -- ^ 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 IO : e) a   -> Eff e a withConsoleLogging = withIoLogging consoleLogWriter@@ -214,17 +209,17 @@ -- > exampleWithIoLogging = -- >     runLift -- >   $ withIoLogging consoleLogWriter---                     "my-app"---                     local7---                     (lmSeverityIsAtLeast informationalSeverity)+-- >                   "my-app"+-- >                   local7+-- >                   (lmSeverityIsAtLeast informationalSeverity) -- >   $ logInfo "Oh, hi there" -- withIoLogging   :: SetMember Lift (Lift IO) e-  => LogWriter IO-  -> String-  -> Facility-  -> LogPredicate+  => LogWriter IO -- ^ The 'LogWriter' that will be used to write log messages.+  -> String -- ^ 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 IO : e) a   -> Eff e a withIoLogging lw appName facility defaultPredicate =@@ -278,7 +273,7 @@ -- Exposed for custom extensions, if in doubt use 'withLogging'. runLogs   :: forall h e b .-     (LogsTo h (Logs ': e), SupportsLogger h (Logs ': e))+     (LogsTo h (Logs ': e))   => LogPredicate   -> Eff (Logs ': e) b   -> Eff e b@@ -558,104 +553,17 @@  -- | Internal function. sendLogMessageToLogWriter-  :: forall h e b .-     (LogsTo h e, SupportsLogger h e, Member Logs e)-  => Eff e b -> Eff e b-sendLogMessageToLogWriter = respondToLogMessage messageCallback-  where-    messageCallback msg = do-      lw <- askLogWriter-      liftLogWriter lw msg---- | 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)-      )---- | 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---- | Get the current 'LogWriter'.-askLogWriter :: SetMember LogWriterReader (LogWriterReader h) e => Eff e (LogWriter h)-askLogWriter = send AskLogWriter+  :: forall h e b . (LogsTo h 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 f = localLogWriterReader . sendLogMessageToLogWriter-  where-    localLogWriterReader m =-      f <$> askLogWriter >>= fix (respond_relay @(LogWriterReader h) (\x _ -> return x)) m-+  :: forall h e a+   . LogsTo h e+  => (LogWriter h -> LogWriter h)+  -> Eff e a+  -> Eff e a+modifyLogWriter f = localLogWriterReader f . sendLogMessageToLogWriter  -- | Replace the current 'LogWriter'. -- To add an additional log message consumer use 'addLogWriter'@@ -679,7 +587,7 @@  -- | Combine the effects of a given 'LogWriter' and the existing one. ----- > +-- > -- > exampleAddLogWriter :: IO () -- > exampleAddLogWriter = go >>= putStrLn -- >  where go = fmap (unlines . map renderLogMessage . snd)

@@ -1,46 +1,73 @@ {-# LANGUAGE UndecidableInstances #-} -- | The 'LogWriter' type encapsulates an effectful function to write 'LogMessage's. ----- Used in conjunction with the 'SupportsLogger' class, it+-- Used in conjunction with the 'HandleLogWriter' class, it -- can be used to write messages from within an effectful -- computation. module Control.Eff.Log.Writer-  ( -- * 'LogWriter' Definition-    LogWriter(MkLogWriter, runLogWriter)-  , SupportsLogger(..)-  -- ** 'LogWriter' Zoo+  (+  -- * 'LogWriter' Definition+    LogWriter(..)+  -- * LogWriter Reader Effect+  , LogWriterReader+  , localLogWriterReader+  , askLogWriter+  , runLogWriterReader+  -- * LogWriter Handler Class+  , HandleLogWriter(..)+  -- ** 'LogWriter' Handler Instance Zoo   -- *** Pure Writer   , noOpLogWriter   , debugTraceLogWriter   , PureLogWriter(..)+  -- *** List Writer   , listLogWriter   , CaptureLogs(..)   , CapturedLogsWriter   , runCapturedLogsWriter-  -- ** IO Based 'LogWriter'+  -- *** IO Writer   , consoleLogWriter   , ioHandleLogWriter-  -- *** General Combinator+  -- ** Writer Combinator+  -- *** Pure Writer Combinator   , filteringLogWriter   , mappingLogWriter+  -- *** Impure Writer Combinator   , mappingLogWriterM   -- *** IO Based Combinator   , ioLogWriter   , defaultIoLogWriter-  ) where+  )+where -import Control.Eff-import Control.Eff.Log.Message-import Data.Default-import Debug.Trace-import GHC.Stack-import Control.Eff.Writer.Strict (Writer, tell, runListWriter)-import Data.Functor.Identity (Identity)-import Control.DeepSeq (deepseq)-import Data.Foldable (traverse_)-import System.IO-import Control.Monad ((>=>))-import Control.Lens+import           Control.Eff+import           Control.Eff.Extend+import           Control.Eff.Log.Message+import           Data.Default+import           Data.Function                  ( fix )+import           Debug.Trace+import           GHC.Stack+import           Control.Eff.Writer.Strict      ( Writer+                                                , tell+                                                , runListWriter+                                                )+import           Data.Functor.Identity          ( Identity )+import           Control.DeepSeq                ( force )+import           Data.Foldable                  ( traverse_ )+import qualified System.IO                     as IO+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           Data.Kind+import           Control.Lens  -- | A function that takes a log message and returns an effect that -- /logs/ the message.@@ -51,32 +78,121 @@ instance Applicative w => Default (LogWriter w) where   def = MkLogWriter (const (pure ())) --- * LogWriter liftings+-- | 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 --- | This class describes how to lift the log writer action into some monad.+-- | Get the current 'LogWriter'.+askLogWriter+  :: SetMember LogWriterReader (LogWriterReader h) e => Eff e (LogWriter h)+askLogWriter = send AskLogWriter++-- | Modify the current 'LogWriter'.+localLogWriterReader+  :: forall h e a+   . SetMember LogWriterReader (LogWriterReader h) e+  => (LogWriter h -> LogWriter h)+  -> 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 second parameter is almost always @Eff x@--- so usually the method of this class lifts the log writer action into an effect monad.-class SupportsLogger h e where-  liftLogWriter :: LogWriter h -> LogMessage -> Eff e ()+-- 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 (writerEff :: Type -> Type) where+  -- | A list of effects that are required for writing the log messages.+  -- For example 'Lift IO' or '[]' for pure log writers.+  type LogWriterEffects writerEff :: [Type -> Type]++  -- | Run the side effect of a 'LogWriter' in a compatible 'Eff'.+  handleLogWriterEffect :: (LogWriterEffects writerEff <:: e) => writerEff () -> 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 writerEff) e+                         , LogWriterEffects writerEff <:: e)+                      => LogMessage+                      -> Eff e ()+  liftWriteLogMessage m = do+    w <- askLogWriter+    handleLogWriterEffect (runLogWriter w m)+ -- ** Pure Log Writers --- | A base monad for all side effect free 'LogWriter'.------ This is only required e.g. when logs are only either discarded or traced.--- See 'debugTraceLogWriter' or 'noOpLogWriter'.------ This is just a wrapper around 'Identity' and serves as a type that has a special--- 'SupportsLogger' instance.+-- | A phantom type for the 'HandleLogWriter' class for /pure/ 'LogWriter's newtype PureLogWriter a = MkPureLogWriter { runPureLogWriter :: Identity a }-  deriving (Functor, Applicative, Monad)+  deriving (Applicative, Functor, Monad)  -- | A 'LogWriter' monad for 'Debug.Trace' based pure logging.-instance SupportsLogger PureLogWriter e where-  liftLogWriter lw msg = deepseq (runPureLogWriter (runLogWriter lw msg)) (return ())+instance HandleLogWriter PureLogWriter where+  type LogWriterEffects PureLogWriter = '[]+  handleLogWriterEffect lw = return (force (runIdentity (force (runPureLogWriter lw))))  -- | This 'LogWriter' will discard all messages. --@@ -102,14 +218,17 @@  -- | A 'LogWriter' monad for pure logging. ----- The 'SupportsLogger' instance for this type assumes a 'Writer' effect.-instance Member CapturedLogsWriter e => SupportsLogger CaptureLogs e where-  liftLogWriter lw = traverse_ (tell @LogMessage) . snd . run . runListWriter . unCaptureLogs . runLogWriter lw+-- The 'HandleLogWriter' instance for this type assumes a 'Writer' effect.+instance HandleLogWriter CaptureLogs where+  type LogWriterEffects CaptureLogs = '[CapturedLogsWriter]+  handleLogWriterEffect =+    traverse_ (tell @LogMessage) . snd . run . runListWriter . unCaptureLogs  -- | Run a 'Writer' for 'LogMessage's. -- -- Such a 'Writer' is needed for 'CaptureLogs'-runCapturedLogsWriter :: Eff (CapturedLogsWriter ': e) a -> Eff e (a, [LogMessage])+runCapturedLogsWriter+  :: Eff (CapturedLogsWriter ': e) a -> Eff e (a, [LogMessage]) runCapturedLogsWriter = runListWriter  -- | Alias for the 'Writer' that contains the captured 'LogMessage's from 'CaptureLogs'.@@ -118,23 +237,23 @@ -- | A 'LogWriter' that uses an 'IO' action to write the message. -- -- Example use cases for this function are the 'consoleLogWriter' and the 'ioHandleLogWriter'.-ioLogWriter :: HasCallStack => (LogMessage-> IO ()) -> LogWriter IO+ioLogWriter :: HasCallStack => (LogMessage -> IO ()) -> LogWriter IO ioLogWriter = MkLogWriter --- | A 'LogWriter' that uses an 'IO' action to write the message.-ioHandleLogWriter :: HasCallStack => Handle -> LogWriter IO-ioHandleLogWriter h = ioLogWriter (hPutStrLn h . renderLogMessage)+-- | A 'LogWriter' that renders 'LogMessage's to strings via 'renderLogMessage'+-- and prints them to an 'IO.Handle' using 'hPutStrLn'.+ioHandleLogWriter :: HasCallStack => IO.Handle -> LogWriter IO+ioHandleLogWriter h = ioLogWriter (IO.hPutStrLn h . renderLogMessage) -instance (Lifted IO e) => SupportsLogger IO e where-  liftLogWriter = (lift . ) . runLogWriter+instance HandleLogWriter IO where+  type LogWriterEffects IO = '[Lift IO]+  handleLogWriterEffect = send . Lift  -- | Write 'LogMessage's to standard output, formatted with 'printLogMessage'. consoleLogWriter :: LogWriter IO consoleLogWriter = ioLogWriter printLogMessage --- | Decorate an IO based 'LogWriter' to set important fields in log messages.------ ALl log messages are censored to include basic log message information:+-- | 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@@ -142,22 +261,26 @@ -- * The 'lmHostname' field contains the FQDN of the current host -- * The 'lmFacility' field contains the given 'Facility' ----- It installs the given 'LogWriter', wrapped using 'mappingLogWriterM'.-defaultIoLogWriter :: String -> Facility -> LogWriter IO -> LogWriter IO-defaultIoLogWriter appName facility =-  mappingLogWriterM-    (   setLogMessageThreadId-    >=> setLogMessageTimestamp-    >=> setLogMessageHostname-    >=> pure-         . set lmFacility facility-         . set lmAppName (Just appName)-    )+-- It works by using 'mappingLogWriterM'.+defaultIoLogWriter+  :: String -- ^ The default application name to put into the 'lmAppName' field.+  -> Facility -- ^ The default RFC-5424 facility to put into the 'lmFacility' field.+  -> LogWriter IO -- ^ The IO based writer to decorate+  -> LogWriter IO+defaultIoLogWriter appName facility = mappingLogWriterM+  (   setLogMessageThreadId+  >=> setLogMessageTimestamp+  >=> setLogMessageHostname+  >=> pure+  .   set lmFacility facility+  .   set lmAppName  (Just appName)+  )  -- | A 'LogWriter' that applies a predicate to the 'LogMessage' and delegates to -- to the given writer of the predicate is satisfied. filteringLogWriter :: Monad e => LogPredicate -> LogWriter e -> LogWriter e-filteringLogWriter p lw = MkLogWriter (\msg -> if p msg then (runLogWriter lw msg) else return ())+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.@@ -165,5 +288,6 @@ mappingLogWriter f lw = MkLogWriter (runLogWriter lw . f)  -- | Like 'mappingLogWriter' allow the function that changes the 'LogMessage' to have effects.-mappingLogWriterM :: Monad e => (LogMessage -> e LogMessage) -> LogWriter e -> LogWriter e+mappingLogWriterM+  :: Monad e => (LogMessage -> e LogMessage) -> LogWriter e -> LogWriter e mappingLogWriterM f lw = MkLogWriter (f >=> runLogWriter lw)