git.iko.soy/typeable/katip
on master help sign in
Update examples
commitbe5deaab277be4acd6371d37913e7fb4880a917f authorMichael Xavier <michael@michaelxavier.net> dateFri 7 Jul 2017, 13:50 (9 years ago) parentede15f5
2 files changed+10−44
compare with master
unifiedsplit
katip/examples/example.hs+5−22 katip/examples/example_lens.hs+5−22
katip/examples/example.hs+5−22
@@ -45,11 +45,11 @@ main = do
4545 -- use this to stack up various contextual details throughout your
4646 -- code and they will be flattened out and combined in the log
4747 -- output.
48− addNamespace "confrabulation" $ addContext (ConfrabLogCTX 42) $ do
48+ katipAddNamespace "confrabulation" $ katipAddContext (ConfrabLogCTX 42) $ do
4949 $(logTM) DebugS "Confrabulating widgets, with extra namespace and context"
5050 confrabulateWidgets
5151 $(logTM) InfoS "Namespace and context are back to normal"
52− noLogging $
52+ katipNoLogging $
5353 $(logTM) DebugS "You'll never see this log message!"
5454 -- This blocking call flushes all in-flight messages through
5555 -- handlers and then finalizes each scribe.
@@ -111,31 +111,14 @@ instance MonadBaseControl b m => MonadBaseControl b (MyStack m) where
111111
112112instance (MonadIO m) => Katip (MyStack m) where
113113 getLogEnv = asks msLogEnv
114+ localLogEnv f (MyStack m) = MyStack (local (\s -> s { msLogEnv = f (msLogEnv s)}) m)
114115
115116
116117instance (MonadIO m) => KatipContext (MyStack m) where
117118 getKatipContext = asks msKContext
119+ localKatipContext f (MyStack m) = MyStack (local (\s -> s { msKContext = f (msKContext s)}) m)
118120 getKatipNamespace = asks msKNamespace
119−
120−
121−-------------------------------------------------------------------------------
122−-- | Merge some context into the log only for the given block
123−addContext :: (LogItem i, MonadReader MyState m) => i -> m a -> m a
124−addContext i = local (\r -> r { msKContext = msKContext r <> ctxs })
125− where
126− ctxs = liftPayload i
127−
128−
129−-------------------------------------------------------------------------------
130−-- | Add a layer of namespace to the logs only for the given block
131−addNamespace :: (MonadReader MyState m) => Namespace -> m a -> m a
132−addNamespace ns = local (\r -> r { msKNamespace = msKNamespace r <> ns })
133−
134−
135−-------------------------------------------------------------------------------
136−-- | Disable all log output temporarily
137−noLogging :: (MonadReader MyState m) => m a -> m a
138−noLogging = local (\r -> r { msLogEnv = clearScribes (msLogEnv r)})
121+ localKatipNamespace f (MyStack m) = MyStack (local (\s -> s { msKNamespace = f (msKNamespace s)}) m)
139122
140123
141124-------------------------------------------------------------------------------
katip/examples/example_lens.hs+5−22
@@ -60,11 +60,11 @@ main = do
6060 -- use this to stack up various contextual details throughout your
6161 -- code and they will be flattened out and combined in the log
6262 -- output.
63− addNamespace "confrabulation" $ addContext (ConfrabLogCTX 42) $ do
63+ katipAddNamespace "confrabulation" $ katipAddContext (ConfrabLogCTX 42) $ do
6464 $(logTM) DebugS "Confrabulating widgets, with extra namespace and context"
6565 confrabulateWidgets
6666 $(logTM) InfoS "Namespace and context are back to normal"
67− noLogging $
67+ katipNoLogging $
6868 $(logTM) DebugS "You'll never see this log message!"
6969 -- This blocking call flushes all in-flight messages through
7070 -- handlers and then finalizes each scribe.
@@ -118,31 +118,14 @@ instance MonadBaseControl b m => MonadBaseControl b (MyStack m) where
118118
119119instance (MonadIO m) => Katip (MyStack m) where
120120 getLogEnv = view msLogEnv
121+ localLogEnv f (MyStack m) = MyStack (local (over msLogEnv f) m)
121122
122123
123124instance (MonadIO m) => KatipContext (MyStack m) where
124125 getKatipContext = view msKContext
126+ localKatipContext f (MyStack m) = MyStack (local (over msKContext f) m)
125127 getKatipNamespace = view msKNamespace
126−
127−
128−-------------------------------------------------------------------------------
129−-- | Merge some context into the log only for the given block
130−addContext :: (LogItem i, MonadReader r m, HasMyState r) => i -> m a -> m a
131−addContext i = local (\r -> r & msKContext <>~ ctxs)
132− where
133− ctxs = liftPayload i
134−
135−
136−-------------------------------------------------------------------------------
137−-- | Add a layer of namespace to the logs only for the given block
138−addNamespace :: (MonadReader r m, HasMyState r) => Namespace -> m a -> m a
139−addNamespace ns = local (\r -> r & msKNamespace <>~ ns)
140−
141−
142−-------------------------------------------------------------------------------
143−-- | Disable all log output temporarily
144−noLogging :: (MonadReader r m, HasMyState r) => m a -> m a
145−noLogging = local (\r -> r & msLogEnv %~ clearScribes)
128+ localKatipNamespace f (MyStack m) = MyStack (local (over msKNamespace f) m)
146129
147130
148131-------------------------------------------------------------------------------