simple-log 0.1.5 → 0.1.6

raw patch · 2 files changed

+27/−12 lines, 2 files

Files

• simple-log.cabal +2/−1
• src/System/Log/Monad.hs +25/−11

@@ -1,5 +1,5 @@ Name:                 simple-log
-Version:              0.1.5
+Version:              0.1.6
 Synopsis:             Simple log for Haskell
 Description:          Log library for Haskell with removing unnecessary traces
 License:              BSD3
@@ -10,6 +10,7 @@ Category:             Logging
 Build-type:           Simple
 Cabal-version:        >= 1.6
+Tested-with:          GHC == 7.6.1
 
 Library
   HS-Source-Dirs: src

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE OverloadedStrings, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses #-}
 
 module System.Log.Monad (
     withNoLog,
@@ -6,6 +6,7 @@     log,
     scope_,
     scope,
+    scopeM_,
     scopeM,
     scoper,
     scoperM,
@@ -15,13 +16,13 @@     MonadLog(..)
     ) where
 
-import Prelude hiding (log, catch)
+import Prelude hiding (log)
 
 import Control.Exception (SomeException)
 import Control.Monad.IO.Class
 import Control.Monad.Reader
 import Control.Monad.Error
-import Control.Monad.CatchIO
+import Control.Monad.CatchIO as C
 import Data.String
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -54,19 +55,32 @@ 
 -- | Scope with log all exceptions
 scope :: (MonadLog m) => Text -> m a -> m a
-scope s act = scope_ s $ catch act onError where
+scope s act = scope_ s $ C.catch act onError where
     onError :: (MonadLog m) => SomeException -> m a
     onError e = do
         log Error $ T.concat ["Scope leaves with exception: ", fromString . show $ e]
         throw e
 
--- | Scope with log exceptions from MonadError
+-- | Workaround: we must explicitely post 'LeaveScope'
+scopeM_ :: (MonadLog m, MonadError e m) => Text -> m a -> m a
+scopeM_ s act = do
+    (Log post getRules) <- askLog
+    rs <- liftIO getRules
+    let
+        close = liftIO $ post LeaveScope
+    bracket_ (liftIO $ post $ EnterScope s rs) close (catchError act (\e -> close >> throwError e))
+
+-- | Scope with log exceptions from 'MonadError'
+-- | Workaround: we must explicitely post 'LeaveScope'
 scopeM :: (Error e, Show e, MonadLog m, MonadError e m) => Text -> m a -> m a
-scopeM s act = scope s $ catchError act onError where
-    onError :: (Error e, Show e, MonadLog m, MonadError e m) => e -> m a
-    onError e = do
-        log Error $ T.concat ["Scope leaves with exception: ", fromString . show $ e]
-        throwError e
+scopeM s act = scopeM_ s $ C.catch act' onError' where
+    onError' :: (MonadLog m) => SomeException -> m a
+    onError' e = logE e >> throw e
+    act' = catchError act onError
+    onError :: (MonadLog m, Show e, MonadError e m) => e -> m a
+    onError e = logE e >> throwError e
+    logE :: (MonadLog m, Show e) => e -> m ()
+    logE e = log Error $ T.concat ["Scope leaves with exception: ", fromString . show $ e]
 
 -- | Scope with tracing result
 scoper :: (Show a, MonadLog m) => Text -> m a -> m a
@@ -83,7 +97,7 @@ 
 -- | Ignore error
 ignoreError :: (MonadLog m) => m () -> m ()
-ignoreError act = catch act onError where
+ignoreError act = C.catch act onError where
     onError :: (MonadLog m) => SomeException -> m ()
     onError _ = return ()