8c214b8 · typeable/katip

git.iko.soy/typeable/katip

Add katipNoLogging combinator, examples

This is for #26

commit8c214b88cc5a05506709973b4e5e778e7f5128a2 authorMichael Xavier <michael@michaelxavier.net> dateFri 13 May 2016, 12:17 (10 years ago) parentd9ae92f

5 files changed+38−1

compare with master

unifiedsplit

katip/examples/example.hs+8 katip/examples/example_lens.hs+8 katip/src/Katip.hs+1 katip/src/Katip/Core.hs+4−1 katip/src/Katip/Monadic.hs+17

katip/examples/example.hs+8

@@ -45,6 +45,8 @@ main = do

4545 $(logTM) DebugS "Confrabulating widgets, with extra namespace and context"

4646 confrabulateWidgets

4747 $(logTM) InfoS "Namespace and context are back to normal"

48+ noLogging $

49+ $(logTM) DebugS "You'll never see this log message!"

4850

4951

5052-------------------------------------------------------------------------------

@@ -104,6 +106,12 @@ addNamespace :: (MonadReader MyState m) => Namespace -> m a -> m a

104106addNamespace ns = local (\r -> r { msKNamespace = msKNamespace r <> ns })

105107

106108

109+-------------------------------------------------------------------------------

110+-- | Disable all log output temporarily

111+noLogging :: (MonadReader MyState m) => m a -> m a

112+noLogging = local (\r -> r { msLogEnv = clearScribes (msLogEnv r)})

113+

114+

107115-------------------------------------------------------------------------------

108116runStack :: MyState -> MyStack m a -> m a

109117runStack s f = runReaderT (unStack f) s

katip/examples/example_lens.hs+8

@@ -61,6 +61,8 @@ main = do

6161 $(logTM) DebugS "Confrabulating widgets, with extra namespace and context"

6262 confrabulateWidgets

6363 $(logTM) InfoS "Namespace and context are back to normal"

64+ noLogging $

65+ $(logTM) DebugS "You'll never see this log message!"

6466

6567

6668-------------------------------------------------------------------------------

@@ -112,6 +114,12 @@ addNamespace :: (MonadReader r m, HasMyState r) => Namespace -> m a -> m a

112114addNamespace ns = local (\r -> r & msKNamespace <>~ ns)

113115

114116

117+-------------------------------------------------------------------------------

118+-- | Disable all log output temporarily

119+noLogging :: (MonadReader r m, HasMyState r) => m a -> m a

120+noLogging = local (\r -> r & msLogEnv %~ clearScribes)

121+

122+

115123-------------------------------------------------------------------------------

116124runStack :: MyState -> MyStack m a -> m a

117125runStack s f = runReaderT (unStack f) s

katip/src/Katip.hs+1

@@ -106,6 +106,7 @@ module Katip

106106 , runKatipContextT

107107 , katipAddNamespace

108108 , katipAddContext

109+ , katipNoLogging

109110 ) where

110111

111112-------------------------------------------------------------------------------

katip/src/Katip/Core.hs+4−1

@@ -551,7 +551,10 @@ unregisterScribe nm = logEnvScribes %~ M.delete nm

551551

552552-------------------------------------------------------------------------------

553553-- | Unregister *all* scribes. Logs will go off into space from this

554−-- point onward until new scribes are added.

554+-- point onward until new scribes are added. Note that you could use

555+-- this with `local` if you're using a Reader based stack to

556+-- temporarily disable log output. See `katipNoLogging` for an

557+-- example.

555558clearScribes

556559 :: LogEnv

557560 -> LogEnv

katip/src/Katip/Monadic.hs+17

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

3131 , runKatipContextT

3232 , katipAddNamespace

3333 , katipAddContext

34+ , katipNoLogging

3435 , KatipContextTState(..)

3536 ) where

3637

@@ -311,6 +312,8 @@ runKatipContextT le ctx ns = flip runReaderT lts . unKatipContextT

311312

312313

313314-------------------------------------------------------------------------------

315+-- | Append a namespace segment to the current namespace for the given

316+-- monadic action, then restore the previous state afterwards.

314317katipAddNamespace

315318 :: (Monad m)

316319 => Namespace

@@ -321,6 +324,8 @@ katipAddNamespace ns (KatipContextT f) =

321324

322325

323326-------------------------------------------------------------------------------

327+-- | Append some context to the current context for the given monadic

328+-- action, then restore the previous state afterwards.

324329katipAddContext

325330 :: ( LogItem i

326331 , Monad m

@@ -330,3 +335,15 @@ katipAddContext

330335 -> KatipContextT m a

331336katipAddContext i (KatipContextT f) =

332337 KatipContextT (local (\r -> r { ltsContext = (ltsContext r) <> liftPayload i}) f)

338+

339+

340+-------------------------------------------------------------------------------

341+-- | Disable all scribes for the given monadic action, then restore

342+-- them afterwards.

343+katipNoLogging

344+ :: ( Monad m

345+ )

346+ => KatipContextT m a

347+ -> KatipContextT m a

348+katipNoLogging (KatipContextT f) =

349+ KatipContextT (local (\r -> r { ltsLogEnv = clearScribes (ltsLogEnv r)}) f)