git.iko.soy/typeable/katip
on master help sign in
add nullary log context transformer
a7d785aMichael Xavier
katip/src/Katip.hs+2
compare with master
unifiedsplit
@@ -41,6 +41,8 @@ module Katip
41 -- * Transformer for appending to a log context
41 -- * Transformer for appending to a log context
42 , ContextualLogT
42 , ContextualLogT
43 , runContextualLogT
43 , runContextualLogT
44+ , BlankLogContextT
45+ , runBlankLogContextT
44
46
45 -- * Included Scribes
47 -- * Included Scribes
46 , mkHandleScribe
48 , mkHandleScribe
katip/src/Katip/Monadic.hs+44−1
@@ -32,6 +32,8 @@ module Katip.Monadic
32 , ContextualLogT'
32 , ContextualLogT'
33 , ContextualLogT
33 , ContextualLogT
34 , runContextualLogT
34 , runContextualLogT
35+ , BlankLogContextT
36+ , runBlankLogContextT
35 ) where
37 ) where
36
38
37
39
@@ -202,6 +204,7 @@ newtype ContextualLogT' n m a = ContextualLogT {
202 , MonadIO
204 , MonadIO
203 , MonadThrow
205 , MonadThrow
204 , MonadCatch
206 , MonadCatch
207+ , MonadMask
205 , MonadBase b
208 , MonadBase b
206 , MonadState s
209 , MonadState s
207 , MonadWriter w
210 , MonadWriter w
@@ -244,7 +247,6 @@ instance (ContextualLog m, Monad m) => ContextualLog (ContextualLogT' m m) where
244 nsInner <- getNsInner
247 nsInner <- getNsInner
245 return $ nsOuter <> nsInner
248 return $ nsOuter <> nsInner
246
249
247−
248runContextualLogT
250runContextualLogT
249 :: (Functor m, LogContext a)
251 :: (Functor m, LogContext a)
250 => m a
252 => m a
@@ -253,3 +255,44 @@ runContextualLogT
253 -> m b
255 -> m b
254runContextualLogT lgtr nsgtr m = runReaderT (unContextualLogT m) (liftPayload <$> lgtr, nsgtr)
256runContextualLogT lgtr nsgtr m = runReaderT (unContextualLogT m) (liftPayload <$> lgtr, nsgtr)
255
257
258+
259+-------------------------------------------------------------------------------
260+-- | Type analogous to IdentityT that provides an empty log
261+-- context. Use this if your root monad doesn't have a LogContext instance.
262+newtype BlankLogContextT m a = BlankLogContextT {
263+ runBlankLogContextT :: m a
264+ } deriving ( Functor
265+ , Applicative
266+ , Monad
267+ , MonadIO
268+ , MonadThrow
269+ , MonadCatch
270+ , MonadMask
271+ , MonadBase b
272+ , MonadReader r
273+ , MonadState s
274+ , MonadWriter w
275+ , MonadError e
276+ , MonadPlus
277+ , MonadFix
278+ , Katip
279+ )
280+
281+instance Monad m => ContextualLog (BlankLogContextT m) where
282+ getLogContexts = return mempty
283+ getNamespace = return mempty
284+
285+instance MonadTrans BlankLogContextT where
286+ lift = BlankLogContextT
287+
288+instance MonadTransControl BlankLogContextT where
289+ type StT BlankLogContextT a = a
290+ liftWith f = BlankLogContextT $ f runBlankLogContextT
291+ restoreT = BlankLogContextT
292+ {-# INLINABLE liftWith #-}
293+ {-# INLINABLE restoreT #-}
294+
295+instance (MonadBaseControl b m) => MonadBaseControl b (BlankLogContextT m) where
296+ type StM (BlankLogContextT m) a = ComposeSt BlankLogContextT m a
297+ liftBaseWith = defaultLiftBaseWith
298+ restoreM = defaultRestoreM