11{-# LANGUAGE GHC2021 #-}
22
3- module Benign.Katip where
3+ -- | This module is a small wrapper around
4+ -- [Katip](https://hackage.haskell.org/package/katip) to allow logging in pure
5+ -- code.
6+ --
7+ -- The wrapper is a little primitive still and you will have to handle the
8+ -- transition from IO code to pure code manually. Pull requests are, of course,
9+ -- welcome.
10+ module Benign.Katip
11+ ( withKatipContext ,
12+ withKatipNamespace ,
13+ withKatip ,
14+ logLocM ,
15+ )
16+ where
417
518import Benign qualified
619import GHC.Stack
@@ -28,7 +41,7 @@ withKatipContext item = Benign.withAltering katipContext (<> Just (Katip.liftPay
2841withKatipNamespace :: Katip. Namespace -> Benign. Strat a -> a -> a
2942withKatipNamespace namespace = Benign. withAltering katipNamespace (<> Just namespace)
3043
31- -- | Within this computation, Katip is configured.
44+ -- | Within this computation, Katip is configured for pure code .
3245withKatip ::
3346 (Katip. LogItem c ) =>
3447 Katip. LogEnv ->
@@ -42,7 +55,9 @@ withKatip env ctx namespace strat =
4255 . Benign. withSettingIO' katipContext (Katip. liftPayload ctx)
4356 . Benign. withSettingIO katipNamespace namespace strat
4457
45- logLocM :: forall a . (HasCallStack ) => Katip. Severity -> Katip. LogStr -> Benign. Strat a -> a -> a
58+ -- | @'logLocM' s msg a@ logs a an event, like Katip's 'Katip.logLocM', before
59+ -- evaluating @a@.
60+ logLocM :: forall a . (HasCallStack ) => Katip. Severity -> Katip. LogStr -> a -> a
4661logLocM severity str = withFrozenCallStack spanLog
4762 where
4863 -- The whole purpose of naming `span` is to freeze the call stack. It's
@@ -53,16 +68,16 @@ logLocM severity str = withFrozenCallStack spanLog
5368 -- scratch. This would be invisible. I tried to harden this function by
5469 -- declaring type signatures everywhere. I haven't tested it yet though. It
5570 -- may be wrong.
56- spanLog :: HasCallStack => Benign. Strat a - > a -> a
57- spanLog = Benign. unsafeSpanBenign doLog (return () )
71+ spanLog :: ( HasCallStack ) = > a -> a
72+ spanLog = Benign. unsafeSpanBenign doLog (return () ) Benign. whnf
5873
59- doLog :: HasCallStack => IO ()
74+ doLog :: ( HasCallStack ) => IO ()
6075 doLog = do
6176 -- Making an intermediary `KatipContextT` is a little roundabout, but it's
6277 -- easier than reaching to Katip's internals.
6378 --
6479 -- TODO: catch errors
65- Just env <- Benign. lookupLocalState katipEnv
66- Just ctx <- Benign. lookupLocalState katipContext
67- Just namespace <- Benign. lookupLocalState katipNamespace
80+ Just env <- Benign. lookupLexicalState katipEnv
81+ Just ctx <- Benign. lookupLexicalState katipContext
82+ Just namespace <- Benign. lookupLexicalState katipNamespace
6883 Katip. runKatipContextT env ctx namespace $ Katip. logLocM severity str
0 commit comments