diff --git a/Blammo.cabal b/Blammo.cabal --- a/Blammo.cabal +++ b/Blammo.cabal @@ -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 diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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) diff --git a/README.lhs b/README.lhs --- a/README.lhs +++ b/README.lhs @@ -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=[,,...]` | -| Destination | `setLogSettingsDestination` | `LOG_DESTINATION=stdout\|stderr\|@` | -| Format | `setLogSettingsFormat` | `LOG_FORMAT=tty\|json` | +| Setting | Setter | Environment variable and format | +| --- | --- | --- | +| Level(s) | `setLogSettingsLevels` | `LOG_LEVEL=[,,...]` | +| Destination | `setLogSettingsDestination` | `LOG_DESTINATION=stdout\|stderr\|@` | +| Color | `setLogSettingsColor ` | `LOG_COLOR=auto\|always\|never` | +| Breakpoint | `setLogSettingsBreakpoint` | `LOG_BREAKPOINT=` | ## Advanced Usage diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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=[,,...]` | -| Destination | `setLogSettingsDestination` | `LOG_DESTINATION=stdout\|stderr\|@` | -| Format | `setLogSettingsFormat` | `LOG_FORMAT=tty\|json` | +| Setting | Setter | Environment variable and format | +| --- | --- | --- | +| Level(s) | `setLogSettingsLevels` | `LOG_LEVEL=[,,...]` | +| Destination | `setLogSettingsDestination` | `LOG_DESTINATION=stdout\|stderr\|@` | +| Color | `setLogSettingsColor ` | `LOG_COLOR=auto\|always\|never` | +| Breakpoint | `setLogSettingsBreakpoint` | `LOG_BREAKPOINT=` | ## Advanced Usage diff --git a/src/Blammo/Logging/LogSettings.hs b/src/Blammo/Logging/LogSettings.hs --- a/src/Blammo/Logging/LogSettings.hs +++ b/src/Blammo/Logging/LogSettings.hs @@ -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 diff --git a/src/Blammo/Logging/LogSettings/Env.hs b/src/Blammo/Logging/LogSettings/Env.hs --- a/src/Blammo/Logging/LogSettings/Env.hs +++ b/src/Blammo/Logging/LogSettings/Env.hs @@ -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 diff --git a/src/Blammo/Logging/Logger.hs b/src/Blammo/Logging/Logger.hs --- a/src/Blammo/Logging/Logger.hs +++ b/src/Blammo/Logging/Logger.hs @@ -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 diff --git a/src/Blammo/Logging/Terminal.hs b/src/Blammo/Logging/Terminal.hs --- a/src/Blammo/Logging/Terminal.hs +++ b/src/Blammo/Logging/Terminal.hs @@ -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 diff --git a/src/Blammo/Logging/Terminal/LogPiece.hs b/src/Blammo/Logging/Terminal/LogPiece.hs new file mode 100644 --- /dev/null +++ b/src/Blammo/Logging/Terminal/LogPiece.hs @@ -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 } diff --git a/tests/Blammo/Logging/TerminalSpec.hs b/tests/Blammo/Logging/TerminalSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Blammo/Logging/TerminalSpec.hs @@ -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)