61de75e · typeable/katip

katip/examples/example.hs+8

compare with master

unifiedsplit

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

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

51 confrabulateWidgets

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

53+ noLogging $

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

53

55

54

56

55-------------------------------------------------------------------------------

57-------------------------------------------------------------------------------

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

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

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

130

132

131

133

134+-------------------------------------------------------------------------------

135+-- | Disable all log output temporarily

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

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

138+

139+

132-------------------------------------------------------------------------------

140-------------------------------------------------------------------------------

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

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

134runStack s f = runReaderT (unStack f) s

142runStack s f = runReaderT (unStack f) s

katip/examples/example_lens.hs+8

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

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

67 confrabulateWidgets

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

69+ noLogging $

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

69

71

70

72

71-------------------------------------------------------------------------------

73-------------------------------------------------------------------------------

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

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

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

137

139

138

140

141+-------------------------------------------------------------------------------

142+-- | Disable all log output temporarily

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

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

145+

146+

139-------------------------------------------------------------------------------

147-------------------------------------------------------------------------------

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

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

141runStack s f = runReaderT (unStack f) s

149runStack 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

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

572

573-------------------------------------------------------------------------------

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

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

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

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

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

578+-- example.

576clearScribes

579clearScribes

577 :: LogEnv

580 :: LogEnv

578 -> LogEnv

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