8c214b8 · typeable/katip

katip/examples/example.hs+8

compare with master

unifiedsplit

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

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

46 confrabulateWidgets

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

48+ noLogging $

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

48

50

49

51

50-------------------------------------------------------------------------------

52-------------------------------------------------------------------------------

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

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

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

105

107

106

108

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+

107-------------------------------------------------------------------------------

115-------------------------------------------------------------------------------

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

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

109runStack s f = runReaderT (unStack f) s

117runStack s f = runReaderT (unStack f) s

katip/examples/example_lens.hs+8

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

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

62 confrabulateWidgets

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

64+ noLogging $

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

64

66

65

67

66-------------------------------------------------------------------------------

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

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

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

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

113

115

114

116

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+

115-------------------------------------------------------------------------------

123-------------------------------------------------------------------------------

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

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

117runStack s f = runReaderT (unStack f) s

125runStack s f = runReaderT (unStack f) s

katip/src/Katip.hs+1

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

106 , runKatipContextT

107 , katipAddNamespace

108 , katipAddContext

109+ , katipNoLogging

109 ) where

110 ) where

110

111

111-------------------------------------------------------------------------------

112-------------------------------------------------------------------------------

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

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

551

552-------------------------------------------------------------------------------

553-- | 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.

555clearScribes

558clearScribes

556 :: LogEnv

559 :: LogEnv

557 -> LogEnv

560 -> LogEnv

katip/src/Katip/Monadic.hs+17

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

31 , runKatipContextT

32 , katipAddNamespace

33 , katipAddContext

34+ , katipNoLogging

34 , KatipContextTState(..)

35 , KatipContextTState(..)

35 ) where

36 ) where

36

37

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

311

312

313

313-------------------------------------------------------------------------------

314-------------------------------------------------------------------------------

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

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

314katipAddNamespace

317katipAddNamespace

315 :: (Monad m)

318 :: (Monad m)

316 => Namespace

319 => Namespace

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

321

324

322

325

323-------------------------------------------------------------------------------

326-------------------------------------------------------------------------------

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

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

324katipAddContext

329katipAddContext

325 :: ( LogItem i

330 :: ( LogItem i

326 , Monad m

331 , Monad m

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

330 -> KatipContextT m a

335 -> KatipContextT m a

331katipAddContext i (KatipContextT f) =

336katipAddContext i (KatipContextT f) =

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

337 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)