Blammo 1.1.0.0 → 1.1.1.0

raw patch · 10 files changed

+311/−41 lines, 10 filesdep ~bytestringdep ~timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: bytestring, time

API changes (from Hackage documentation)

Files

• Blammo.cabal +6/−2
• CHANGELOG.md +7/−1
• README.lhs +16/−5
• README.md +16/−5
• src/Blammo/Logging/LogSettings.hs +10/−0
• src/Blammo/Logging/LogSettings/Env.hs +2/−0
• src/Blammo/Logging/Logger.hs +4/−2
• src/Blammo/Logging/Terminal.hs +51/−26
• src/Blammo/Logging/Terminal/LogPiece.hs +60/−0
• tests/Blammo/Logging/TerminalSpec.hs +139/−0

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            Blammo-version:         1.1.0.0+version:         1.1.1.0 license:         MIT license-file:    LICENSE maintainer:      Freckle Education@@ -28,6 +28,7 @@         Blammo.Logging.LogSettings.LogLevels         Blammo.Logging.Simple         Blammo.Logging.Terminal+        Blammo.Logging.Terminal.LogPiece         Blammo.Logging.Test         Data.Aeson.Compat         Network.Wai.Middleware.Logging@@ -111,6 +112,7 @@     other-modules:         Blammo.Logging.LoggerSpec         Blammo.Logging.LogSettings.LogLevelsSpec+        Blammo.Logging.TerminalSpec         Paths_Blammo      default-language:   Haskell2010@@ -128,9 +130,11 @@         Blammo,         aeson,         base >=4.11.1.0 && <5,+        bytestring,         hspec,         mtl,-        text+        text,+        time      if impl(ghc >=9.2)         ghc-options: -Wno-missing-kind-signatures

@@ -1,4 +1,10 @@-## [_Unreleased_](https://github.com/freckle/blammo/compare/v1.1.0.0...main)+## [_Unreleased_](https://github.com/freckle/blammo/compare/v1.1.1.0...main)++## [v1.1.1.0](https://github.com/freckle/blammo/compare/v1.1.0.0...v1.1.1.0)++- Terminal formatter: align attributes vertically if the message goes over a+  certain number of characters (default 120).+- Adds `{get,set}LogSettingsBreakpoint` and `LOG_BREAKPOINT` parsing  ## [v1.1.0.0](https://github.com/freckle/blammo/compare/v1.0.3.0...v1.1.0.0) 

@@ -104,13 +104,24 @@  ![](files/readme-json.png) +## Multiline Format++With the terminal formatter, a log message that is more than 120 visible+characters will break into multi-line format:++![](files/multiline.png)++This breakpoint can be controlled with `LOG_BREAKPOINT`. Set an unreasonably+large number to disable this feature.+ ## Configuration -| Setting     | Setter                      | Environment variable and format          |-| ---         | ---                         | ---                                      |-| Level(s)    | `setLogSettingsLevels`      | `LOG_LEVEL=<level>[,<source:level>,...]` |-| Destination | `setLogSettingsDestination` | `LOG_DESTINATION=stdout\|stderr\|@<path>`  |-| Format      | `setLogSettingsFormat`      | `LOG_FORMAT=tty\|json`                    |+| Setting     | Setter                      | Environment variable and format           |+| ---         | ---                         | ---                                       |+| Level(s)    | `setLogSettingsLevels`      | `LOG_LEVEL=<level>[,<source:level>,...]`  |+| Destination | `setLogSettingsDestination` | `LOG_DESTINATION=stdout\|stderr\|@<path>` |+| Color       | `setLogSettingsColor `      | `LOG_COLOR=auto\|always\|never`           |+| Breakpoint  | `setLogSettingsBreakpoint`  | `LOG_BREAKPOINT=<number>`                 |  ## Advanced Usage 

@@ -104,13 +104,24 @@  ![](files/readme-json.png) +## Multiline Format++With the terminal formatter, a log message that is more than 120 visible+characters will break into multi-line format:++![](files/multiline.png)++This breakpoint can be controlled with `LOG_BREAKPOINT`. Set an unreasonably+large number to disable this feature.+ ## Configuration -| Setting     | Setter                      | Environment variable and format          |-| ---         | ---                         | ---                                      |-| Level(s)    | `setLogSettingsLevels`      | `LOG_LEVEL=<level>[,<source:level>,...]` |-| Destination | `setLogSettingsDestination` | `LOG_DESTINATION=stdout\|stderr\|@<path>`  |-| Format      | `setLogSettingsFormat`      | `LOG_FORMAT=tty\|json`                    |+| Setting     | Setter                      | Environment variable and format           |+| ---         | ---                         | ---                                       |+| Level(s)    | `setLogSettingsLevels`      | `LOG_LEVEL=<level>[,<source:level>,...]`  |+| Destination | `setLogSettingsDestination` | `LOG_DESTINATION=stdout\|stderr\|@<path>` |+| Color       | `setLogSettingsColor `      | `LOG_COLOR=auto\|always\|never`           |+| Breakpoint  | `setLogSettingsBreakpoint`  | `LOG_BREAKPOINT=<number>`                 |  ## Advanced Usage 

@@ -19,12 +19,14 @@   , setLogSettingsDestination   , setLogSettingsFormat   , setLogSettingsColor+  , setLogSettingsBreakpoint    -- * Access   , getLogSettingsLevels   , getLogSettingsDestination   , getLogSettingsFormat   , getLogSettingsColor+  , getLogSettingsBreakpoint    -- * Logic   , shouldLogLevel@@ -45,6 +47,7 @@   , lsDestination :: LogDestination   , lsFormat :: LogFormat   , lsColor :: LogColor+  , lsBreakpoint :: Int   }  readLogLevels :: String -> Either String LogLevels@@ -107,6 +110,7 @@   , lsDestination = LogDestinationStdout   , lsFormat = LogFormatTerminal   , lsColor = LogColorAuto+  , lsBreakpoint = 120   }  setLogSettingsLevels :: LogLevels -> LogSettings -> LogSettings@@ -121,6 +125,9 @@ setLogSettingsColor :: LogColor -> LogSettings -> LogSettings setLogSettingsColor x ls = ls { lsColor = x } +setLogSettingsBreakpoint :: Int -> LogSettings -> LogSettings+setLogSettingsBreakpoint x ls = ls { lsBreakpoint = x }+ getLogSettingsLevels :: LogSettings -> LogLevels getLogSettingsLevels = lsLevels @@ -132,6 +139,9 @@  getLogSettingsColor :: LogSettings -> LogColor getLogSettingsColor = lsColor++getLogSettingsBreakpoint :: LogSettings -> Int+getLogSettingsBreakpoint = lsBreakpoint  shouldLogLevel :: LogSettings -> LogSource -> LogLevel -> Bool shouldLogLevel = LogLevels.shouldLogLevel . getLogSettingsLevels

@@ -51,6 +51,7 @@ import Data.Semigroup (Endo(..)) import Env hiding (parse) import qualified Env+import Text.Read (readEither)  parse :: IO LogSettings parse = parseWith defaultLogSettings@@ -69,6 +70,7 @@   , var (endo readLogDestination setLogSettingsDestination) "LOG_DESTINATION" (def mempty)   , var (endo readLogFormat setLogSettingsFormat) "LOG_FORMAT" (def mempty)   , var (endo readLogColor setLogSettingsColor) "LOG_COLOR" (def mempty)+  , var (endo readEither setLogSettingsBreakpoint) "LOG_BREAKPOINT" (def mempty)   ]  endo

@@ -93,9 +93,11 @@         (pure False)    let+    breakpoint = getLogSettingsBreakpoint settings+     lReformat = case getLogSettingsFormat settings of-      LogFormatJSON -> const id -- Color is ignored-      LogFormatTerminal -> reformatTerminal useColor+      LogFormatJSON -> const id -- breakpoint and color ignored+      LogFormatTerminal -> reformatTerminal breakpoint useColor      lShouldLog = shouldLogLevel settings     lLoggedMessages = Nothing

@@ -21,6 +21,8 @@ import Prelude  import Blammo.Logging.Colors+import Blammo.Logging.Terminal.LogPiece (LogPiece, logPiece)+import qualified Blammo.Logging.Terminal.LogPiece as LogPiece import Control.Monad.Logger.Aeson import Data.Aeson import Data.Aeson.Compat (KeyMap)@@ -28,50 +30,73 @@ 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) import qualified Data.Text as T-import Data.Text.Encoding (encodeUtf8) import Data.Time (defaultTimeLocale, formatTime) import qualified Data.Vector as V -reformatTerminal :: Bool -> LogLevel -> ByteString -> ByteString-reformatTerminal useColor logLevel bytes = fromMaybe bytes $ do+reformatTerminal :: Int -> Bool -> LogLevel -> ByteString -> ByteString+reformatTerminal breakpoint useColor logLevel bytes = fromMaybe bytes $ do   LoggedMessage {..} <- decode $ BSL.fromStrict bytes    let     colors@Colors {..} = getColors useColor -    logTimestampText =-      dim $ pack $ formatTime defaultTimeLocale "%F %X" loggedMessageTimestamp+    logTimestampPiece = logPiece dim $ pack $ formatTime+      defaultTimeLocale+      "%F %X"+      loggedMessageTimestamp -    logLevelText = case logLevel of-      LevelDebug -> gray $ padTo 9 "debug"-      LevelInfo -> green $ padTo 9 "info"-      LevelWarn -> yellow $ padTo 9 "warn"-      LevelError -> red $ padTo 9 "error"-      LevelOther x -> blue $ padTo 9 x+    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      loggedSourceAsMap =       foldMap (KeyMap.singleton "source" . String) loggedMessageLogSource -  pure $ encodeUtf8 $ mconcat-    [ logTimestampText <> " "-    , "[" <> logLevelText <> "] "-    , bold $ padTo 31 loggedMessageText-    , colorizeKeyMap colors loggedSourceAsMap-    , colorizeKeyMap colors loggedMessageThreadContext-    , colorizeKeyMap colors loggedMessageMeta-    ]+    logPrefixPiece =+      logTimestampPiece <> " [" <> logLevelPiece <> "] " -colorizeKeyMap :: Colors -> KeyMap Value -> Text-colorizeKeyMap Colors {..} km-  | KeyMap.null km = ""-  | otherwise = " " <> T.intercalate " " keyValues- where-  keyValues = map (uncurry renderPair) $ KeyMap.toList km+    logMessagePiece = logPiece bold $ padTo 31 loggedMessageText -  renderPair k v = cyan (Key.toText k) <> "=" <> magenta (fromValue v)+    logAttrsPiece = mconcat+      [ colorizeKeyMap " " colors loggedSourceAsMap+      , colorizeKeyMap " " colors loggedMessageThreadContext+      , colorizeKeyMap " " colors loggedMessageMeta+      ]++    oneLineLogPiece = mconcat [logPrefixPiece, logMessagePiece, logAttrsPiece]++    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+          ]++  pure+    $ LogPiece.bytestring+    $ if LogPiece.visibleLength oneLineLogPiece <= breakpoint+        then oneLineLogPiece+        else multiLineLogPiece++colorizeKeyMap :: LogPiece -> Colors -> KeyMap Value -> LogPiece+colorizeKeyMap sep Colors {..} km+  | KeyMap.null km = mempty+  | otherwise = foldMap (uncurry fromPair) $ sortOn fst $ KeyMap.toList km+ where+  fromPair k v =+    sep <> logPiece cyan (Key.toText k) <> "=" <> logPiece magenta (fromValue v)    fromValue = \case     Object m -> obj $ map (uncurry renderPairNested) $ KeyMap.toList m

@@ -0,0 +1,60 @@+module Blammo.Logging.Terminal.LogPiece+  ( LogPiece+  , logPiece+  , render+  , visibleLength+  , bytestring++  -- * Built-in pieces+  , offset+  ) where++import Prelude++import Data.ByteString (ByteString)+import Data.Semigroup (Sum(..))+import Data.String (IsString(..))+import Data.Text (Text, pack)+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8)++data LogPiece = LogPiece+  { lpRendered :: Text+  , lpVisibleLength :: Sum Int+  }+  -- TODO: When we drop support for ghc-8.6:+  -- deriving stock Generic+  -- deriving (Semigroup, Monoid) via (GenericSemigroupMonoid LogPiece)++instance Semigroup LogPiece where+  a <> b = LogPiece+    { lpRendered = lpRendered a <> lpRendered b+    , lpVisibleLength = lpVisibleLength a <> lpVisibleLength b+    }++instance Monoid LogPiece where+  mempty = LogPiece mempty mempty++instance IsString LogPiece where+  fromString = logPiece id . pack++logPiece+  :: (Text -> Text)+  -- ^ Non-visible decoration, such as color escapes+  -> Text+  -- ^ Raw+  -> LogPiece+logPiece f t =+  LogPiece { lpRendered = f t, lpVisibleLength = Sum $ T.length t }++render :: LogPiece -> Text+render = lpRendered++bytestring :: LogPiece -> ByteString+bytestring = encodeUtf8 . render++visibleLength :: LogPiece -> Int+visibleLength = getSum . lpVisibleLength++offset :: Int -> LogPiece+offset n = LogPiece { lpRendered = T.replicate n " ", lpVisibleLength = Sum n }

@@ -0,0 +1,139 @@+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}++module Blammo.Logging.TerminalSpec+  ( spec+  ) where++import Prelude++import Blammo.Logging+import Blammo.Logging.Logger (LoggedMessage(..))+import Blammo.Logging.Terminal+import Data.Aeson+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++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]]+          }++        expected = mconcat+          [ "2022-01-01 00:00:00 [info     ] I'm a log message              "+          , " source=app x={y: True} a=[1, 2, 3]"+          ]++      reformatTerminal 120 False LevelInfo bs `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)+            ]+          }++        single = mconcat+          [ "2022-01-01 00:00:00 [info     ] I'm a log message              "+          , " source=app a=aaaaaaaaa b=aaaaaaaaa c=aaaaaaaaa d=aaaaaaaaa"+          ]++        multi = mconcat+          [ "2022-01-01 00:00:00 [info     ] I'm a log message              \n"+          , "                                source=app\n"+          , "                                a=aaaaaaaaa\n"+          , "                                b=aaaaaaaaa\n"+          , "                                c=aaaaaaaaa\n"+          , "                                d=aaaaaaaaa"+          ]++        breakpoint = BS.length single++      reformatTerminal breakpoint False LevelInfo bs `shouldBe` single+      reformatTerminal (breakpoint - 1) False LevelInfo bs `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)+          ]+        }++      expected = mconcat+        [ "2022-01-01 00:00:00 [info     ] I'm a log message              \n"+        , "                                source=app\n"+        , "                                a=aaaaaaaaa\n"+        , "                                b=aaaaaaaaa\n"+        , "                                c=aaaaaaaaa\n"+        , "                                d=aaaaaaaaa"+        ]++    stripColor (reformatTerminal 120 True LevelInfo bs) `shouldBe` expected++keyMap :: [Pair] -> Object+keyMap ps = km where Object km = object ps++-- Removes from any '\ESC' Char to the next 'm' Char+stripColor :: ByteString -> ByteString+stripColor = snd . BS8.foldl' go (False, "")+ where+  go :: (Bool, ByteString) -> Char -> (Bool, ByteString)+  go (dropping, acc) = \case+    '\ESC' -> (True, acc)+    'm' | dropping -> (False, acc)+    _ | dropping -> (True, acc)+    c -> (False, BS8.snoc acc c)