extensible-effects-concurrent 0.29.0 → 0.29.1

raw patch · 25 files changed

+276/−161 lines, 25 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• examples/example-1/Main.hs +1/−1
• examples/example-3/Main.hs +1/−1
• extensible-effects-concurrent.cabal +1/−1
• src/Control/Eff/Concurrent/Process/ForkIOScheduler.hs +2/−2
• src/Control/Eff/Concurrent/Process/Interactive.hs +1/−1
• src/Control/Eff/Concurrent/Process/SingleThreadedScheduler.hs +5/−5
• src/Control/Eff/Concurrent/Protocol.hs +7/−4
• src/Control/Eff/Concurrent/Protocol/CallbackServer.hs +105/−19
• src/Control/Eff/Concurrent/Protocol/Supervisor.hs +1/−2
• src/Control/Eff/Concurrent/SingleThreaded.hs +1/−1
• src/Control/Eff/Log/Examples.hs +6/−7
• src/Control/Eff/Log/Handler.hs +37/−18
• src/Control/Eff/Log/Writer.hs +34/−23
• src/Control/Eff/LogWriter/Async.hs +6/−6
• src/Control/Eff/LogWriter/Capture.hs +3/−12
• src/Control/Eff/LogWriter/Console.hs +4/−4
• src/Control/Eff/LogWriter/DebugTrace.hs +3/−3
• src/Control/Eff/LogWriter/File.hs +3/−3
• src/Control/Eff/LogWriter/IO.hs +11/−11
• src/Control/Eff/LogWriter/UDP.hs +3/−3
• src/Control/Eff/LogWriter/UnixSocket.hs +3/−3
• test/Common.hs +1/−1
• test/LoggingTests.hs +2/−2
• test/ProcessBehaviourTestCases.hs +28/−28

@@ -1,5 +1,12 @@ # Changelog for extensible-effects-concurrent +## 0.29.1+- Add more constraints to `Embeds`+- Improve the `CallbackServer`+- Add `LogWriterEffects`+- Rewrite `HandleLogWriter` so that the instance types have to be effects.+  TL,DR; This allows shorter type signatures than before.  + ## 0.29.0 - Remove the reply type parameter from `HasPdu`  - Make a new constraint `Embeds` that replaces `EmbedProtocol`

@@ -76,7 +76,7 @@   go  testServerLoop :: Eff Effects (Endpoint TestProtocol)-testServerLoop = Callback.start (\ _ e -> e) handleReq "test-server-1"+testServerLoop = Callback.start (Callback.callbacks handleReq "test-server-1")  where   handleReq :: Endpoint TestProtocol -> Event TestProtocol -> Eff Effects ()   handleReq me (OnCall rt cm) =

@@ -10,7 +10,7 @@ main :: IO () main =   runLift-  $  withSomeLogging @IO+  $  withSomeLogging @(Lift IO)   $  withFileLogWriter  "extensible-effects-concurrent-example-3.log"   $  addLogWriter (filteringLogWriter severeMessages (mappingLogWriter (lmMessage %~ ("traced: " <>)) (debugTraceLogWriter renderRFC5424)))   $  modifyLogWriter (defaultIoLogWriter "example-3" local0)

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

@@ -271,7 +271,7 @@ -- | 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 IO -> Eff Effects () -> IO ()+  :: HasCallStack => LogWriter (Lift IO) -> Eff Effects () -> IO () defaultMainWithLogWriter lw =   runLift . withLogging lw . withAsyncLogWriter (1024 :: Int) . schedule @@ -624,7 +624,7 @@     let addProcessId = over           lmProcessId           (maybe (Just (T.pack (printf "% 9s" (show pid)))) Just)-    in  censorLogs @IO addProcessId+    in  censorLogs @(Lift IO) addProcessId   triggerProcessLinksAndMonitors     :: ProcessId -> Interrupt e -> TVar (Set ProcessId) -> Eff BaseEffects ()   triggerProcessLinksAndMonitors !pid !reason !linkSetVar = do

@@ -100,7 +100,7 @@ killInteractiveScheduler :: SchedulerSession r -> IO () killInteractiveScheduler (SchedulerSession qVar) =   atomically (void (tryTakeTMVar qVar))-+                          -- | Send a 'Process' effect to the main process of a scheduler, this blocks -- until the effect is executed. submit

@@ -218,9 +218,9 @@ -- -- @since 0.3.0.2 schedulePure-  :: Eff (Processes '[Logs, LogWriterReader PureLogWriter]) a+  :: Eff (Processes '[Logs, LogWriterReader Logs]) a   -> Either (Interrupt 'NoRecovery) a-schedulePure e = run (scheduleM (withSomeLogging @PureLogWriter) (return ()) e)+schedulePure e = run (scheduleM (withSomeLogging @Logs) (return ()) e)  -- | Invoke 'scheduleM' with @lift 'Control.Concurrent.yield'@ as yield effect. -- @scheduleIO runEff == 'scheduleM' (runLift . runEff) (liftIO 'yield')@@@ -254,7 +254,7 @@ -- @since 0.4.0.0 scheduleIOWithLogging   :: HasCallStack-  => LogWriter IO+  => LogWriter (Lift IO)   -> Eff EffectsIo a   -> IO (Either (Interrupt 'NoRecovery) a) scheduleIOWithLogging h = scheduleIO (withLogging h)@@ -590,7 +590,7 @@ -- All logging is written using the given 'LogWriter'. -- -- @since 0.25.0-defaultMainWithLogWriter :: HasCallStack => LogWriter IO -> Eff EffectsIo () -> IO ()+defaultMainWithLogWriter :: HasCallStack => LogWriter (Lift IO) -> Eff EffectsIo () -> IO () defaultMainWithLogWriter lw =   void     . runLift@@ -617,7 +617,7 @@ -- 'Logs' and the 'LogWriterReader' for 'PureLogWriter'. -- -- @since 0.25.0-type PureBaseEffects = '[Logs, LogWriterReader PureLogWriter]+type PureBaseEffects = '[Logs, LogWriterReader Logs]  -- | Constraint for the existence of the underlying scheduler effects. --

@@ -113,8 +113,7 @@ -- > -- -- @since 0.25.1-class (Typeable protocol) =>-   HasPdu (protocol :: Type) where+class Typeable protocol => HasPdu (protocol :: Type) where   -- | A type level list Protocol phantom types included in the associated 'Pdu' instance.   --   -- This is just a helper for better compiler error messages.@@ -148,8 +147,12 @@ -- -- Note that every type embeds itself, so @Embeds x x@ always holds. ----- @since 0.29.0-type Embeds outer inner = (HasPduPrism outer inner, CheckEmbeds outer inner)+-- @since 0.29.1+type Embeds outer inner =+  ( HasPduPrism outer inner+  , CheckEmbeds outer inner+  , HasPdu outer+  )  -- ---------- Type Machinery: type family CheckEmbeds outer inner :: Constraint where

@@ -1,3 +1,4 @@+{-# LANGUAGE UndecidableInstances #-} -- | Build a "Control.Eff.Concurrent.EffectfulServer" from callbacks. -- -- This module contains in instance of 'E.Server' that delegates to@@ -11,6 +12,12 @@   , ServerId(..)   , Event(..)   , TangibleCallbacks+  , Callbacks+  , callbacks+  , onEvent+  , CallbacksEff+  , callbacksEff+  , onEventEff   )   where @@ -29,38 +36,37 @@ import qualified Data.Text as T import GHC.Stack (HasCallStack) ---- | Execute the server loop.+-- | Execute the server loop, that dispatches incoming events+-- to either a set of 'Callbacks' or 'CallbacksEff'. ----- @since 0.27.0+-- @since 0.29.1 start-  :: forall tag eLoop q h.+  :: forall (tag :: Type) eLoop q h e.      ( HasCallStack      , TangibleCallbacks tag eLoop q      , E.Server (Server tag eLoop) (Processes q)      , LogsTo h (Processes q)+     , HasProcesses e q      )-  => (forall x . Endpoint tag -> Eff eLoop x -> Eff (Processes q) x)-  -> (Endpoint tag -> Event tag -> Eff eLoop ())-  -> ServerId tag-  -> Eff (Processes q) (Endpoint tag)-start initCb eventCb serverId = E.start (MkServer serverId initCb eventCb)+  => CallbacksEff tag eLoop q+  -> Eff e (Endpoint tag)+start = E.start --- | Execute the server loop.+-- | Execute the server loop, that dispatches incoming events+-- to either a set of 'Callbacks' or 'CallbacksEff'. ----- @since 0.27.0+-- @since 0.29.1 startLink-  :: forall tag eLoop q h.+  :: forall (tag :: Type) eLoop q h e.      ( HasCallStack      , TangibleCallbacks tag eLoop q      , E.Server (Server tag eLoop) (Processes q)      , LogsTo h (Processes q)+     , HasProcesses e q      )-  => (forall x . Endpoint tag -> Eff eLoop x -> Eff (Processes q) x)-  -> (Endpoint tag -> Event tag -> Eff eLoop ())-  -> ServerId tag-  -> Eff (Processes q) (Endpoint tag)-startLink initCb eventCb serverId = E.startLink (MkServer serverId initCb eventCb)+  => CallbacksEff tag eLoop q+  -> Eff e (Endpoint tag)+startLink = E.startLink  -- | Phantom type to indicate a callback based 'E.Server' instance. --@@ -71,8 +77,7 @@ -- -- @since 0.27.0 type TangibleCallbacks tag eLoop e =-       ( LogIo e-       , HasProcesses eLoop e+       ( HasProcesses eLoop e        , Typeable e        , Typeable eLoop        , Typeable tag@@ -116,4 +121,85 @@       . showChar ' ' . showSTypeRep (typeRep (Proxy @tag))       . showString " callback-server"       )+++-- ** Smart Constructors for 'Callbacks'++-- | A convenience type alias for callbacks that do not+-- need a custom effect.+--+-- @since 0.29.1+type Callbacks tag e = CallbacksEff tag (Processes e) e+++-- | A smart constructor for 'Callbacks'.+--+-- @since 0.29.1+callbacks+  :: forall tag q h.+     ( HasCallStack+     , TangibleCallbacks tag (Processes q) q+     , E.Server (Server tag (Processes q)) (Processes q)+     , LogsTo h q+     )+  => (Endpoint tag -> Event tag -> Eff (Processes q) ())+  -> ServerId tag+  -> Callbacks tag q+callbacks evtCb i = callbacksEff (const id) evtCb i++-- | A simple smart constructor for 'Callbacks'.+--+-- @since 0.29.1+onEvent+  :: forall tag q h.+     ( HasCallStack+     , TangibleCallbacks tag (Processes q) q+     , E.Server (Server tag (Processes q)) (Processes q)+     , LogsTo h q+     )+  => (Event tag -> Eff (Processes q) ())+  -> ServerId (tag :: Type)+  -> Callbacks tag q+onEvent = onEventEff id++-- ** Smart Constructors for 'CallbacksEff'++-- | A convenience type alias for __effectful__ callback based 'E.Server' instances.+--+-- See 'Callbacks'.+--+-- @since 0.29.1+type CallbacksEff tag eLoop e = E.Init (Server tag eLoop) (Processes e)++-- | A smart constructor for 'CallbacksEff'.+--+-- @since 0.29.1+callbacksEff+  :: forall tag eLoop q h.+     ( HasCallStack+     , TangibleCallbacks tag eLoop q+     , E.Server (Server tag eLoop) (Processes q)+     , LogsTo h q+     )+  => (forall x . Endpoint tag -> Eff eLoop x -> Eff (Processes q) x)+  -> (Endpoint tag -> Event tag -> Eff eLoop ())+  -> ServerId tag+  -> CallbacksEff tag eLoop q+callbacksEff a b c = MkServer c a b++-- | A simple smart constructor for 'CallbacksEff'.+--+-- @since 0.29.1+onEventEff+  ::+    ( HasCallStack+    , TangibleCallbacks tag eLoop q+    , E.Server (Server tag eLoop) (Processes q)+    , LogsTo h q+    )+  => (forall a. Eff eLoop a -> Eff (Processes q) a)+  -> (Event tag -> Eff eLoop ())+  -> ServerId (tag :: Type)+  -> CallbacksEff tag eLoop q+onEventEff h f i = callbacksEff (const h) (const f) i 

@@ -246,8 +246,7 @@ startSupervisor   :: forall p e   . ( HasCallStack-    , LogsTo IO (Processes e)-    , Lifted IO e+    , LogIo (Processes e)     , TangibleSup p     , Server (Sup p) (Processes e)     )

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

@@ -58,11 +58,10 @@ -- | Example code for: -- --  * 'withSomeLogging'---  * 'PureLogWriter' --  * 'logDebug' exampleWithSomeLogging :: HasCallStack => () exampleWithSomeLogging =-  run $ withSomeLogging @PureLogWriter $ logDebug "Oh, hi there"+  run $ withSomeLogging @Logs $ logDebug "Oh, hi there"  -- | Example code for: --@@ -76,7 +75,7 @@ exampleLogPredicate :: HasCallStack => IO Int exampleLogPredicate =   runLift-    $ withSomeLogging @IO+    $ withSomeLogging @(Lift IO)     $ setLogWriter consoleLogWriter     $ logPredicatesExampleClient @@ -129,7 +128,7 @@ exampleRFC5424Logging :: IO Int exampleRFC5424Logging =   runLift-    $ withSomeLogging @IO+    $ withSomeLogging @(Lift IO)     $ setLogWriter         (defaultIoLogWriter "myapp" local2 (debugTraceLogWriter renderRFC5424))     $ logPredicatesExampleClient@@ -138,7 +137,7 @@ exampleRFC3164WithRFC5424TimestampsLogging :: IO Int exampleRFC3164WithRFC5424TimestampsLogging =   runLift-    $ withSomeLogging @IO+    $ withSomeLogging @(Lift IO)     $ setLogWriter         (defaultIoLogWriter "myapp" local2 (debugTraceLogWriter renderRFC3164WithRFC5424Timestamps))     $ logPredicatesExampleClient@@ -187,7 +186,7 @@ --  * 'logWarning' --  * 'logCritical' --  * 'lmMessage'-loggingExampleClient :: (HasCallStack, Monad h, LogsTo h e) => Eff e ()+loggingExampleClient :: (HasCallStack, Monad (LogWriterM h), LogsTo h e) => Eff e () loggingExampleClient = do   logDebug "test 1.1"   logError "test 1.2"@@ -210,7 +209,7 @@ --  * 'lmSeverityIsAtLeast' --  * 'includeLogMessages' --  * 'excludeLogMessages'-logPredicatesExampleClient :: (HasCallStack, Monad h, LogsTo h e) => Eff e Int+logPredicatesExampleClient :: (HasCallStack, Monad (LogWriterM h), LogsTo h e) => Eff e Int logPredicatesExampleClient = do   logInfo "test"   setLogPredicate

@@ -106,34 +106,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 m (Logs ': e))+instance forall m e. (MonadBase m m, LiftedBase m e, LogsTo (Lift m) (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 @m lf)))+      raise (liftBaseWith (\runInBase -> f (runInBase . runLogs @(Lift m) 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 m (Logs ': e))+instance (Applicative m, LiftedBase m e, Catch.MonadCatch (Eff e), LogsTo (Lift m) (Logs ': e))   => Catch.MonadCatch (Eff (Logs ': e)) where   catch effect handler = do     lf <- askLogPredicate-    let lower                   = runLogs @m lf+    let lower                   = runLogs @(Lift m) 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 m (Logs ': e))+instance (Applicative m, LiftedBase m e, Catch.MonadMask (Eff e), LogsTo (Lift m) (Logs ': e))   => Catch.MonadMask (Eff (Logs ': e)) where   mask maskedEffect = do     lf <- askLogPredicate     let       lower :: Eff (Logs ': e) a -> Eff e a-      lower = runLogs @m lf+      lower = runLogs @(Lift m) lf     raise         (Catch.mask           (\nestedUnmask -> lower@@ -146,7 +146,7 @@     lf <- askLogPredicate     let       lower :: Eff (Logs ': e) a -> Eff e a-      lower = runLogs @m lf+      lower = runLogs @(Lift m) lf     raise         (Catch.uninterruptibleMask           (\nestedUnmask -> lower@@ -159,7 +159,7 @@     lf <- askLogPredicate     let       lower :: Eff (Logs ': e) a -> Eff e a-      lower = runLogs @m lf+      lower = runLogs @(Lift m) lf     raise         (Catch.generalBracket           (lower acquire)@@ -177,12 +177,31 @@ -- * 'withLogging' -- * 'withSomeLogging' ---type LogsTo h e = (Member Logs e, HandleLogWriter h e, SetMember LogWriterReader (LogWriterReader h) e)+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.+--+-- @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++instance Monad (LogWriterM Logs) where+  MkPureLogging >>= _ = MkPureLogging+ -- | A constraint that required @'LogsTo' 'IO' e@ and @'Lifted' 'IO' e@. -- -- @since 0.24.0-type LogIo e = (LogsTo IO e, Lifted IO e)+type LogIo e = (LogsTo (Lift IO) e, Lifted IO e)  -- | Handle the 'Logs' and 'LogWriterReader' effects. --@@ -198,7 +217,7 @@ -- >   $ logDebug "Oh, hi there" -- withLogging ::-     forall h e a. (Applicative h, LogsTo h (Logs ': LogWriterReader h ': e))+     forall h e a. (Applicative (LogWriterM h), LogsTo h (Logs ': LogWriterReader h ': e))   => LogWriter h -> Eff (Logs ': LogWriterReader h ': e) a -> Eff e a withLogging lw = runLogWriterReader lw . runLogs allLogMessages @@ -219,7 +238,7 @@ -- withSomeLogging ::      forall h e a.-     (Applicative h, LogsTo h (Logs ': LogWriterReader h ': e))+     (Applicative (LogWriterM h), LogsTo h (Logs ': LogWriterReader h ': e))   => Eff (Logs ': LogWriterReader h ': e) a   -> Eff e a withSomeLogging = withLogging (noOpLogWriter @h)@@ -595,7 +614,7 @@ -- | Change the current 'LogWriter'. modifyLogWriter   :: forall h e a-   . LogsTo h e+   . (LogsTo h e)   => (LogWriter h -> LogWriter h)   -> Eff e a   -> Eff e a@@ -603,13 +622,13 @@  -- | 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 :: forall h e a. (LogsTo h e) => LogWriter h -> 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 :: (LogsTo h 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'@@ -617,8 +636,8 @@ -- -- Note: This is equivalent to @'modifyLogWriter' . 'mappingLogWriterM'@ censorLogsM-  :: (LogsTo h e, Monad h)-  => (LogMessage -> h LogMessage) -> Eff e a -> Eff e a+  :: (LogsTo h e, Monad (LogWriterM h))+  => (LogMessage -> LogWriterM h LogMessage) -> Eff e a -> Eff e a censorLogsM = modifyLogWriter . mappingLogWriterM  -- | Combine the effects of a given 'LogWriter' and the existing one.@@ -646,6 +665,6 @@ -- > -- addLogWriter :: forall h e a .-     (HasCallStack, LogsTo h e, Monad h)+     (HasCallStack, LogsTo h e, Monad (LogWriterM h))   => LogWriter h -> Eff e a -> Eff e a addLogWriter lw2 = modifyLogWriter (\lw1 -> MkLogWriter (\m -> runLogWriter lw1 m >> runLogWriter lw2 m))

@@ -15,8 +15,8 @@   , runLogWriterReader   -- * LogWriter Handler Class   , HandleLogWriter(..)+  , LogWriterM(..)   , noOpLogWriter-  , PureLogWriter(..)   -- ** Writer Combinator   -- *** Pure Writer Combinator   , filteringLogWriter@@ -31,8 +31,6 @@ import           Control.Eff.Log.Message import           Data.Default import           Data.Function                  ( fix )-import           Data.Functor.Identity          ( Identity )-import           Control.DeepSeq                ( force ) import           Control.Monad                  ( (>=>)                                                 , when                                                 )@@ -44,16 +42,17 @@                                                   , StM                                                   )                                                 )+import           Control.Eff.Writer.Strict      ( Writer, tell, runListWriter ) import           Data.Kind-import           Control.Lens+import           Data.Foldable                  (traverse_)  -- | A function that takes a log message and returns an effect that -- /logs/ the message. newtype LogWriter writerM = MkLogWriter-  { runLogWriter :: LogMessage -> writerM ()+  { runLogWriter :: LogMessage -> LogWriterM writerM ()   } -instance Applicative w => Default (LogWriter w) where+instance Applicative (LogWriterM w) => Default (LogWriter w) where   def = MkLogWriter (const (pure ()))  -- | Provide the 'LogWriter'@@ -84,7 +83,7 @@ -- 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)+  AskLogWriter :: LogWriterReader h (LogWriter h)  instance Handle (LogWriterReader h) e a (LogWriter h -> k) where   handle k q AskLogWriter lw = k (q ^$ lw) lw@@ -141,44 +140,56 @@ -- * 'LogWriter' Zoo  -- | The instances of this class are the monads that define (side-) effect(s) of writting logs.-class HandleLogWriter (writerEff :: Type -> Type) e where+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 :: writerEff () -> Eff e ()+  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 writerEff) e)+  liftWriteLogMessage :: ( SetMember LogWriterReader (LogWriterReader writer) e+                         , Member writer e+                         )                       => LogMessage                       -> Eff e ()   liftWriteLogMessage m = do     w <- askLogWriter     handleLogWriterEffect (runLogWriter w m) -instance (Lifted IO e) => HandleLogWriter IO e where-  handleLogWriterEffect = send . Lift+-- | 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 --- ** Pure Log Writers --- | A phantom type for the 'HandleLogWriter' class for /pure/ 'LogWriter's-newtype PureLogWriter a = MkPureLogWriter { runPureLogWriter :: Identity a }-  deriving (Applicative, Functor, Monad)---- | A 'LogWriter' monad for 'Debug.Trace' based pure logging.-instance HandleLogWriter PureLogWriter e where-  handleLogWriterEffect lw = return (force (runIdentity (force (runPureLogWriter lw))))+-- | 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  -- | This 'LogWriter' will discard all messages. -- -- NOTE: This is just an alias for 'def'-noOpLogWriter :: Applicative m => LogWriter m+noOpLogWriter :: Applicative (LogWriterM m) => LogWriter m noOpLogWriter = def  -- | 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 :: Monad (LogWriterM e) => LogPredicate -> LogWriter e -> LogWriter e filteringLogWriter p lw =   MkLogWriter (\msg -> when (p msg) (runLogWriter lw msg)) @@ -189,5 +200,5 @@  -- | Like 'mappingLogWriter' allow the function that changes the 'LogMessage' to have effects. mappingLogWriterM-  :: Monad e => (LogMessage -> e LogMessage) -> LogWriter e -> LogWriter e+  :: Monad (LogWriterM e) => (LogMessage -> LogWriterM e LogMessage) -> LogWriter e -> LogWriter e mappingLogWriterM f lw = MkLogWriter (f >=> runLogWriter lw)

@@ -36,16 +36,16 @@ -- withAsyncLogging   :: (Lifted IO e, MonadBaseControl IO (Eff e), Integral len)-  => LogWriter IO+  => LogWriter (Lift IO)   -> 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 IO : e) a+  -> Eff (Logs : LogWriterReader (Lift IO) : e) a   -> Eff e a withAsyncLogging lw queueLength a f p e = liftBaseOp-  (withAsyncLogChannel queueLength (runLogWriter lw . force))+  (withAsyncLogChannel queueLength (runIOLogWriter . runLogWriter lw . force))   (\lc -> withIoLogging (makeLogChannelWriter lc) a f p e)  @@ -72,14 +72,14 @@ -- > -- withAsyncLogWriter-  :: (LogsTo IO e, Lifted IO e, MonadBaseControl IO (Eff e), Integral len)+  :: (LogIo 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 (runLogWriter lw . force))+  liftBaseOp (withAsyncLogChannel queueLength (runIOLogWriter . runLogWriter lw . force))              (\lc -> setLogWriter (makeLogChannelWriter lc) e)  withAsyncLogChannel@@ -101,7 +101,7 @@     traverse_ ioWriter ms     logLoop tq -makeLogChannelWriter :: LogChannel -> LogWriter IO+makeLogChannelWriter :: LogChannel -> LogWriter (Lift IO) makeLogChannelWriter lc = mkLogWriterIO logChannelPutIO  where   logChannelPutIO (force -> me) = do

@@ -4,7 +4,7 @@ -- See 'Control.Eff.Log.Examples.exampleLogCapture' module Control.Eff.LogWriter.Capture   ( captureLogWriter-  , CaptureLogs(..)+  , CaptureLogs   , CaptureLogWriter   , runCaptureLogWriter   )@@ -16,24 +16,15 @@                                                 , tell                                                 , runListWriter                                                 )-import           Data.Foldable                  ( traverse_ )  -- | A 'LogWriter' monad that provides pure logging by capturing via the 'Writer' effect. -- -- See 'Control.Eff.Log.Examples.exampleLogCapture'-captureLogWriter :: LogWriter CaptureLogs+captureLogWriter :: LogWriter CaptureLogWriter captureLogWriter = MkLogWriter (MkCaptureLogs . tell)  -- | A 'LogWriter' monad that provides pure logging by capturing via the 'Writer' effect.-newtype CaptureLogs a = MkCaptureLogs { unCaptureLogs :: Eff '[CaptureLogWriter] a }-  deriving (Functor, Applicative, Monad)---- | A 'LogWriter' monad for pure logging.------ The 'HandleLogWriter' instance for this type assumes a 'Writer' effect.-instance Member CaptureLogWriter e => HandleLogWriter CaptureLogs e where-  handleLogWriterEffect =-    traverse_ (tell @LogMessage) . snd . run . runListWriter . unCaptureLogs+type CaptureLogs a = LogWriterM CaptureLogWriter a  -- | Run a 'Writer' for 'LogMessage's. --

@@ -31,7 +31,7 @@   => 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 IO : e) a+  -> Eff (Logs : LogWriterReader (Lift IO) : e) a   -> Eff e a withConsoleLogging = withIoLogging consoleLogWriter @@ -49,16 +49,16 @@ -- >   $ withConsoleLogWriter -- >   $ logInfo "Oh, hi there" withConsoleLogWriter-  :: (LogsTo IO e, Lifted IO e)+  :: (LogIo e)   => Eff e a -> Eff e a withConsoleLogWriter = addLogWriter consoleLogWriter  -- | Write 'LogMessage's to standard output, formatted with 'printLogMessage'. -- -- It uses 'stdoutLogWriter' with 'renderLogMessageConsoleLog'.-consoleLogWriter :: LogWriter IO+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 IO+stdoutLogWriter :: LogMessageRenderer Text -> LogWriter (Lift IO) stdoutLogWriter render = mkLogWriterIO (T.putStrLn . render)

@@ -29,7 +29,7 @@   => 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 IO : e) a+  -> Eff (Logs : LogWriterReader (Lift IO) : e) a   -> Eff e a withTraceLogging = withIoLogging (debugTraceLogWriter renderLogMessageConsoleLog) @@ -47,9 +47,9 @@ -- >   $ withSomeLogging @IO -- >   $ withTraceLogWriter -- >   $ logInfo "Oh, hi there"-withTraceLogWriter :: forall h e a . (Monad h, LogsTo h e) => Eff e a -> Eff e a+withTraceLogWriter :: forall h e a . (Monad (LogWriterM h), LogsTo h e) => Eff e a -> Eff e a withTraceLogWriter = addLogWriter @h (debugTraceLogWriter renderLogMessageConsoleLog)  -- | Write 'LogMessage's  via 'traceM'.-debugTraceLogWriter :: forall h . (Monad h) => LogMessageRenderer Text -> LogWriter h+debugTraceLogWriter :: forall h . (Monad (LogWriterM h)) => LogMessageRenderer Text -> LogWriter h debugTraceLogWriter render = MkLogWriter (traceM . T.unpack . render)

@@ -41,7 +41,7 @@   -> 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 IO : e) a+  -> Eff (Logs : LogWriterReader (Lift IO) : e) a   -> Eff e a withFileLogging fnIn a f p e =   liftBaseOp (withOpenedLogFile fnIn) (\lw -> withIoLogging lw a f p e)@@ -59,14 +59,14 @@ -- >   $ withFileLogWriter "test.log" -- >   $ logInfo "Oh, hi there" withFileLogWriter-  :: (Lifted IO e, LogsTo IO e, MonadBaseControl IO (Eff e))+  :: (LogIo e, MonadBaseControl IO (Eff e))   => FilePath -- ^ Path to the log-file.   -> Eff e b   -> Eff e b withFileLogWriter fnIn e =   liftBaseOp (withOpenedLogFile fnIn) (`addLogWriter` e) -withOpenedLogFile :: HasCallStack => FilePath -> (LogWriter IO -> IO a) -> IO a+withOpenedLogFile :: HasCallStack => FilePath -> (LogWriter (Lift IO) -> IO a) -> IO a withOpenedLogFile fnIn ioE = Safe.bracket   (do     fnCanon <- canonicalizePath fnIn

@@ -26,12 +26,12 @@ -- 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 IO-mkLogWriterIO = MkLogWriter+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 IO+ioHandleLogWriter :: HasCallStack => IO.Handle -> LogWriter (Lift IO) ioHandleLogWriter h =   mkLogWriterIO (T.hPutStrLn h . renderLogMessageConsoleLog) @@ -49,12 +49,12 @@ -- >   $ logInfo "Oh, hi there" -- withIoLogging-  :: SetMember Lift (Lift IO) e-  => LogWriter IO -- ^ The 'LogWriter' that will be used to write log messages.+  :: 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 IO : e) a+  -> Eff (Logs : LogWriterReader (Lift IO) : e) a   -> Eff e a withIoLogging lw appName facility defaultPredicate =   withLogging (defaultIoLogWriter appName facility lw)@@ -71,18 +71,18 @@ 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 IO -- ^ The IO based writer to decorate-  -> LogWriter IO+  -> LogWriter (Lift IO )-- ^ The IO based writer to decorate+  -> LogWriter (Lift IO) defaultIoLogWriter appName facility = mappingLogWriterM-  (   setLogMessageTimestamp-  >=> setLogMessageHostname+  (   (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 IO, Lift IO]+type LoggingAndIo = '[Logs, LogWriterReader (Lift IO), Lift IO]  -- | Render a 'LogMessage' but set the timestamp and thread id fields. printLogMessage :: LogMessage -> IO ()

@@ -32,7 +32,7 @@   -> 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 IO : e) a+  -> Eff (Logs : LogWriterReader (Lift IO) : e) a   -> Eff e a withUDPLogging render hostname port a f p e = liftBaseOp   (withUDPSocket render hostname port)@@ -43,7 +43,7 @@ -- -- See 'Control.Eff.Log.Examples.exampleUdpRFC3164Logging' withUDPLogWriter-  :: (Lifted IO e, LogsTo IO e, MonadBaseControl IO (Eff e), HasCallStack)+  :: (LogIo 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 IO -> IO a)+  -> (LogWriter (Lift IO) -> IO a)   -> IO a withUDPSocket render hostname port ioE = Safe.bracket   (do

@@ -31,7 +31,7 @@   -> 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 IO : e) a+  -> Eff (Logs : LogWriterReader (Lift IO) : e) a   -> Eff e a withUnixSocketLogging render socketPath a f p e = liftBaseOp   (withUnixSocketSocket render socketPath)@@ -41,7 +41,7 @@ -- -- See 'Control.Eff.Log.Examples.exampleDevLogSyslogLogging' withUnixSocketLogWriter-  :: (Lifted IO e, LogsTo IO e, MonadBaseControl IO (Eff e), HasCallStack)+  :: (LogIo 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 IO -> IO a)+  -> (LogWriter (Lift IO) -> IO a)   -> IO a withUnixSocketSocket render socketPath ioE = Safe.bracket   (socket AF_UNIX Datagram defaultProtocol)

@@ -51,7 +51,7 @@     assertBool title result  applySchedulerFactory ::-     forall r. (Lifted IO r, LogsTo IO r)+     forall r. (LogIo r)   => IO (Eff (Processes r) () -> IO ())   -> Eff (Processes r) ()   -> IO ()

@@ -26,13 +26,13 @@       logInfo "jo"       logDebug "oh" -    pureLogs :: Eff '[Logs, LogWriterReader CaptureLogs, CaptureLogWriter] a -> [LogMessage]+    pureLogs :: Eff '[Logs, LogWriterReader CaptureLogWriter, CaptureLogWriter] a -> [LogMessage]     pureLogs =         snd       . run       . runCaptureLogWriter       . withLogging captureLogWriter-      . censorLogs @CaptureLogs (lmSrcLoc .~ Nothing)+      . censorLogs @CaptureLogWriter (lmSrcLoc .~ Nothing)  strictness :: HasCallStack => TestTree strictness =

@@ -66,7 +66,7 @@  allTests   :: forall r-   . (Lifted IO r, LogsTo IO r, Typeable r)+   . (LogIo r, Typeable r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree allTests schedulerFactory = localOption@@ -126,29 +126,29 @@  returnToSenderServer   :: forall q-   . (HasCallStack, Lifted IO q, LogsTo IO q, Member Logs q, Typeable q)+   . (HasCallStack, LogIo q, Typeable q)   => Eff (Processes q) (Endpoint ReturnToSender) returnToSenderServer =   Callback.start @ReturnToSender-    (const id)-    (\_me evt ->-      case evt of-        OnCall rt msg ->-          case msg of-            StopReturnToSender -> interrupt testInterruptReason-            ReturnToSender fromP echoMsg -> do-              sendMessage fromP echoMsg-              yieldProcess-              sendReply rt True-        OnInterrupt i ->-          interrupt i-        other -> interrupt (ErrorInterrupt (show other))-    )-    "return-to-sender"+    $ Callback.onEvent+        (\evt ->+          case evt of+            OnCall rt msg ->+              case msg of+                StopReturnToSender -> interrupt testInterruptReason+                ReturnToSender fromP echoMsg -> do+                  sendMessage fromP echoMsg+                  yieldProcess+                  sendReply rt True+            OnInterrupt i ->+              interrupt i+            other -> interrupt (ErrorInterrupt (show other))+        )+        "return-to-sender"  selectiveReceiveTests   :: forall r-   . (Lifted IO r, LogsTo IO r, Typeable r)+   . (LogIo r, Typeable r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree selectiveReceiveTests schedulerFactory = setTravisTestOptions@@ -201,7 +201,7 @@  yieldLoopTests   :: forall r-   . (Lifted IO r, LogsTo IO r)+   . (LogIo r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree yieldLoopTests schedulerFactory =@@ -243,7 +243,7 @@  pingPongTests   :: forall r-   . (Lifted IO r, LogsTo IO r)+   . (LogIo r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree pingPongTests schedulerFactory = testGroup@@ -318,7 +318,7 @@  errorTests   :: forall r-   . (Lifted IO r, LogsTo IO r)+   . (LogIo r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree errorTests schedulerFactory = testGroup@@ -363,7 +363,7 @@  concurrencyTests   :: forall r-   . (Lifted IO r, LogsTo IO r)+   . (LogIo r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree concurrencyTests schedulerFactory =@@ -474,7 +474,7 @@  exitTests   :: forall r-   . (Lifted IO r, LogsTo IO r)+   . (LogIo r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree exitTests schedulerFactory =@@ -624,7 +624,7 @@  sendShutdownTests   :: forall r-   . (Lifted IO r, LogsTo IO r)+   . (LogIo r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree sendShutdownTests schedulerFactory = testGroup@@ -717,7 +717,7 @@  linkingTests   :: forall r-   . (Lifted IO r, LogsTo IO r)+   . (LogIo r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree linkingTests schedulerFactory = setTravisTestOptions@@ -931,7 +931,7 @@  monitoringTests   :: forall r-   . (Lifted IO r, LogsTo IO r)+   . (LogIo r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree monitoringTests schedulerFactory = setTravisTestOptions@@ -1001,7 +1001,7 @@  timerTests   :: forall r-   . (Lifted IO r, LogsTo IO r)+   . (LogIo r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree timerTests schedulerFactory = setTravisTestOptions@@ -1057,7 +1057,7 @@   )  processDetailsTests ::-     forall r. (Lifted IO r, LogsTo IO r)+     forall r. (LogIo r)   => IO (Eff (Processes r) () -> IO ())   -> TestTree processDetailsTests schedulerFactory =