Don't show source location for logs that don't have that information

This commit is contained in:
Andrew Martin 2015-06-30 17:02:33 -04:00
parent c2efc73e04
commit e327963912

View File

@ -615,7 +615,14 @@ asyncHelper render scripts jscript jsLoc =
Nothing -> Nothing Nothing -> Nothing
Just j -> Just $ jelper j Just j -> Just $ jelper j
-- | Default formatting for log messages. -- | Default formatting for log messages. When you use
-- the template haskell logging functions for to log with information
-- about the source location, that information will be appended to
-- the end of the log. When you use the non-TH logging functions,
-- like 'logDebugN', this function does not include source
-- information. This currently works by checking to see if the
-- package name is the string \"\<unknown\>\". This is a hack,
-- but it removes some of the visual clutter from non-TH logs.
-- --
-- Since 1.4.10 -- Since 1.4.10
formatLogMessage :: IO ZonedDate formatLogMessage :: IO ZonedDate
@ -626,20 +633,23 @@ formatLogMessage :: IO ZonedDate
-> IO LogStr -> IO LogStr
formatLogMessage getdate loc src level msg = do formatLogMessage getdate loc src level msg = do
now <- getdate now <- getdate
return $ let sourceSuffix = if loc_package loc == "<unknown>" then "" else mempty
toLogStr now `mappend` `mappend` " @("
" [" `mappend` `mappend` toLogStr (fileLocationToString loc)
(case level of `mappend` ")"
return $ mempty
`mappend` toLogStr now
`mappend` " ["
`mappend` (case level of
LevelOther t -> toLogStr t LevelOther t -> toLogStr t
_ -> toLogStr $ drop 5 $ show level) `mappend` _ -> toLogStr $ drop 5 $ show level)
(if T.null src `mappend` (if T.null src
then mempty then mempty
else "#" `mappend` toLogStr src) `mappend` else "#" `mappend` toLogStr src)
"] " `mappend` `mappend` "] "
msg `mappend` `mappend` msg
" @(" `mappend` `mappend` sourceSuffix
toLogStr (fileLocationToString loc) `mappend` `mappend` "\n"
")\n"
-- | Customize the cookies used by the session backend. You may -- | Customize the cookies used by the session backend. You may
-- use this function on your definition of 'makeSessionBackend'. -- use this function on your definition of 'makeSessionBackend'.