git.iko.soy/typeable/katip
on master help sign in
Add standard combinator to log exceptions
commitd2de8542ec22ac37ea70cf03d666caaaad8cc253 authorOzgun Ataman <ozgun.ataman@soostone.com> dateFri 27 Nov 2015, 16:35 (11 years ago) parentccdce47
4 files changed+39−1
compare with master
unifiedsplit
katip/src/Katip.hs+2 katip/src/Katip/Core.hs+19 katip/src/Katip/Monadic.hs+18 katip/src/Katip/Scribes/Handle.hs−1
katip/src/Katip.hs+2
@@ -57,9 +57,11 @@ module Katip
5757 , logMsg
5858 , logT
5959 , logItem
60+ , logException
6061 , logFM
6162 , logTM
6263 , logItemM
64+ , logExceptionM
6365
6466 -- * Transformer for appending to a log context
6567 , LogT
katip/src/Katip/Core.hs+19
@@ -592,6 +592,25 @@ logF
592592logF a ns sev msg = logItem a ns Nothing sev msg
593593
594594
595+
596+-------------------------------------------------------------------------------
597+-- | Perform an action while logging any exceptions that may occur.
598+-- Inspired by 'onException`.
599+--
600+-- >>>> logException (error "foo") () mempty ErrorS
601+logException
602+ :: (Katip m, LogItem a, MonadCatch m, Applicative m)
603+ => m b -- ^ Main action being run
604+ -> a -- ^ Log context
605+ -> Namespace -- ^ Namespace
606+ -> Severity -- ^ Severity
607+ -> m b
608+logException action a ns sev = action `catchAll` \e -> f e >> throwM e
609+ where
610+ f e = logF a ns sev (msg e)
611+ msg e = ls (T.pack "An exception has occured: ") <> showLS e
612+
613+
595614-------------------------------------------------------------------------------
596615-- | Log a message without any payload/context or code location.
597616logMsg
katip/src/Katip/Monadic.hs+18
@@ -21,6 +21,7 @@ module Katip.Monadic
2121 logFM
2222 , logTM
2323 , logItemM
24+ , logExceptionM
2425
2526 -- * Machinery for merging typed log payloads/contexts
2627 , KatipContext(..)
@@ -64,6 +65,7 @@ import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT)
6465import Data.Aeson
6566import qualified Data.HashMap.Strict as HM
6667import Data.Monoid
68+import Data.Text (Text)
6769import Language.Haskell.TH
6870-------------------------------------------------------------------------------
6971import Katip.Core
@@ -179,6 +181,22 @@ logTM :: ExpQ
179181logTM = [| logItemM (Just $(getLoc)) |]
180182
181183
184+-------------------------------------------------------------------------------
185+-- | Perform an action while logging any exceptions that may occur.
186+-- Inspired by 'onException`.
187+--
188+-- >>>> error "foo" `logExceptionM` ErrorS
189+logExceptionM
190+ :: (KatipContext m, MonadCatch m, Applicative m)
191+ => m a -- ^ Main action to run
192+ -> Severity -- ^ Severity
193+ -> m a
194+logExceptionM action sev = action `catchAll` \e -> f e >> throwM e
195+ where
196+ f e = logFM sev (msg e)
197+ msg e = ls ("An exception has occured: " :: Text) <> showLS e
198+
199+
182200-------------------------------------------------------------------------------
183201-- | Wrapper over 'ReaderT' that provides a passthrough instance for
184202-- 'MonadReader' so your stack will not be affected. Also provides a
katip/src/Katip/Scribes/Handle.hs−1
@@ -14,7 +14,6 @@ import Data.Time
1414import qualified Data.Time.Locale.Compat as LC
1515import System.IO
1616import System.IO.Unsafe (unsafePerformIO)
17−import System.Locale as L
1817-------------------------------------------------------------------------------
1918import Katip.Core
2019-------------------------------------------------------------------------------