log-effect 1.1.1 → 1.2.0

raw patch · 3 files changed

+72/−20 lines, 3 filesdep +log-effectdep ~extensible-effectsnew-component:exe:log-examplePVP ok

version bump matches the API change (PVP)

Dependencies added: log-effect

Dependency ranges changed: extensible-effects

API changes (from Hackage documentation)

Files

• examples/log.hs +26/−0
• log-effect.cabal +18/−5
• src/Control/Eff/Log.hs +28/−15

@@ -0,0 +1,26 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+import Control.Concurrent+import Control.Eff+import Control.Eff.Log+import Control.Monad.Trans.Control (MonadBaseControl, liftBaseDiscard)++-- This function is declared in lifted-base package.+fork :: MonadBaseControl IO m => m () -> m ThreadId+fork = liftBaseDiscard forkIO++someComp :: ( [ Log String, LogM IO String ] <:: r+            , LiftedBase IO r+            ) => Eff r ()+someComp = do logE "Hello!"+              logM "Greetings from the main thread!"++              _ <- fork $ do logM "This is a new thread, and this message is still visible."+                             logE "Unfortunately, this one is not."+              return ()++main :: IO ()+main = runLift $ runLog l $ runLogM l $ someComp+  where+    l = stdoutLogger :: Logger IO String

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                log-effect-version:             1.1.1+version:             1.2.0 synopsis:            An extensible log effect using extensible-effects description:         Introduce two logging effects to your extensible effects arsenal homepage:            https://github.com/greydot/log-effect@@ -15,20 +15,33 @@ build-type:          Simple extra-source-files:  Changelog.md, README.md cabal-version:       >=1.10-Tested-With:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3+Tested-With:         GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.3  library   exposed-modules:     Control.Eff.Log-  -- other-modules:       -  -- other-extensions:       build-depends:       base >=4.6 && <5.0                      , bytestring >= 0.10 && < 0.11-                     , extensible-effects >= 3.0.0.0 && < 4.0.0.0+                     , extensible-effects >= 5.0.0.0 && < 5.1.0.0                      , monad-control >= 1.0 && < 1.1                      , text >= 1.2 && < 1.3                      , transformers-base >= 0.4 && < 0.5   hs-source-dirs:      src   default-language:    Haskell2010+  ghc-options:         -Wall++executable log-example+  build-depends:       base >=4.6 && <5.0+                     , bytestring >= 0.10 && < 0.11+                     , extensible-effects >= 5.0.0.0 && < 5.1.0.0+                     , log-effect == 1.2.0+                     , monad-control >= 1.0 && < 1.1+                     , text >= 1.2 && < 1.3+                     , transformers-base >= 0.4 && < 0.5+  hs-source-dirs:      examples+  main-is:             log.hs+  default-language:    Haskell2010+  ghc-options:         -Wall -threaded+  source-repository head   type: git

@@ -22,24 +22,30 @@                        , runLogM                        ) where -import Control.Applicative   ((<$>), (<*), (<$)) import Control.Eff import Control.Eff.Extend-import Control.Eff.Lift      (Lifted, lift) import Control.Monad         (when) import Control.Monad.Base    (MonadBase(..)) import Control.Monad.Trans.Control (MonadBaseControl(..)) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as Char8+import Data.Function (fix) import Data.Text (Text) import Data.Text.Encoding (encodeUtf8)-import Data.Typeable         (Typeable) import System.IO (stderr, stdout)  -- | Simple log effect, useful in pure code data Log l v where   Log :: l -> Log l () +instance Monad m => Handle (Log l) r a (b -> (l -> b -> b) -> m (a,b)) where+  handle step q (Log l) e append = step (q ^$ ()) e append >>=+    \(x, ls) -> return (x, l `append` ls)++instance Monad m => Handle (Log l) r a ((l -> m c) -> m a) where+  handle step q (Log l) action = step (q ^$ ()) action >>=+    \x -> action l >> return x+ instance ( MonadBase m m          , Lifted m r          , MonadBaseControl m (Eff r)@@ -51,9 +57,6 @@                     mapM_ logE ls                     return a -logLine :: Log a v -> a-logLine (Log l) = l- -- | Monadic action that does the real logging type Logger m l = l -> m () @@ -71,13 +74,17 @@  -- | Collect log messages in a list. runLogPure :: Eff (Log l ': r) a -> Eff r (a, [l])-runLogPure = handle_relay (\x -> return (x, []))-                          (\(Log l) k -> k () >>= \(x, ls) -> return (x, l:ls))+runLogPure m = fix (handle_relay ret) m [] (:)+  where+    ret :: Monad m => a -> b -> (l -> b -> b) -> m (a, b)+    ret l e _ = return (l, e)  -- | Run the 'Logger' action in the base monad for every log line. runLog :: Lifted m r => Logger m l -> Eff (Log l ': r) a -> Eff r a-runLog logger = handle_relay return-                             (\(Log l) k -> lift (logger l) >> k ())+runLog logger m = fix (handle_relay ret) m (lift . logger)+  where+    ret :: Monad m => a -> (l -> m c) -> m a+    ret a _ = return a  -- | Filter Log entries with a predicate. --@@ -85,10 +92,10 @@ -- will be required. filterLog :: forall l r a. Member (Log l) r           => (l -> Bool) -> Eff r a -> Eff r a-filterLog f = interpose return h+filterLog f = fix (respond_relay' h return)   where-    h :: Log l v -> (v -> Eff r b) -> Eff r b-    h (Log l) k = when (f l) (logE l) >> k ()+    h :: (Eff r b -> Eff r b) -> Arrs r v b -> Log l v -> Eff r b+    h step q (Log l) = when (f l) (logE l) >>= \x -> step (q ^$ x)   -- | Filter Log entries with a predicate and a proxy.@@ -112,8 +119,14 @@  -- | Run the 'Logger' action in the base monad for every log line. runLogM :: Lifted m r => Logger m l -> Eff (LogM m l ': r) a -> Eff r a-runLogM logger = handle_relay return-                              (\AskLogger -> ($ logger))+runLogM logger m = fix (handle_relay ret) m logger+  where+    ret :: Monad m' => a -> Logger m l -> m' a+    ret x _ = return x+++instance Monad m => Handle (LogM m' l) r a (Logger m' l -> m a) where+  handle step q AskLogger logger = step (q ^$ logger) logger  instance ( MonadBase m m          , Lifted m r