@@ -10,30 +10,30 @@
1010
1111-- | Provides support for treating payloads and namespaces as
1212-- composable contexts. The common pattern would be to provide a
13−-- 'ContextualLog' instance for your base monad. When your program
13+-- 'KatipContext' instance for your base monad. When your program
1414-- changes to a more detailed context, say to the database, you can
15−-- use 'ContextualLogT' to tack on a typed context and a namespace
15+-- use 'LogT' to tack on a typed context and a namespace
1616-- which will be merged into the enclosing monad's context and
1717-- namespace.
1818module Katip.Monadic
1919 (
2020 -- * Monadic variants of logging functions from "Katip.Core"
21− logfM
22− , logtM
21+ logFM
22+ , logTM
2323 , logItemM
2424
2525 -- * Machinery for merging typed log payloads/contexts
26− , ContextualLog(..)
26+ , KatipContext(..)
2727 , AnyLogContext
2828 , LogContexts
2929 , liftPayload
3030
3131 -- * Transformer for appending to a log context
32− , ContextualLogT'
33− , ContextualLogT
34− , runContextualLogT
35− , BlankLogContextT
36− , runBlankLogContextT
32+ , LogT'
33+ , LogT
34+ , runLogT
35+ , BlankLogT
36+ , runBlankLogT
3737 ) where
3838
3939
@@ -71,7 +71,7 @@ import Katip.Core
7171-- | A wrapper around a log context that erases type information so
7272-- that contexts from multiple layers can be combined intelligently.
7373data AnyLogContext where
74− AnyLogContext :: (LogContext a) => a -> AnyLogContext
74+ AnyLogContext :: (LogItem a) => a -> AnyLogContext
7575
7676
7777-------------------------------------------------------------------------------
@@ -85,7 +85,7 @@ instance ToJSON LogContexts where
8585
8686instance ToObject LogContexts
8787
88−instance LogContext LogContexts where
88+instance LogItem LogContexts where
8989 payloadKeys verb (LogContexts vs) = mconcat $ map payloadKeys' vs
9090 where
9191 -- To ensure AllKeys doesn't leak keys from other values when
@@ -98,28 +98,28 @@ instance LogContext LogContexts where
9898
9999-------------------------------------------------------------------------------
100100-- | Lift a log context into the generic wrapper
101−liftPayload :: (LogContext a) => a -> LogContexts
101+liftPayload :: (LogItem a) => a -> LogContexts
102102liftPayload = LogContexts . (:[]) . AnyLogContext
103103
104104
105105-------------------------------------------------------------------------------
106106-- | A monadic context that has an inherant way to get logging
107107-- context and namespace. Examples include a web application monad or
108−-- database monad. Combine with 'ContextualLogT' to nest.
109−class ContextualLog m where
110− getLogContexts :: m LogContexts
111− getNamespace :: m Namespace
108+-- database monad. Combine with 'LogT' to nest.
109+class Katip m => KatipContext m where
110+ getKatipContext :: m LogContexts
111+ getKatipNamespace :: m Namespace
112112
113113--TODO: is this INLINABLE?
114114#define TRANS(T) \
115− instance (ContextualLog m, Monad m) => ContextualLog (T m) where \
116− getLogContexts = lift getLogContexts; \
117− getNamespace = lift getNamespace
115+ instance (KatipContext m, Katip (T m)) => KatipContext (T m) where \
116+ getKatipContext = lift getKatipContext; \
117+ getKatipNamespace = lift getKatipNamespace
118118
119119#define TRANS_CTX(CTX, T) \
120− instance (CTX, ContextualLog m, Monad m) => ContextualLog (T m) where \
121− getLogContexts = lift getLogContexts; \
122− getNamespace = lift getNamespace
120+ instance (CTX, KatipContext m, Katip (T m)) => KatipContext (T m) where \
121+ getKatipContext = lift getKatipContext; \
122+ getKatipNamespace = lift getKatipNamespace
123123
124124TRANS(IdentityT)
125125TRANS(MaybeT)
@@ -134,21 +134,21 @@ TRANS_CTX(Monoid w, WriterT w)
134134TRANS_CTX(Monoid w, Strict.RWST r w s)
135135TRANS_CTX(Monoid w, RWST r w s)
136136
137−deriving instance (Monad m, ContextualLog m) => ContextualLog (KatipT m)
137+deriving instance (Monad m, KatipContext m) => KatipContext (KatipT m)
138138
139139-------------------------------------------------------------------------------
140140-- | Log with everything, including a source code location. This is
141−-- very low level and you typically can use 'logtM' in its
141+-- very low level and you typically can use 'logTM' in its
142142-- place. Automaticallysupplies payload and namespace.
143143logItemM
144− :: (Applicative m, ContextualLog m, Katip m)
144+ :: (Applicative m, KatipContext m, Katip m)
145145 => Maybe Loc
146146 -> Severity
147147 -> LogStr
148148 -> m ()
149149logItemM loc sev msg = do
150− ctx <- getLogContexts
151− ns <- getNamespace
150+ ctx <- getKatipContext
151+ ns <- getKatipNamespace
152152 logItem ctx ns loc sev msg
153153
154154
@@ -156,39 +156,39 @@ logItemM loc sev msg = do
156156-------------------------------------------------------------------------------
157157-- | Log with full context, but without any code
158158-- location. Automatically supplies payload and namespace.
159−logfM
160− :: (Applicative m, ContextualLog m, Katip m)
159+logFM
160+ :: (Applicative m, KatipContext m, Katip m)
161161 => Severity
162162 -- ^ Severity of the message
163163 -> LogStr
164164 -- ^ The log message
165165 -> m ()
166−logfM sev msg = do
167− ctx <- getLogContexts
168− ns <- getNamespace
169− logf ctx ns sev msg
166+logFM sev msg = do
167+ ctx <- getKatipContext
168+ ns <- getKatipNamespace
169+ logF ctx ns sev msg
170170
171171
172172-------------------------------------------------------------------------------
173173-- | 'Loc'-tagged logging when using template-haskell is OK. Automatically supplies payload and namespace.
174174--
175175-- @$(logt) InfoS "Hello world"@
176−logtM :: ExpQ
177−logtM = [| logItemM (Just $(getLoc)) |]
176+logTM :: ExpQ
177+logTM = [| logItemM (Just $(getLoc)) |]
178178
179179
180180-------------------------------------------------------------------------------
181181-- | Wrapper over 'ReaderT' that provides a passthrough instance for
182182-- 'MonadReader' so your stack will not be affected. Also provides a
183−-- 'ContextualLog' instance which combines with the inner monad's
183+-- 'KatipContext' instance which combines with the inner monad's
184184-- instance.
185185--
186186-- @
187−-- instance ContextualLog m WebMonad where
188−-- getLogContexts = ...
189−-- getNamespace = Namespace ["web"]
187+-- instance KatipContext m WebMonad where
188+-- getKatipContext = ...
189+-- getKatipNamespace = Namespace ["web"]
190190--
191−-- dbCallInWeb = runContextualLogT getDBContext (Namespace ["db"]) $ do
191+-- dbCallInWeb = runLogT getDBContext (Namespace ["db"]) $ do
192192-- someStuff
193193-- @
194194--
@@ -196,10 +196,10 @@ logtM = [| logItemM (Just $(getLoc)) |]
196196-- the (optionally) monadic log context for the db, combine it with
197197-- the web server's and will use the namespace @Namespace ["web","db"]@.
198198--
199−-- 'ContextualLogT' is exported which fixes @n ~ m@. The two type
199+-- 'LogT' is exported which fixes @n ~ m@. The two type
200200-- variables must be present for defining a 'MonadTransControl' instance.
201−newtype ContextualLogT' n m a = ContextualLogT {
202− unContextualLogT :: ReaderT (n LogContexts, n Namespace) m a
201+newtype LogT' n m a = LogT {
202+ unLogT :: ReaderT (n LogContexts, n Namespace) m a
203203 } deriving ( Functor
204204 , Applicative
205205 , Monad
@@ -216,53 +216,53 @@ newtype ContextualLogT' n m a = ContextualLogT {
216216 , Katip
217217 )
218218
219−type ContextualLogT m a = ContextualLogT' m m a
219+type LogT m a = LogT' m m a
220220
221−instance MonadTrans (ContextualLogT' n) where
222− lift = ContextualLogT . lift
221+instance MonadTrans (LogT' n) where
222+ lift = LogT . lift
223223
224224-- Reader is a passthrough. We don't expose our internal reader so as not to conflict
225−instance (MonadReader r m) => MonadReader r (ContextualLogT' n m) where
225+instance (MonadReader r m) => MonadReader r (LogT' n m) where
226226 ask = lift ask
227− local f (ContextualLogT (ReaderT m)) = ContextualLogT $ ReaderT $ \r ->
227+ local f (LogT (ReaderT m)) = LogT $ ReaderT $ \r ->
228228 local f (m r)
229229
230−instance MonadTransControl (ContextualLogT' n) where
231− type StT (ContextualLogT' n) a = StT (ReaderT (n LogContexts)) a
232− liftWith = defaultLiftWith ContextualLogT unContextualLogT
233− restoreT = defaultRestoreT ContextualLogT
230+instance MonadTransControl (LogT' n) where
231+ type StT (LogT' n) a = StT (ReaderT (n LogContexts)) a
232+ liftWith = defaultLiftWith LogT unLogT
233+ restoreT = defaultRestoreT LogT
234234 {-# INLINE liftWith #-}
235235 {-# INLINE restoreT #-}
236236
237−instance (MonadBaseControl b m) => MonadBaseControl b (ContextualLogT' n m) where
238− type StM ((ContextualLogT' n) m) a = ComposeSt (ContextualLogT' n) m a
237+instance (MonadBaseControl b m) => MonadBaseControl b (LogT' n m) where
238+ type StM ((LogT' n) m) a = ComposeSt (LogT' n) m a
239239 liftBaseWith = defaultLiftBaseWith
240240 restoreM = defaultRestoreM
241241
242−instance (ContextualLog m, Monad m) => ContextualLog (ContextualLogT' m m) where
243− getLogContexts = ContextualLogT $ ReaderT $ \(gctxs, _) -> do
242+instance (KatipContext m, Monad m) => KatipContext (LogT' m m) where
243+ getKatipContext = LogT $ ReaderT $ \(gctxs, _) -> do
244244 ctxs <- gctxs
245− ctxs' <- getLogContexts
245+ ctxs' <- getKatipContext
246246 return $ ctxs <> ctxs'
247− getNamespace = ContextualLogT $ ReaderT $ \(_, getNsInner) -> do
248− nsOuter <- getNamespace
247+ getKatipNamespace = LogT $ ReaderT $ \(_, getNsInner) -> do
248+ nsOuter <- getKatipNamespace
249249 nsInner <- getNsInner
250250 return $ nsOuter <> nsInner
251251
252−runContextualLogT
253− :: (Functor m, LogContext a)
252+runLogT
253+ :: (Functor m, LogItem a)
254254 => m a
255255 -> m Namespace
256− -> ContextualLogT m b
256+ -> LogT m b
257257 -> m b
258−runContextualLogT lgtr nsgtr m = runReaderT (unContextualLogT m) (liftPayload <$> lgtr, nsgtr)
258+runLogT lgtr nsgtr m = runReaderT (unLogT m) (liftPayload <$> lgtr, nsgtr)
259259
260260
261261-------------------------------------------------------------------------------
262262-- | Type analogous to IdentityT that provides an empty log
263263-- context. Use this if your root monad doesn't have a LogContext instance.
264−newtype BlankLogContextT m a = BlankLogContextT {
265− runBlankLogContextT :: m a
264+newtype BlankLogT m a = BlankLogT {
265+ runBlankLogT :: m a
266266 } deriving ( Functor
267267 , Applicative
268268 , Monad
@@ -280,21 +280,21 @@ newtype BlankLogContextT m a = BlankLogContextT {
280280 , Katip
281281 )
282282
283−instance Monad m => ContextualLog (BlankLogContextT m) where
284− getLogContexts = return mempty
285− getNamespace = return mempty
283+instance Katip m => KatipContext (BlankLogT m) where
284+ getKatipContext = return mempty
285+ getKatipNamespace = return mempty
286286
287−instance MonadTrans BlankLogContextT where
288− lift = BlankLogContextT
287+instance MonadTrans BlankLogT where
288+ lift = BlankLogT
289289
290−instance MonadTransControl BlankLogContextT where
291− type StT BlankLogContextT a = a
292− liftWith f = BlankLogContextT $ f runBlankLogContextT
293− restoreT = BlankLogContextT
290+instance MonadTransControl BlankLogT where
291+ type StT BlankLogT a = a
292+ liftWith f = BlankLogT $ f runBlankLogT
293+ restoreT = BlankLogT
294294 {-# INLINABLE liftWith #-}
295295 {-# INLINABLE restoreT #-}
296296
297−instance (MonadBaseControl b m) => MonadBaseControl b (BlankLogContextT m) where
298− type StM (BlankLogContextT m) a = ComposeSt BlankLogContextT m a
297+instance (MonadBaseControl b m) => MonadBaseControl b (BlankLogT m) where
298+ type StM (BlankLogT m) a = ComposeSt BlankLogT m a
299299 liftBaseWith = defaultLiftBaseWith
300300 restoreM = defaultRestoreM