61de75e · typeable/katip

git.iko.soy/typeable/katip

Merge branch 'no-logging'

commit61de75e950ef3ba1ab851ce55f6c6c5add7cfc4a authorMichael Xavier <michael@michaelxavier.net> dateWed 1 Jun 2016, 08:26 (10 years ago) parent525c276 8c214b8

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

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

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

5151 confrabulateWidgets

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

53+ noLogging $

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

5355

5456

5557-------------------------------------------------------------------------------

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

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

130132

131133

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+

132140-------------------------------------------------------------------------------

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

134142runStack s f = runReaderT (unStack f) s

katip/examples/example_lens.hs+8

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

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

6767 confrabulateWidgets

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

69+ noLogging $

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

6971

7072

7173-------------------------------------------------------------------------------

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

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

137139

138140

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+

139147-------------------------------------------------------------------------------

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

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

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

572572

573573-------------------------------------------------------------------------------

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

576579clearScribes

577580 :: LogEnv

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