log-warper 1.1.2 → 1.1.3

raw patch · 7 files changed

+73/−37 lines, 7 files

Files

• CHANGES.md +6/−0
• log-warper.cabal +4/−3
• src/System/Wlog/Formatter.hs +13/−10
• src/System/Wlog/Launcher.hs +6/−2
• src/System/Wlog/LoggerConfig.hs +35/−16
• src/System/Wlog/LoggerNameBox.hs +1/−2
• src/System/Wlog/Wrapper.hs +8/−4

@@ -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.

@@ -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 <hi@serokell.io> copyright:           2016-2017 Serokell-category:            Interfaces+category:            Logging+extra-source-files:  CHANGES.md stability:           experimental build-type:          Simple cabal-version:       >=1.18

@@ -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

@@ -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

@@ -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

@@ -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.

@@ -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 ()