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+
11+ module Benign.Katip
12+ ( withKatipContext ,
13+ withKatipNamespace ,
14+ withKatip ,
15+ logLocM ,
16+ )
17+ where
418
519import Benign qualified
620import GHC.Stack
@@ -28,7 +42,7 @@ withKatipContext item = Benign.withAltering katipContext (<> Just (Katip.liftPay
2842withKatipNamespace :: Katip. Namespace -> Benign. Strat a -> a -> a
2943withKatipNamespace namespace = Benign. withAltering katipNamespace (<> Just namespace)
3044
31- -- | Within this computation, Katip is configured.
45+ -- | Within this computation, Katip is configured for pure code .
3246withKatip ::
3347 (Katip. LogItem c ) =>
3448 Katip. LogEnv ->
@@ -42,7 +56,9 @@ withKatip env ctx namespace strat =
4256 . Benign. withSettingIO' katipContext (Katip. liftPayload ctx)
4357 . Benign. withSettingIO katipNamespace namespace strat
4458
45- logLocM :: forall a . (HasCallStack ) => Katip. Severity -> Katip. LogStr -> Benign. Strat a -> a -> a
59+ -- | @'logLocM' s msg a@ logs a an event, like Katip's 'Katip.logLocM', before
60+ -- evaluating @a@.
61+ logLocM :: forall a . (HasCallStack ) => Katip. Severity -> Katip. LogStr -> a -> a
4662logLocM severity str = withFrozenCallStack spanLog
4763 where
4864 -- The whole purpose of naming `span` is to freeze the call stack. It's
@@ -53,16 +69,16 @@ logLocM severity str = withFrozenCallStack spanLog
5369 -- scratch. This would be invisible. I tried to harden this function by
5470 -- declaring type signatures everywhere. I haven't tested it yet though. It
5571 -- may be wrong.
56- spanLog :: HasCallStack => Benign. Strat a - > a -> a
57- spanLog = Benign. unsafeSpanBenign doLog (return () )
72+ spanLog :: ( HasCallStack ) = > a -> a
73+ spanLog = Benign. unsafeSpanBenign doLog (return () ) Benign. whnf
5874
59- doLog :: HasCallStack => IO ()
75+ doLog :: ( HasCallStack ) => IO ()
6076 doLog = do
6177 -- Making an intermediary `KatipContextT` is a little roundabout, but it's
6278 -- easier than reaching to Katip's internals.
6379 --
6480 -- TODO: catch errors
65- Just env <- Benign. lookupLocalState katipEnv
66- Just ctx <- Benign. lookupLocalState katipContext
67- Just namespace <- Benign. lookupLocalState katipNamespace
81+ Just env <- Benign. lookupLexicalState katipEnv
82+ Just ctx <- Benign. lookupLexicalState katipContext
83+ Just namespace <- Benign. lookupLexicalState katipNamespace
6884 Katip. runKatipContextT env ctx namespace $ Katip. logLocM severity str
0 commit comments