log-effect 0.4.0.1 → 1.0.0

raw patch · 6 files changed

+138/−205 lines, 6 filesdep +monad-controldep +textdep +transformers-basedep −fast-loggerdep −timedep ~basedep ~bytestringdep ~extensible-effectsnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: monad-control, text, transformers-base

Dependencies removed: fast-logger, time

Dependency ranges changed: base, bytestring, extensible-effects

API changes (from Hackage documentation)

Files

• Changelog.md +12/−0
• LICENSE +1/−0
• examples/IOLogger.hs +0/−17
• log-effect.cabal +13/−13
• src/Control/Eff/Log.hs +112/−101
• src/Control/Eff/Log/Simple.hs +0/−74

@@ -1,5 +1,17 @@ # Changelog +## Version 1.0++	* Complete revamp of the logging effects.++	* Add LogM effect.++	* Add MonadBaseControl instances.++	* Remove fast-logger dependency in favor of a custom typeclass.+++ ## Version 0.4   * add a proxy to most `runLog` functions to not have to supply the full

@@ -1,6 +1,7 @@ The MIT License (MIT)  Copyright (c) 2013, 2014 Tobias Florek (me@ibotty.net)+Copyright (c) 2018 Lana Black (lanablack@amok.cc)  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,17 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Main (main) where--import Control.Eff-import Control.Eff.Lift-import Control.Eff.Log-import System.Log.FastLogger--data Proxy a = Proxy--main :: IO ()-main = do-    loggerSet <- newStderrLoggerSet defaultBufSize-    pushLogStr loggerSet "logging from outer space^WIO\n"-    runLift $ runLogWithLoggerSet loggerSet (Proxy :: Proxy String) $-        logE ("logging from inner Eff" :: String)-    flushLogStr loggerSet

@@ -2,35 +2,35 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                log-effect-version:             0.4.0.1+version:             1.0.0 synopsis:            An extensible log effect using extensible-effects-description:         Any help (especially documentation) is very welcome,-homepage:            https://github.com/ibotty/log-effect+description:         Introduce two logging effects to your extensible effects arsenal+homepage:            https://github.com/greydot/log-effect license:             MIT license-file:        LICENSE-author:              Tobias Florek-maintainer:          tob@butter.sh+author:              Tobias Florek, Lana Black+maintainer:          Lana Black <lanablack@amok.cc> -- copyright:            category:            Control, Effect, Logging build-type:          Simple extra-source-files:    Changelog.md-                     , examples/IOLogger.hs cabal-version:       >=1.10+Tested-With:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1  library   exposed-modules:     Control.Eff.Log-                     , Control.Eff.Log.Simple   -- other-modules:          -- other-extensions:    -  build-depends:       base >=4.6 && <4.8-                     , bytestring >=0.10.2 && <0.11-                     , extensible-effects ==1.4.* || ==1.7.*-                     , fast-logger >=2.1.4 && <2.2-                     , time >=1.4 && <1.5+  build-depends:       base >=4.6 && <5.0+                     , bytestring >= 0.10+                     , extensible-effects >= 2.5.1.0+                     , monad-control >= 1.0+                     , text >= 1.2+                     , transformers-base >= 0.4   hs-source-dirs:      src   default-language:    Haskell2010  source-repository head   type: git-  location: https://github.com/ibotty/log-effect+  location: https://github.com/greydot/log-effect 

@@ -1,128 +1,139 @@-{-# LANGUAGE DeriveDataTypeable    #-}-{-# LANGUAGE DeriveFunctor         #-}-{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeOperators         #-}-module Control.Eff.Log-  ( Log(Log, logLine)-  , Logger-  , logE-  , filterLog-  , filterLog'-  , runLogPure-  , runLogStdout-  , runLogStderr-  , runLogFile-  , runLogWithLoggerSet-  , runLog-  ) where+module Control.Eff.Log ( Log+                       , LogM+                       , Logger+                       , stdoutLogger+                       , stderrLogger+                       , LogMessage(..)+                       , logE+                       , logM+                       , filterLog+                       , filterLog'+                       , runLogPure+                       , runLog+                       , runLogM+                       ) where -import Control.Applicative   ((<$>), (<*))-import Control.Eff           ((:>), Eff, Member, SetMember, VE (..), admin,-                              handleRelay, inj, interpose, send)-import Control.Eff.Lift      (Lift, lift)-import Data.Monoid           ((<>))-import Data.Typeable         (Typeable, Typeable1)-import System.Log.FastLogger (LogStr, LoggerSet, ToLogStr, defaultBufSize,-                              flushLogStr, fromLogStr, newFileLoggerSet,-                              newStderrLoggerSet, newStdoutLoggerSet,-                              pushLogStr, toLogStr)+import Control.Applicative   ((<$>), (<*), (<$))+import Control.Eff+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.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import Data.Typeable         (Typeable)+import System.IO (stderr, stdout) -import qualified Data.ByteString.Char8 as B8+-- | Simple log effect, useful in pure code+data Log l v where+  Log :: l -> Log l () -data Log a v = Log-  { logLine :: a-  , logNext :: v-  } deriving (Typeable, Functor)+instance ( MonadBase m m+         , Lifted m r+         , MonadBaseControl m (Eff r)+         ) => MonadBaseControl m (Eff (Log l ': r)) where+    type StM (Eff (Log l ': r)) a = StM (Eff r) (a, [l])+    liftBaseWith f = raise $ liftBaseWith $ \runInBase ->+                       f (runInBase . runLogPure)+    restoreM x = do (a, ls :: [l]) <- raise (restoreM x)+                    mapM_ logE ls+                    return a --- | a monadic action that does the real logging-type Logger m l = forall v. Log l v -> m ()+logLine :: Log a v -> a+logLine (Log l) = l +-- | Monadic action that does the real logging+type Logger m l = l -> m ()++-- | Logger that outputs messages to stdout+stdoutLogger :: (LogMessage l, MonadBase IO m) => Logger m l+stdoutLogger = liftBase . Char8.hPutStrLn stdout . toMsg++-- | Logger that outputs messages to stderr+stderrLogger :: (LogMessage l, MonadBase IO m) => Logger m l+stderrLogger = liftBase . Char8.hPutStrLn stderr . toMsg+ -- | Log something.-logE :: (Typeable l, Member (Log l) r)-  => l -> Eff r ()-logE line = send $ \next -> inj (Log line (next ()))+logE :: Member (Log l) r => l -> Eff r ()+logE = send . Log  -- | Collect log messages in a list.-runLogPure :: (Typeable l)-  => Eff (Log l :> r) a-  -> Eff r (a, [l])-runLogPure = go . admin-  where go (Val v) = return (v, [])-        go (E req) = handleRelay req go performLog-        performLog l = fmap (prefixLogWith l) (go (logNext l))-        prefixLogWith log' (v, l) = (v, logLine log' : l)+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))  -- | Run the 'Logger' action in the base monad for every log line.-runLog :: (Typeable l, Typeable1 m, SetMember Lift (Lift m) r)-  => Logger m l -> Eff (Log l :> r) a -> Eff r a-runLog logger = go . admin-  where go (Val v) = return v-        go (E req) = handleRelay req go performLog-        performLog l = lift (logger l) >> go (logNext l)+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 ())  -- | Filter Log entries with a predicate. -- -- Note that, most of the time an explicit type signature for the predicate -- will be required.-filterLog :: (Typeable l, Member (Log l) r)-  => (l -> Bool) -> Eff r a -> Eff r a-filterLog f = go . admin-  where go (Val v) = return v-        go (E req) = interpose req go filter'-          where filter' (Log l v) = if f l then send (<$> req) >>= go-                                           else go v+filterLog :: forall l r a. Member (Log l) r+          => (l -> Bool) -> Eff r a -> Eff r a+filterLog f = interpose return h+  where+    h :: Log l v -> (v -> Eff r b) -> Eff r b+    h (Log l) k = when (f l) (logE l) >> k () + -- | Filter Log entries with a predicate and a proxy. -- -- This is the same as 'filterLog' but with a proxy l for type inference.-filterLog' :: (Typeable l, Member (Log l) r)-  => (l -> Bool) -> proxy l -> Eff r a -> Eff r a+filterLog' :: Member (Log l) r+           => (l -> Bool) -> proxy l -> Eff r a -> Eff r a filterLog' predicate _ = filterLog predicate --- | Log to stdout.-runLogStdout :: (Typeable l, ToLogStr l, SetMember Lift (Lift IO) r)-  => proxy l -> Eff (Log l :> r) a -> Eff r a-runLogStdout proxy eff = do-    s <- lift $ newStdoutLoggerSet defaultBufSize-    runLogWithLoggerSet s proxy eff <* lift (flushLogStr s)+-- | A more advanced version of 'Log'. Adds an ability to log from multiple threads.+data LogM m l v where+  AskLogger :: LogM m l (Logger m l) --- | Log to stderr.-runLogStderr :: (Typeable l, ToLogStr l, SetMember Lift (Lift IO) r)-  => proxy l -> Eff (Log l :> r) a -> Eff r a-runLogStderr proxy eff = do-    s <- lift $ newStderrLoggerSet defaultBufSize-    runLogWithLoggerSet s proxy eff <* lift (flushLogStr s)+askLogger :: Member (LogM m l) r => Eff r (Logger m l)+askLogger = send AskLogger --- | Log to file.-runLogFile :: (Typeable l, ToLogStr l, SetMember Lift (Lift IO) r)-  => FilePath -> proxy l -> Eff (Log l :> r) a -> Eff r a-runLogFile f proxy eff = do-    s <- lift $ newFileLoggerSet defaultBufSize f-    runLogWithLoggerSet s proxy eff <* lift (flushLogStr s)+-- | Log something using `LogM` effect+logM :: (Member (LogM m l) r, Lifted m r) => l -> Eff r ()+logM l = do logger <- askLogger+            lift (logger l) --- | Log to a file using a 'LoggerSet'.------ Note, that you will still have to call 'flushLogStr' on the 'LoggerSet'--- at one point.------ With that function you can combine a logger in a surrounding IO action--- with a logger in the 'Eff' effect.------ >data Proxy a = Proxy--- >--- > main :: IO ()--- > main = do--- >     loggerSet <- newStderrLoggerSet defaultBufSize--- >     pushLogStr loggerSet "logging from outer space^WIO\n"--- >     runLift $ runLogWithLoggerSet loggerSet (Proxy :: Proxy String) $--- >         logE ("logging from within Eff" :: String)--- >     flushLogStr loggerSet-runLogWithLoggerSet :: (Typeable l, ToLogStr l, SetMember Lift (Lift IO) r)-  => LoggerSet -> proxy l -> Eff (Log l :> r) a -> Eff r a-runLogWithLoggerSet s _ = runLog (loggerSetLogger s)+-- | 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)) -loggerSetLogger :: ToLogStr l => LoggerSet -> Logger IO l-loggerSetLogger loggerSet = pushLogStr loggerSet . (<> "\n") . toLogStr . logLine+instance ( MonadBase m m+         , Lifted m r+         , MonadBaseControl m (Eff r)+         ) => MonadBaseControl m (Eff (LogM m l ': r)) where+    type StM (Eff (LogM m l ': r)) a = StM (Eff r) a+    liftBaseWith f = do l <- askLogger+                        raise $ liftBaseWith $ \runInBase ->+                          f (runInBase . runLogM l)+    restoreM = raise . restoreM++-- | Handy typeclass to convert log messages for output+class LogMessage l where+  toMsg :: l -> ByteString+  {-# MINIMAL toMsg #-}++instance LogMessage ByteString where+  toMsg = id++instance LogMessage [Char] where+  toMsg = Char8.pack++instance LogMessage Text where+  toMsg = encodeUtf8

@@ -1,74 +0,0 @@-{-# LANGUAGE DeriveDataTypeable    #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE RankNTypes            #-}-{-# LANGUAGE TypeOperators         #-}-module Control.Eff.Log.Simple-  ( SimpleLog-  , Severity(..)-  , logTo-  , debug-  , info-  , notice-  , warning-  , error-  , critical-  , alert-  , panic-  ) where--import Control.Eff           (Eff, Member)-import Control.Eff.Log-import Data.Monoid           ((<>))-import Data.Typeable         (Typeable)-import Prelude               hiding (error)-import System.Log.FastLogger (ToLogStr, toLogStr)--data Severity =-    DEBUG | INFO | NOTICE | WARNING | ERROR | CRITICAL | ALERT | PANIC-  deriving (Bounded, Enum, Eq, Ord, Read, Show, Typeable)--type SimpleLog a = Log (Severity, a)--instance ToLogStr Severity where-    toLogStr DEBUG    = "DEBUG"-    toLogStr INFO     = "INFO"-    toLogStr NOTICE   = "NOTICE"-    toLogStr WARNING  = "WARNING"-    toLogStr ERROR    = "ERROR"-    toLogStr CRITICAL = "CRITICAL"-    toLogStr ALERT    = "ALERT"-    toLogStr PANIC    = "PANIC"--instance ToLogStr a => ToLogStr (Severity, a) where-    toLogStr (sev, line) = "[" <> toLogStr sev <> "] " <> toLogStr line <> "\n"--logTo :: (Typeable l, Member (Log (Severity, l)) r)-  => Severity -> l -> Eff r ()-logTo sev line = logE (sev, line)--debug :: (Typeable l, Member (Log (Severity, l)) r) => l -> Eff r ()-debug = logTo DEBUG--info :: (Typeable l, Member (Log (Severity, l)) r) => l -> Eff r ()-info = logTo INFO--notice :: (Typeable l, Member (Log (Severity, l)) r) => l -> Eff r ()-notice = logTo NOTICE--warning :: (Typeable l, Member (Log (Severity, l)) r) => l -> Eff r ()-warning = logTo WARNING--error :: (Typeable l, Member (Log (Severity, l)) r) => l -> Eff r ()-error = logTo ERROR--critical :: (Typeable l, Member (Log (Severity, l)) r) => l -> Eff r ()-critical = logTo CRITICAL--alert :: (Typeable l, Member (Log (Severity, l)) r) => l -> Eff r ()-alert = logTo ALERT--panic :: (Typeable l, Member (Log (Severity, l)) r) => l -> Eff r ()-panic = logTo PANIC