simple-log 0.4.0 → 0.5.0

raw patch · 3 files changed

+27/−9 lines, 3 filesdep ~directory

Dependency ranges changed: directory

Files

• simple-log.cabal +1/−1
• src/System/Log/Simple/Base.hs +4/−1
• src/System/Log/Simple/Monad.hs +22/−7

@@ -1,5 +1,5 @@ Name:                 simple-log
-Version:              0.4.0
+Version:              0.5.0
 Synopsis:             Simple log for Haskell
 Description:          Log library for Haskell with removing unnecessary traces
 License:              BSD3

@@ -173,7 +173,10 @@ 
 -- | Empty log
 noLog :: Log
-noLog = Log (const (return ())) (return ()) (return [])
+noLog = Log post' (return ()) (return []) where
+    post' (EnterScope _ _) = return ()
+    post' (LeaveScope io) = io
+    post' (PostMessage _) = return ()
 
 -- | Type to initialize rule updater
 type RulesLoad = IO (IO Rules)

@@ -1,6 +1,7 @@-{-# LANGUAGE OverloadedStrings, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
 
 module System.Log.Simple.Monad (
+    LogT(..),
     withNoLog,
     withLog,
     log,
@@ -22,6 +23,8 @@ import Control.Concurrent.MSem
 import Control.Monad.IO.Class
 import Control.Monad.Reader
+import Control.Monad.State
+import Control.Monad.Writer
 import Control.Monad.Except
 import Control.Monad.Catch
 import Data.String
@@ -33,14 +36,26 @@ class (MonadIO m, MonadMask m) => MonadLog m where
     askLog :: m Log
 
-instance (MonadIO m, MonadMask m) => MonadLog (ReaderT Log m) where
-    askLog = ask
+instance MonadLog m => MonadLog (ReaderT r m) where
+    askLog = lift askLog
 
-withNoLog :: ReaderT Log m a -> m a
-withNoLog act = runReaderT act noLog
+instance MonadLog m => MonadLog (StateT s m) where
+    askLog = lift askLog
 
-withLog :: Log -> ReaderT Log m a -> m a
-withLog l act = runReaderT act l
+instance (Monoid w, MonadLog m) => MonadLog (WriterT w m) where
+    askLog = lift askLog
+
+newtype LogT m a = LogT { runLogT :: ReaderT Log m a }
+    deriving (Functor, Applicative, Monad, MonadIO, MonadReader Log, MonadThrow, MonadCatch, MonadMask)
+
+instance (MonadIO m, MonadMask m) => MonadLog (LogT m) where
+    askLog = LogT ask
+
+withNoLog :: LogT m a -> m a
+withNoLog act = runReaderT (runLogT act) noLog
+
+withLog :: Log -> LogT m a -> m a
+withLog l act = runReaderT (runLogT act) l
 
 log :: (MonadLog m) => Level -> Text -> m ()
 log l msg = do