@@ -128,6 +128,19 @@ instance ToJSON a => ToJSON (Item a) where
128128 , "msg" A..= itemMessage
129129 , "at" A..= itemTime
130130 , "ns" A..= itemNamespace
131+ , "loc" A..= fmap LocJs itemLoc
132+ ]
133+
134+newtype LocJs = LocJs { getLocJs :: Loc }
135+
136+
137+instance ToJSON LocJs where
138+ toJSON (LocJs (Loc fn p m (l, c) _)) = A.object
139+ [ "loc_fn" A..= fn
140+ , "loc_pkg" A..= p
141+ , "loc_mod" A..= l
142+ , "loc_ln" A..= c
143+ , "loc_col" A..= c
131144 ]
132145
133146
@@ -173,12 +186,12 @@ instance Monoid Scribe where
173186
174187-------------------------------------------------------------------------------
175188data LogEnv = LogEnv {
176− _logEnvHost :: HostName
177− , _logEnvPid :: ProcessID
178− , _logEnvApp :: Namespace
179− , _logEnvEnv :: Environment
180− , _logEnvTimer :: IO UTCTime
181− , _logEnvHandlers :: M.Map Text Scribe
189+ _logEnvHost :: HostName
190+ , _logEnvPid :: ProcessID
191+ , _logEnvNs :: Namespace
192+ , _logEnvEnv :: Environment
193+ , _logEnvTimer :: IO UTCTime
194+ , _logEnvScribes :: M.Map Text Scribe
182195 }
183196makeLenses ''LogEnv
184197
@@ -200,22 +213,22 @@ initLogEnv an env = LogEnv
200213
201214
202215-------------------------------------------------------------------------------
203−registerHandler
216+registerScribe
204217 :: Text
205− -- ^ Name the handler
218+ -- ^ Name the scribe
206219 -> Scribe
207220 -> LogEnv
208221 -> LogEnv
209−registerHandler nm h = logEnvHandlers . at nm .~ Just h
222+registerScribe nm h = logEnvScribes . at nm .~ Just h
210223
211224
212225-------------------------------------------------------------------------------
213−unregisterHandler
226+unregisterScribe
214227 :: Text
215− -- ^ Name of the handler
228+ -- ^ Name of the scribe
216229 -> LogEnv
217230 -> LogEnv
218−unregisterHandler nm = logEnvHandlers . at nm .~ Nothing
231+unregisterScribe nm = logEnvScribes . at nm .~ Nothing
219232
220233
221234
@@ -224,7 +237,8 @@ class Katip m where
224237
225238
226239-------------------------------------------------------------------------------
227−-- | Log with everything, including a source code location.
240+-- | Log with everything, including a source code location. This is
241+-- very low level and you typically can use 'logT' in its place.
228242logI
229243 :: (Applicative m, MonadIO m, LogContext a, Katip m)
230244 => a
@@ -236,7 +250,7 @@ logI
236250logI a ns loc sev msg = do
237251 LogEnv{..} <- getLogEnv
238252 item <- Item
239− <$> pure _logEnvApp
253+ <$> pure _logEnvNs
240254 <*> pure _logEnvEnv
241255 <*> pure sev
242256 <*> liftIO myThreadId
@@ -245,13 +259,13 @@ logI a ns loc sev msg = do
245259 <*> pure a
246260 <*> pure msg
247261 <*> liftIO _logEnvTimer
248− <*> pure (_logEnvApp <> ns)
262+ <*> pure (_logEnvNs <> ns)
249263 <*> pure loc
250− liftIO $ forM_ (M.elems _logEnvHandlers) $ \ (Scribe h) -> h item
264+ liftIO $ forM_ (M.elems _logEnvScribes) $ \ (Scribe h) -> h item
251265
252266
253267-------------------------------------------------------------------------------
254−-- | Log with full context.
268+-- | Log with full context, but without any code location.
255269logF
256270 :: (Applicative m, MonadIO m, LogContext a, Katip m)
257271 => a
@@ -267,7 +281,7 @@ logF a ns sev msg = logI a ns Nothing sev msg
267281
268282
269283-------------------------------------------------------------------------------
270−-- | Log a message without any payload/context.
284+-- | Log a message without any payload/context or code location.
271285logM
272286 :: (Applicative m, MonadIO m, Katip m)
273287 => Namespace
@@ -321,8 +335,10 @@ getLoc = [| $(location >>= liftLoc) |]
321335
322336-------------------------------------------------------------------------------
323337-- | 'Loc'-tagged logging when using template-haskell is OK.
338+--
339+-- @$(logT) obj mempty Info "Hello world"@
324340logT :: ExpQ
325−logT = [| \ a ns sev msg -> logI a ns (Just $(location >>= liftLoc)) sev msg |]
341+logT = [| \ a ns sev msg -> logI a ns (Just $(getLoc)) sev msg |]
326342
327343
328344-- taken from the file-location package