Blammo 2.1.1.0 → 2.1.2.0

raw patch · 6 files changed

+149/−138 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Blammo.cabal +1/−1
• CHANGELOG.md +6/−2
• src/Blammo/Logging/LogSettings/Env.hs +1/−1
• src/Blammo/Logging/Logger.hs +27/−10
• src/Blammo/Logging/Terminal.hs +44/−47
• tests/Blammo/Logging/TerminalSpec.hs +70/−77

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            Blammo-version:         2.1.1.0+version:         2.1.2.0 license:         MIT license-file:    LICENSE maintainer:      Freckle Education

@@ -1,6 +1,10 @@-## [_Unreleased_](https://github.com/freckle/blammo/compare/Blammo-v2.1.1.0...main)+## [_Unreleased_](https://github.com/freckle/blammo/compare/Blammo-v2.1.2.0...main) -## [v2.1.1.0](https://github.com/freckle/blammo/compare/v2.0.0.0...Blammo-v2.1.0.0)+## [v2.1.2.0](https://github.com/freckle/blammo/compare/v2.1.1.0...Blammo-v2.1.2.0)++- Add `setLoggerReformat`++## [v2.1.1.0](https://github.com/freckle/blammo/compare/v2.1.0.0...Blammo-v2.1.1.0)  - Accept special value `null` for `LOG_DESTINATION` as a synonym for the null   device (`/dev/null` or `\\.\NUL` on windows).

@@ -74,7 +74,7 @@  parserWith :: LogSettings -> Parser Error LogSettings parserWith defaults =-  ($ defaults) . appEndo . mconcat+  flip (appEndo . mconcat) defaults     <$> sequenceA       [ endoVar readLogLevels setLogSettingsLevels "LOG_LEVEL"       , endoVar readLogDestination setLogSettingsDestination "LOG_DESTINATION"

@@ -8,6 +8,7 @@   , pushLoggerLn   , getLoggerLogSettings   , getLoggerReformat+  , setLoggerReformat   , getLoggerShouldLog   , getLoggerShouldColor   , pushLogStrLn@@ -24,6 +25,7 @@  import Prelude +import Blammo.Logging.Colors (Colors, getColors) import Blammo.Logging.Internal.Logger import Blammo.Logging.LogSettings import Blammo.Logging.Terminal@@ -34,9 +36,11 @@ import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Logger.Aeson import Control.Monad.Reader (MonadReader)+import qualified Data.Aeson as Aeson import Data.ByteString (ByteString) import Data.Either (partitionEithers, rights) import Data.List (intercalate)+import Data.Maybe (fromMaybe) import Data.Text (Text) import GHC.Stack (HasCallStack) import System.IO (stderr, stdout)@@ -89,6 +93,17 @@ getLoggerReformat :: Logger -> LogLevel -> ByteString -> ByteString getLoggerReformat = lReformat +setLoggerReformat+  :: (LogSettings -> Colors -> LogLevel -> LoggedMessage -> ByteString)+  -> Logger+  -> Logger+setLoggerReformat f logger =+  logger+    { lReformat = \level bytes -> fromMaybe bytes $ do+        lm <- Aeson.decodeStrict bytes+        pure $ f (lLogSettings logger) (getColors $ lShouldColor logger) level lm+    }+ getLoggerShouldLog :: Logger -> LogSource -> LogLevel -> Bool getLoggerShouldLog = lShouldLog @@ -133,18 +148,20 @@           <$> newFileLoggerSetN defaultBufSize concurrency path           <*> shouldColorAuto settings (pure False) -  let-    lReformat = case getLogSettingsFormat settings of-      LogFormatJSON -> const id -- breakpoint and color ignored-      LogFormatTerminal -> reformatTerminal breakpoint lShouldColor--    lShouldLog = shouldLogLevel settings-    lLoggedMessages = Nothing-    lLogSettings = settings+  let logger =+        Logger+          { lLogSettings = settings+          , lLoggerSet = lLoggerSet+          , lReformat = const id -- By default render (JSON) bytestring as-is+          , lShouldLog = shouldLogLevel settings+          , lShouldColor = lShouldColor+          , lLoggedMessages = Nothing+          } -  pure $ Logger {..}+  pure $ case getLogSettingsFormat settings of+    LogFormatJSON -> logger+    LogFormatTerminal -> setLoggerReformat reformatTerminal logger  where-  breakpoint = getLogSettingsBreakpoint settings   concurrency = getLogSettingsConcurrency settings  flushLogger :: (MonadIO m, MonadReader env m, HasLogger env) => m ()

@@ -20,6 +20,7 @@ import Prelude  import Blammo.Logging.Colors+import Blammo.Logging.LogSettings (LogSettings, getLogSettingsBreakpoint) import Blammo.Logging.Terminal.LogPiece (LogPiece, logPiece) import qualified Blammo.Logging.Terminal.LogPiece as LogPiece import Control.Monad.Logger.Aeson@@ -28,7 +29,6 @@ import qualified Data.Aeson.Compat as Key import qualified Data.Aeson.Compat as KeyMap import Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy as BSL import Data.List (sortOn) import Data.Maybe (fromMaybe) import Data.Text (Text, pack)@@ -36,60 +36,57 @@ import Data.Time (defaultTimeLocale, formatTime) import qualified Data.Vector as V -reformatTerminal :: Int -> Bool -> LogLevel -> ByteString -> ByteString-reformatTerminal breakpoint useColor logLevel bytes = fromMaybe bytes $ do-  LoggedMessage {..} <- decode $ BSL.fromStrict bytes--  let-    colors@Colors {..} = getColors useColor--    logTimestampPiece =-      logPiece dim $-        pack $-          formatTime-            defaultTimeLocale-            "%F %X"-            loggedMessageTimestamp+reformatTerminal+  :: LogSettings -> Colors -> LogLevel -> LoggedMessage -> ByteString+reformatTerminal settings colors@Colors {..} logLevel LoggedMessage {..} = do+  LogPiece.bytestring $+    if LogPiece.visibleLength oneLineLogPiece <= breakpoint+      then oneLineLogPiece+      else multiLineLogPiece+ where+  breakpoint = getLogSettingsBreakpoint settings -    logLevelPiece = case logLevel of-      LevelDebug -> logPiece gray $ padTo 9 "debug"-      LevelInfo -> logPiece green $ padTo 9 "info"-      LevelWarn -> logPiece yellow $ padTo 9 "warn"-      LevelError -> logPiece red $ padTo 9 "error"-      LevelOther x -> logPiece blue $ padTo 9 x+  logTimestampPiece =+    logPiece dim $+      pack $+        formatTime+          defaultTimeLocale+          "%F %X"+          loggedMessageTimestamp -    loggedSourceAsMap =-      foldMap (KeyMap.singleton "source" . String) loggedMessageLogSource+  logLevelPiece = case logLevel of+    LevelDebug -> logPiece gray $ padTo 9 "debug"+    LevelInfo -> logPiece green $ padTo 9 "info"+    LevelWarn -> logPiece yellow $ padTo 9 "warn"+    LevelError -> logPiece red $ padTo 9 "error"+    LevelOther x -> logPiece blue $ padTo 9 x -    logPrefixPiece =-      logTimestampPiece <> " [" <> logLevelPiece <> "] "+  loggedSourceAsMap =+    foldMap (KeyMap.singleton "source" . String) loggedMessageLogSource -    logMessagePiece = logPiece bold $ padTo 31 loggedMessageText+  logPrefixPiece =+    logTimestampPiece <> " [" <> logLevelPiece <> "] " -    logAttrsPiece =-      mconcat-        [ colorizeKeyMap " " colors loggedSourceAsMap-        , colorizeKeyMap " " colors loggedMessageThreadContext-        , colorizeKeyMap " " colors loggedMessageMeta-        ]+  logMessagePiece = logPiece bold $ padTo 31 loggedMessageText -    oneLineLogPiece = mconcat [logPrefixPiece, logMessagePiece, logAttrsPiece]+  logAttrsPiece =+    mconcat+      [ colorizeKeyMap " " colors loggedSourceAsMap+      , colorizeKeyMap " " colors loggedMessageThreadContext+      , colorizeKeyMap " " colors loggedMessageMeta+      ] -    multiLineLogPiece =-      let shift = "\n" <> LogPiece.offset (LogPiece.visibleLength logPrefixPiece)-      in  mconcat-            [ logPrefixPiece-            , logMessagePiece-            , colorizeKeyMap shift colors loggedSourceAsMap-            , colorizeKeyMap shift colors loggedMessageThreadContext-            , colorizeKeyMap shift colors loggedMessageMeta-            ]+  oneLineLogPiece = mconcat [logPrefixPiece, logMessagePiece, logAttrsPiece] -  pure $-    LogPiece.bytestring $-      if LogPiece.visibleLength oneLineLogPiece <= breakpoint-        then oneLineLogPiece-        else multiLineLogPiece+  multiLineLogPiece =+    let shift = "\n" <> LogPiece.offset (LogPiece.visibleLength logPrefixPiece)+    in  mconcat+          [ logPrefixPiece+          , logMessagePiece+          , colorizeKeyMap shift colors loggedSourceAsMap+          , colorizeKeyMap shift colors loggedMessageThreadContext+          , colorizeKeyMap shift colors loggedMessageMeta+          ]  colorizeKeyMap :: LogPiece -> Colors -> KeyMap Value -> LogPiece colorizeKeyMap sep Colors {..} km

@@ -7,14 +7,19 @@ import Prelude  import Blammo.Logging+import Blammo.Logging.Colors (noColors)+import Blammo.Logging.LogSettings+  ( LogSettings+  , defaultLogSettings+  , setLogSettingsBreakpoint+  ) import Blammo.Logging.Logger (LoggedMessage (..)) import Blammo.Logging.Terminal-import Data.Aeson (encode, object)+import Data.Aeson (object) import Data.Aeson.Types (Object, Pair, Value (..)) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8-import qualified Data.ByteString.Lazy as BSL import Data.Text (Text) import Data.Time import Test.Hspec@@ -22,35 +27,22 @@ spec :: Spec spec = do   describe "reformatTerminal" $ do-    it "passes-through none-LoggedMessages as-is" $ do-      let-        bs :: ByteString-        bs = "I'm not even JSON"--        bsJSON :: ByteString-        bsJSON = "{\"I'm\":\"Valid JSON, but not LoggedMessage\"}"--      reformatTerminal 0 False LevelInfo bs `shouldBe` bs-      reformatTerminal 0 False LevelInfo bsJSON `shouldBe` bsJSON-     it "reformats LoggedMessages with complex attributes" $ do       let-        bs =-          BSL.toStrict $-            encode-              LoggedMessage-                { loggedMessageTimestamp =-                    UTCTime-                      { utctDay = fromGregorian 2022 1 1-                      , utctDayTime = 0-                      }-                , loggedMessageLevel = LevelInfo-                , loggedMessageLoc = Nothing-                , loggedMessageLogSource = Just "app"-                , loggedMessageThreadContext = keyMap ["x" .= object ["y" .= True]]-                , loggedMessageText = "I'm a log message"-                , loggedMessageMeta = keyMap ["a" .= [1 :: Int, 2, 3]]-                }+        lm =+          LoggedMessage+            { loggedMessageTimestamp =+                UTCTime+                  { utctDay = fromGregorian 2022 1 1+                  , utctDayTime = 0+                  }+            , loggedMessageLevel = LevelInfo+            , loggedMessageLoc = Nothing+            , loggedMessageLogSource = Just "app"+            , loggedMessageThreadContext = keyMap ["x" .= object ["y" .= True]]+            , loggedMessageText = "I'm a log message"+            , loggedMessageMeta = keyMap ["a" .= [1 :: Int, 2, 3]]+            }          expected =           mconcat@@ -58,32 +50,30 @@             , " source=app x={y: True} a=[1, 2, 3]"             ] -      reformatTerminal 120 False LevelInfo bs `shouldBe` expected+      reformatTerminal (settings 120) noColors LevelInfo lm `shouldBe` expected      it "moves attributes to multi-line at the given breakpoint" $ do       let-        bs =-          BSL.toStrict $-            encode-              LoggedMessage-                { loggedMessageTimestamp =-                    UTCTime-                      { utctDay = fromGregorian 2022 1 1-                      , utctDayTime = 0-                      }-                , loggedMessageLevel = LevelInfo-                , loggedMessageLoc = Nothing-                , loggedMessageLogSource = Just "app"-                , loggedMessageThreadContext = mempty-                , loggedMessageText = "I'm a log message"-                , loggedMessageMeta =-                    keyMap-                      [ "a" .= ("aaaaaaaaa" :: Text)-                      , "b" .= ("aaaaaaaaa" :: Text)-                      , "c" .= ("aaaaaaaaa" :: Text)-                      , "d" .= ("aaaaaaaaa" :: Text)-                      ]-                }+        lm =+          LoggedMessage+            { loggedMessageTimestamp =+                UTCTime+                  { utctDay = fromGregorian 2022 1 1+                  , utctDayTime = 0+                  }+            , loggedMessageLevel = LevelInfo+            , loggedMessageLoc = Nothing+            , loggedMessageLogSource = Just "app"+            , loggedMessageThreadContext = mempty+            , loggedMessageText = "I'm a log message"+            , loggedMessageMeta =+                keyMap+                  [ "a" .= ("aaaaaaaaa" :: Text)+                  , "b" .= ("aaaaaaaaa" :: Text)+                  , "c" .= ("aaaaaaaaa" :: Text)+                  , "d" .= ("aaaaaaaaa" :: Text)+                  ]+            }          single =           mconcat@@ -103,33 +93,32 @@          breakpoint = BS.length single -      reformatTerminal breakpoint False LevelInfo bs `shouldBe` single-      reformatTerminal (breakpoint - 1) False LevelInfo bs `shouldBe` multi+      reformatTerminal (settings breakpoint) noColors LevelInfo lm `shouldBe` single+      reformatTerminal (settings $ breakpoint - 1) noColors LevelInfo lm+        `shouldBe` multi    it "aligns multi-line correctly even with color escapes" $ do     let-      bs =-        BSL.toStrict $-          encode-            LoggedMessage-              { loggedMessageTimestamp =-                  UTCTime-                    { utctDay = fromGregorian 2022 1 1-                    , utctDayTime = 0-                    }-              , loggedMessageLevel = LevelInfo-              , loggedMessageLoc = Nothing-              , loggedMessageLogSource = Just "app"-              , loggedMessageThreadContext = mempty-              , loggedMessageText = "I'm a log message"-              , loggedMessageMeta =-                  keyMap-                    [ "a" .= ("aaaaaaaaa" :: Text)-                    , "b" .= ("aaaaaaaaa" :: Text)-                    , "c" .= ("aaaaaaaaa" :: Text)-                    , "d" .= ("aaaaaaaaa" :: Text)-                    ]-              }+      lm =+        LoggedMessage+          { loggedMessageTimestamp =+              UTCTime+                { utctDay = fromGregorian 2022 1 1+                , utctDayTime = 0+                }+          , loggedMessageLevel = LevelInfo+          , loggedMessageLoc = Nothing+          , loggedMessageLogSource = Just "app"+          , loggedMessageThreadContext = mempty+          , loggedMessageText = "I'm a log message"+          , loggedMessageMeta =+              keyMap+                [ "a" .= ("aaaaaaaaa" :: Text)+                , "b" .= ("aaaaaaaaa" :: Text)+                , "c" .= ("aaaaaaaaa" :: Text)+                , "d" .= ("aaaaaaaaa" :: Text)+                ]+          }        expected =         mconcat@@ -141,7 +130,11 @@           , "                                d=aaaaaaaaa"           ] -    stripColor (reformatTerminal 120 True LevelInfo bs) `shouldBe` expected+    stripColor (reformatTerminal (settings 120) noColors LevelInfo lm)+      `shouldBe` expected++settings :: Int -> LogSettings+settings breakpoint = setLogSettingsBreakpoint breakpoint defaultLogSettings  keyMap :: [Pair] -> Object keyMap ps = km where Object km = object ps