diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,6 @@ +1.1.3 +===== + +* Add config parameter to print `ThreadId` optionally. +* Boolean monoidal builders for `LoggerConfig` now set boolean + parameter to default ≠ `mempty` parameter. diff --git a/log-warper.cabal b/log-warper.cabal --- a/log-warper.cabal +++ b/log-warper.cabal @@ -1,13 +1,14 @@ name: log-warper -version: 1.1.2 +version: 1.1.3 synopsis: Flexible, configurable, monadic and pretty logging homepage: https://github.com/serokell/log-warper license: MIT license-file: LICENSE -author: Serokell +author: @serokell maintainer: Serokell copyright: 2016-2017 Serokell -category: Interfaces +category: Logging +extra-source-files: CHANGES.md stability: experimental build-type: Simple cabal-version: >=1.18 diff --git a/src/System/Wlog/Formatter.hs b/src/System/Wlog/Formatter.hs --- a/src/System/Wlog/Formatter.hs +++ b/src/System/Wlog/Formatter.hs @@ -165,18 +165,21 @@ roundBy :: (Num a, Integral a) => a -> a roundBy x = let y = x `div` fromIntegral roundN in y * fromIntegral roundN -stderrFormatter :: LogFormatter a -stderrFormatter = - simpleLogFormatter $ - mconcat [colorizer Error "[$loggername:$prio:$tid] ", timeFmt, "$msg"] +stderrFormatter :: Bool -> LogFormatter a +stderrFormatter isShowTid = simpleLogFormatter $ + mconcat [colorizer Error $ "[$loggername:$prio" ++ tid ++ "] ", timeFmt, "$msg"] + where + tid = if isShowTid then ":$tid" else "" -stdoutFmt :: Severity -> Bool -> String -stdoutFmt pr isShowTime = mconcat - [colorizer pr "[$loggername:$prio:$tid] ", timeFmtStdout isShowTime, "$msg"] +stdoutFmt :: Severity -> Bool -> Bool -> String +stdoutFmt pr isShowTime isShowTid = mconcat + [colorizer pr $ "[$loggername:$prio" ++ tid ++ "] ", timeFmtStdout isShowTime, "$msg"] + where + tid = if isShowTid then ":$tid" else "" -stdoutFormatter :: Bool -> LogFormatter a -stdoutFormatter isShowTime handle r@(pr, _) = - simpleLogFormatter (stdoutFmt pr isShowTime) handle r +stdoutFormatter :: Bool -> Bool -> LogFormatter a +stdoutFormatter isShowTime isShowTid handle r@(pr, _) = + simpleLogFormatter (stdoutFmt pr isShowTime isShowTid) handle r stdoutFormatterTimeRounded :: Int -> LogFormatter a stdoutFormatterTimeRounded roundN a r@(pr,_) s = do diff --git a/src/System/Wlog/Launcher.hs b/src/System/Wlog/Launcher.hs --- a/src/System/Wlog/Launcher.hs +++ b/src/System/Wlog/Launcher.hs @@ -61,13 +61,17 @@ setupLogging :: MonadIO m => LoggerConfig -> m () setupLogging LoggerConfig{..} = do liftIO $ createDirectoryIfMissing True handlerPrefix - when consoleOutput $ initTerminalLogging isShowTime _lcTermSeverity + + when consoleOutput $ + initTerminalLogging isShowTime isShowTid _lcTermSeverity + liftIO $ setPrefix _lcFilePrefix processLoggers mempty _lcTree where handlerPrefix = _lcFilePrefix ?: "." logMapper = appEndo _lcMapper isShowTime = getAny _lcShowTime + isShowTid = getAny _lcShowTid consoleOutput = getAny _lcConsoleOutput handlerFabric :: HandlerFabric @@ -87,7 +91,7 @@ case handlerFabric of HandlerFabric fabric -> do let handlerCreator = fabric handlerPath fileSeverity - let defFmt = (`setFormatter` stdoutFormatter isShowTime) + let defFmt = (`setFormatter` stdoutFormatter isShowTime isShowTid) let roundFmt r = (`setFormatter` stdoutFormatterTimeRounded r) let fmt = maybe defFmt roundFmt _hwRounding thisLoggerHandler <- fmt <$> handlerCreator diff --git a/src/System/Wlog/LoggerConfig.hs b/src/System/Wlog/LoggerConfig.hs --- a/src/System/Wlog/LoggerConfig.hs +++ b/src/System/Wlog/LoggerConfig.hs @@ -38,6 +38,7 @@ , lcMapper , lcRotation , lcShowTime + , lcShowTid , lcTermSeverity , lcTree , zoomLogger @@ -47,6 +48,7 @@ , mapperB , prefixB , productionB + , showTidB , showTimeB ) where @@ -77,9 +79,6 @@ filterObject :: [Text] -> HashMap Text a -> HashMap Text a filterObject excluded = HM.filterWithKey $ \k _ -> k `notElem` excluded --- | Useful lens combinator to be used for logging initialization. -fromScratch :: Monoid m => State m a -> m -fromScratch = executingState mempty ---------------------------------------------------------------------------- -- LoggerTree @@ -145,6 +144,11 @@ _ltSubloggers <- for (filterObject nonLoggers o) parseJSON return LoggerTree{..} +-- | Useful lens combinator to be used for logging initialization. +-- Usually should be used with 'zoomLogger'. +fromScratch :: Monoid m => State m a -> m +fromScratch = executingState mempty + -- | Zooming into logger name with putting specific key. zoomLogger :: Text -> State LoggerTree () -> State LoggerTree () zoomLogger loggerName initializer = zoom (ltSubloggers.at loggerName) $ do @@ -192,6 +196,9 @@ -- Note that error messages always have timestamp. , _lcShowTime :: Any + -- | Show 'ThreadId' for current logging thread. + , _lcShowTid :: Any + -- | @True@ if we should also print output into console. , _lcConsoleOutput :: Any @@ -213,6 +220,7 @@ { _lcRotation = Nothing , _lcTermSeverity = Nothing , _lcShowTime = mempty + , _lcShowTid = mempty , _lcConsoleOutput = mempty , _lcMapper = mempty , _lcFilePrefix = mempty @@ -220,15 +228,20 @@ } lc1 `mappend` lc2 = LoggerConfig - { _lcRotation = _lcRotation lc1 <|> _lcRotation lc2 - , _lcTermSeverity = _lcTermSeverity lc1 <|> _lcTermSeverity lc2 - , _lcShowTime = _lcShowTime lc1 <> _lcShowTime lc2 - , _lcConsoleOutput = _lcConsoleOutput lc1 <> _lcConsoleOutput lc2 - , _lcMapper = _lcMapper lc1 <> _lcMapper lc2 - , _lcFilePrefix = _lcFilePrefix lc1 <|> _lcFilePrefix lc2 - , _lcTree = _lcTree lc1 <> _lcTree lc2 + { _lcRotation = orCombiner _lcRotation + , _lcTermSeverity = orCombiner _lcTermSeverity + , _lcShowTime = andCombiner _lcShowTime + , _lcShowTid = andCombiner _lcShowTid + , _lcConsoleOutput = andCombiner _lcConsoleOutput + , _lcMapper = andCombiner _lcMapper + , _lcFilePrefix = orCombiner _lcFilePrefix + , _lcTree = andCombiner _lcTree } + where + orCombiner field = field lc1 <|> field lc2 + andCombiner field = field lc1 <> field lc2 + topLevelParams :: [Text] topLevelParams = ["rotation", "showTime", "printOutput", "filePrefix" ] @@ -238,6 +251,7 @@ _lcRotation <- o .:? "rotation" _lcTermSeverity <- o .:? "termSeverity" _lcShowTime <- Any <$> o .:? "showTime" .!= False + _lcShowTid <- Any <$> o .:? "showTid" .!= False _lcConsoleOutput <- Any <$> o .:? "printOutput" .!= False _lcFilePrefix <- o .:? "filePrefix" _lcTree <- parseJSON $ Object $ filterObject topLevelParams o @@ -251,6 +265,7 @@ [ "rotation" .= _lcRotation , "termSeverity" .= _lcTermSeverity , "showTime" .= getAny _lcShowTime + , "showTid" .= getAny _lcShowTid , "printOutput" .= getAny _lcConsoleOutput , "filePrefix" .= _lcFilePrefix , ("logTree", toJSON _lcTree) @@ -258,17 +273,21 @@ -- Builders for 'LoggerConfig'. --- | Setup 'lcShowTime' inside 'LoggerConfig'. -showTimeB :: Bool -> LoggerConfig -showTimeB isShowTime = mempty { _lcShowTime = Any isShowTime } +-- | Setup 'lcShowTime' to 'True' inside 'LoggerConfig'. +showTimeB :: LoggerConfig +showTimeB = mempty { _lcShowTime = Any True } +-- | Setup 'lcShowTid' to 'True' inside 'LoggerConfig'. +showTidB :: LoggerConfig +showTidB = mempty { _lcShowTid = Any True } + -- | Setup 'lcConsoleOutput' inside 'LoggerConfig'. -consoleOutB :: Bool -> LoggerConfig -consoleOutB printToConsole = mempty { _lcConsoleOutput = Any printToConsole } +consoleOutB :: LoggerConfig +consoleOutB = mempty { _lcConsoleOutput = Any True } -- | Adds sensible predefined set of parameters to logger. productionB :: LoggerConfig -productionB = showTimeB True <> consoleOutB True +productionB = showTimeB <> consoleOutB -- | Setup 'lcMapper' inside 'LoggerConfig'. mapperB :: (LoggerName -> LoggerName) -> LoggerConfig diff --git a/src/System/Wlog/LoggerNameBox.hs b/src/System/Wlog/LoggerNameBox.hs --- a/src/System/Wlog/LoggerNameBox.hs +++ b/src/System/Wlog/LoggerNameBox.hs @@ -79,8 +79,7 @@ modifyLoggerName = RWSStrict.mapRWST . modifyLoggerName instance HasLoggerName Identity where - getLoggerName = Identity mempty - + getLoggerName = Identity "Identity" modifyLoggerName = flip const -- | Set logger name in context. diff --git a/src/System/Wlog/Wrapper.hs b/src/System/Wlog/Wrapper.hs --- a/src/System/Wlog/Wrapper.hs +++ b/src/System/Wlog/Wrapper.hs @@ -60,8 +60,12 @@ -- descendant loggers by default. -- 3. Applies `setSeverity` to given loggers. It can be done later using -- `setSeverity` directly. -initTerminalLogging :: MonadIO m => Bool -> Maybe Severity -> m () -initTerminalLogging isShowTime (fromMaybe Warning -> defaultSeverity) = liftIO $ do +initTerminalLogging :: MonadIO m + => Bool -- ^ Show time? + -> Bool -- ^ Show ThreadId? + -> Maybe Severity + -> m () +initTerminalLogging isShowTime isShowTid (fromMaybe Warning -> defaultSeverity) = liftIO $ do lock <- liftIO $ newMVar () -- We set Debug here, to allow all messages by stdout handler. -- They will be filtered by loggers. @@ -74,8 +78,8 @@ updateGlobalLogger rootLoggerName $ setLevel defaultSeverity where - setStdoutFormatter = (`setFormatter` stdoutFormatter isShowTime) - setStderrFormatter = (`setFormatter` stderrFormatter) + setStdoutFormatter = (`setFormatter` stdoutFormatter isShowTime isShowTid) + setStderrFormatter = (`setFormatter` stderrFormatter isShowTid) -- | Set severity for given logger. By default parent's severity is used. setSeverity :: MonadIO m => LoggerName -> Severity -> m ()