d2de854 · typeable/katip

katip/src/Katip.hs+2

compare with master

unifiedsplit

@@ -57,9 +57,11 @@ module Katip

57 , logMsg

58 , logT

59 , logItem

60+ , logException

60 , logFM

61 , logFM

61 , logTM

62 , logTM

62 , logItemM

63 , logItemM

64+ , logExceptionM

63

65

64 -- * Transformer for appending to a log context

66 -- * Transformer for appending to a log context

65 , LogT

67 , LogT

katip/src/Katip/Core.hs+19

@@ -592,6 +592,25 @@ logF

592logF a ns sev msg = logItem a ns Nothing sev msg

593

594

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+

595-------------------------------------------------------------------------------

614-------------------------------------------------------------------------------

596-- | Log a message without any payload/context or code location.

615-- | Log a message without any payload/context or code location.

597logMsg

616logMsg

katip/src/Katip/Monadic.hs+18

@@ -21,6 +21,7 @@ module Katip.Monadic

21 logFM

22 , logTM

23 , logItemM

24+ , logExceptionM

24

25

25 -- * Machinery for merging typed log payloads/contexts

26 -- * Machinery for merging typed log payloads/contexts

26 , KatipContext(..)

27 , KatipContext(..)

@@ -64,6 +65,7 @@ import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT)

64import Data.Aeson

65import Data.Aeson

65import qualified Data.HashMap.Strict as HM

66import qualified Data.HashMap.Strict as HM

66import Data.Monoid

67import Data.Monoid

68+import Data.Text (Text)

67import Language.Haskell.TH

69import Language.Haskell.TH

68-------------------------------------------------------------------------------

70-------------------------------------------------------------------------------

69import Katip.Core

71import Katip.Core

@@ -179,6 +181,22 @@ logTM :: ExpQ

179logTM = [| logItemM (Just $(getLoc)) |]

181logTM = [| logItemM (Just $(getLoc)) |]

180

182

181

183

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+

182-------------------------------------------------------------------------------

200-------------------------------------------------------------------------------

183-- | Wrapper over 'ReaderT' that provides a passthrough instance for

201-- | Wrapper over 'ReaderT' that provides a passthrough instance for

184-- 'MonadReader' so your stack will not be affected. Also provides a

202-- '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

14import qualified Data.Time.Locale.Compat as LC

15import System.IO

16import System.IO.Unsafe (unsafePerformIO)

17−import System.Locale as L

18-------------------------------------------------------------------------------

17-------------------------------------------------------------------------------

19import Katip.Core

18import Katip.Core

20-------------------------------------------------------------------------------

19-------------------------------------------------------------------------------