Blammo 1.1.2.0 → 1.1.2.1

raw patch · 17 files changed

+401/−296 lines, 17 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Blammo.cabal +2/−1
• CHANGELOG.md +5/−1
• src/Blammo/Logging.hs +21/−18
• src/Blammo/Logging/Colors.hs +79/−25
• src/Blammo/Logging/Internal/Logger.hs +28/−0
• src/Blammo/Logging/LogSettings.hs +44/−44
• src/Blammo/Logging/LogSettings/Env.hs +20/−21
• src/Blammo/Logging/LogSettings/LogLevels.hs +15/−12
• src/Blammo/Logging/Logger.hs +31/−37
• src/Blammo/Logging/Simple.hs +1/−1
• src/Blammo/Logging/Terminal.hs +24/−23
• src/Blammo/Logging/Terminal/LogPiece.hs +14/−12
• src/Blammo/Logging/Test.hs +3/−3
• src/Network/Wai/Middleware/Logging.hs +22/−23
• tests/Blammo/Logging/LogSettings/LogLevelsSpec.hs +2/−3
• tests/Blammo/Logging/LoggerSpec.hs +1/−1
• tests/Blammo/Logging/TerminalSpec.hs +89/−71

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            Blammo-version:         1.1.2.0+version:         1.1.2.1 license:         MIT license-file:    LICENSE maintainer:      Freckle Education@@ -22,6 +22,7 @@     exposed-modules:         Blammo.Logging         Blammo.Logging.Colors+        Blammo.Logging.Internal.Logger         Blammo.Logging.Logger         Blammo.Logging.LogSettings         Blammo.Logging.LogSettings.Env

@@ -1,4 +1,8 @@-## [_Unreleased_](https://github.com/freckle/blammo/compare/v1.1.2.0...main)+## [_Unreleased_](https://github.com/freckle/blammo/compare/v1.1.2.1...main)++## [v1.1.2.1](https://github.com/freckle/blammo/compare/v1.1.2.0...v1.1.2.1)++- Add various `getColors*` helper functions  ## [v1.1.2.0](https://github.com/freckle/blammo/compare/v1.1.1.2...v1.1.2.0) 

@@ -1,9 +1,9 @@ module Blammo.Logging   ( LogSettings-  , LogLevel(..)-  , LogDestination(..)-  , LogFormat(..)-  , LogColor(..)+  , LogLevel (..)+  , LogDestination (..)+  , LogFormat (..)+  , LogColor (..)   , defaultLogSettings   , setLogSettingsLevels   , setLogSettingsDestination@@ -12,38 +12,40 @@   , setLogSettingsBreakpoint   , setLogSettingsConcurrency   , Logger-  , HasLogger(..)+  , HasLogger (..)   , newLogger   , runLoggerLoggingT -  -- * Re-exports from "Control.Monad.Logger.Aeson"-  -- ** Messages-  , Message(..)+    -- * Re-exports from "Control.Monad.Logger.Aeson"++    -- ** Messages+  , Message (..)   , (.=)   , Series -  -- ** Thread Context+    -- ** Thread Context   , MonadMask   , withThreadContext   , myThreadContext   , Pair -  -- ** Transformer-  , MonadLogger(..)-  , MonadLoggerIO(..)+    -- ** Transformer+  , MonadLogger (..)+  , MonadLoggerIO (..)   , LoggingT -  -- ** Common logging functions-  -- | Import "Control.Monad.Logger.Aeson" if you want more+    -- ** Common logging functions -  -- *** Implicit call stack, no 'LogSource'+    -- | Import "Control.Monad.Logger.Aeson" if you want more++    -- *** Implicit call stack, no 'LogSource'   , logDebug   , logInfo   , logWarn   , logError   , logOther -  -- *** Implicit call stack, with 'LogSource'+    -- *** Implicit call stack, with 'LogSource'   , LogSource   , logDebugNS   , logInfoNS@@ -54,8 +56,8 @@  import Prelude -import Blammo.Logging.Logger import Blammo.Logging.LogSettings+import Blammo.Logging.Logger import Control.Lens ((^.)) import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Unlift (MonadUnliftIO)@@ -71,7 +73,8 @@   runLoggingT     (filterLogger (getLoggerShouldLog logger) f)     (loggerOutput logger $ getLoggerReformat logger)-  where logger = env ^. loggerL+ where+  logger = env ^. loggerL  loggerOutput   :: Logger

@@ -1,11 +1,30 @@+-- | Generic facilities for adding terminal escapes to 'Text'+--+-- Recommended usage:+--+-- @+-- Colors {..} <- 'getColorsLogger' -- for example+-- pure $ "This text will be " <> red "red" <> "."+-- @ module Blammo.Logging.Colors-  ( Colors(..)+  ( Colors (..)+  , noColors   , getColors+  , getColorsLogger+  , getColorsHandle+  , getColorsStdout+  , getColorsStderr   ) where  import Prelude +import Blammo.Logging.Internal.Logger+import Blammo.Logging.LogSettings (shouldColorHandle)+import Control.Lens (to, view)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Reader (MonadReader) import Data.Text (Text)+import System.IO (Handle, stderr, stdout)  data Colors = Colors   { gray :: Text -> Text@@ -21,37 +40,72 @@   }  colors :: Colors-colors = Colors-  { gray = esc "0;37"-  , cyan = esc "0;36"-  , magenta = esc "0;35"-  , blue = esc "0;34"-  , yellow = esc "0;33"-  , green = esc "0;32"-  , red = esc "0;31"-  , black = esc "0;30"-  , bold = esc "1"-  , dim = esc "2"-  }+colors =+  Colors+    { gray = esc "0;37"+    , cyan = esc "0;36"+    , magenta = esc "0;35"+    , blue = esc "0;34"+    , yellow = esc "0;33"+    , green = esc "0;32"+    , red = esc "0;31"+    , black = esc "0;30"+    , bold = esc "1"+    , dim = esc "2"+    }  where   esc :: Text -> Text -> Text   esc code x = "\ESC[" <> code <> "m" <> x <> "\ESC[0m"  noColors :: Colors-noColors = Colors-  { gray = id-  , black = id-  , cyan = id-  , magenta = id-  , blue = id-  , yellow = id-  , green = id-  , red = id-  , bold = id-  , dim = id-  }+noColors =+  Colors+    { gray = id+    , black = id+    , cyan = id+    , magenta = id+    , blue = id+    , yellow = id+    , green = id+    , red = id+    , bold = id+    , dim = id+    }  getColors :: Bool -> Colors getColors = \case   True -> colors   False -> noColors++-- | Return 'Colors' consistent with whatever your logging is doing+getColorsLogger :: (MonadReader env m, HasLogger env) => m Colors+getColorsLogger = view $ loggerL . to (getColors . lShouldColor)++-- | Return 'Colors' consistent with logging, but for 'Handle'+--+-- This is useful if you are building text to print to a handle that is not the+-- one you are logging to.+--+-- For example, say you are using,+--+-- @+-- LOG_COLOR=auto+-- LOG_DESTINATION=@some-file.log+-- @+--+-- That will not log with color, so 'getColorsLogger' will be 'noColor'. If+-- you're building other text to be printed out, you probably want to respect+-- that @LOG_COLOR=auto@, so you would use this function instead.+getColorsHandle+  :: (MonadIO m, MonadReader env m, HasLogger env) => Handle -> m Colors+getColorsHandle h = do+  ls <- view $ loggerL . to lLogSettings+  getColors <$> shouldColorHandle ls h++-- | Short-cut for @'getColorsHandle' 'stdout'@+getColorsStdout :: (MonadIO m, MonadReader env m, HasLogger env) => m Colors+getColorsStdout = getColorsHandle stdout++-- | Short-cut for @'getColorsHandle' 'stderr'@+getColorsStderr :: (MonadIO m, MonadReader env m, HasLogger env) => m Colors+getColorsStderr = getColorsHandle stderr

@@ -0,0 +1,28 @@+module Blammo.Logging.Internal.Logger+  ( Logger (..)+  , HasLogger (..)+  ) where++import Prelude++import Blammo.Logging.LogSettings+import Blammo.Logging.Test hiding (getLoggedMessages)+import Control.Lens (Lens')+import Control.Monad.Logger.Aeson+import Data.ByteString (ByteString)+import System.Log.FastLogger (LoggerSet)++data Logger = Logger+  { lLogSettings :: LogSettings+  , lLoggerSet :: LoggerSet+  , lReformat :: LogLevel -> ByteString -> ByteString+  , lShouldLog :: LogSource -> LogLevel -> Bool+  , lShouldColor :: Bool+  , lLoggedMessages :: Maybe LoggedMessages+  }++class HasLogger env where+  loggerL :: Lens' env Logger++instance HasLogger Logger where+  loggerL = id

@@ -1,20 +1,20 @@ module Blammo.Logging.LogSettings   ( LogSettings   , LogLevels-  , LogDestination(..)-  , LogFormat(..)-  , LogColor(..)+  , LogDestination (..)+  , LogFormat (..)+  , LogColor (..) -  -- * Reading settings, e.g. from @ENV@+    -- * Reading settings, e.g. from @ENV@   , readLogLevels   , readLogDestination   , readLogFormat   , readLogColor -  -- * Construction+    -- * Construction   , defaultLogSettings -  -- * Modify+    -- * Modify   , setLogSettingsLevels   , setLogSettingsDestination   , setLogSettingsFormat@@ -22,7 +22,7 @@   , setLogSettingsBreakpoint   , setLogSettingsConcurrency -  -- * Access+    -- * Access   , getLogSettingsLevels   , getLogSettingsDestination   , getLogSettingsFormat@@ -30,7 +30,7 @@   , getLogSettingsBreakpoint   , getLogSettingsConcurrency -  -- * Logic+    -- * Logic   , shouldLogLevel   , shouldColorAuto   , shouldColorHandle@@ -40,7 +40,7 @@  import Blammo.Logging.LogSettings.LogLevels (LogLevels) import qualified Blammo.Logging.LogSettings.LogLevels as LogLevels-import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Logger.Aeson import System.IO (Handle, hIsTerminalDevice) @@ -57,9 +57,9 @@ readLogLevels = LogLevels.readLogLevels  data LogDestination-    = LogDestinationStdout-    | LogDestinationStderr-    | LogDestinationFile FilePath+  = LogDestinationStdout+  | LogDestinationStderr+  | LogDestinationFile FilePath  readLogDestination :: String -> Either String LogDestination readLogDestination = \case@@ -67,14 +67,14 @@   "stderr" -> Right LogDestinationStderr   ('@' : path) -> Right $ LogDestinationFile path   x ->-    Left-      $ "Invalid log destination "-      <> x-      <> ", must be stdout, stderr, or @{path}"+    Left $+      "Invalid log destination "+        <> x+        <> ", must be stdout, stderr, or @{path}"  data LogFormat-    = LogFormatJSON-    | LogFormatTerminal+  = LogFormatJSON+  | LogFormatTerminal  readLogFormat :: String -> Either String LogFormat readLogFormat = \case@@ -83,20 +83,20 @@   x -> Left $ "Invalid log format " <> x <> ", must be tty or json"  data LogColor-    = LogColorAuto-    | LogColorAlways-    | LogColorNever+  = LogColorAuto+  | LogColorAlways+  | LogColorNever  readLogColor :: String -> Either String LogColor readLogColor x-  | x `elem` autoValues-  = Right LogColorAuto-  | x `elem` alwaysValues-  = Right LogColorAlways-  | x `elem` neverValues-  = Right LogColorNever-  | otherwise-  = Left $ "Invalid log color " <> x <> ", must be auto, always, or never"+  | x `elem` autoValues =+      Right LogColorAuto+  | x `elem` alwaysValues =+      Right LogColorAlways+  | x `elem` neverValues =+      Right LogColorNever+  | otherwise =+      Left $ "Invalid log color " <> x <> ", must be auto, always, or never"  where   autoValues :: [String]   autoValues = ["auto"]@@ -108,29 +108,30 @@   neverValues = ["never", "off", "no", "false"]  defaultLogSettings :: LogSettings-defaultLogSettings = LogSettings-  { lsLevels = LogLevels.defaultLogLevels-  , lsDestination = LogDestinationStdout-  , lsFormat = LogFormatTerminal-  , lsColor = LogColorAuto-  , lsBreakpoint = 120-  , lsConcurrency = Nothing-  }+defaultLogSettings =+  LogSettings+    { lsLevels = LogLevels.defaultLogLevels+    , lsDestination = LogDestinationStdout+    , lsFormat = LogFormatTerminal+    , lsColor = LogColorAuto+    , lsBreakpoint = 120+    , lsConcurrency = Nothing+    }  setLogSettingsLevels :: LogLevels -> LogSettings -> LogSettings-setLogSettingsLevels x ls = ls { lsLevels = x }+setLogSettingsLevels x ls = ls {lsLevels = x}  setLogSettingsDestination :: LogDestination -> LogSettings -> LogSettings-setLogSettingsDestination x ls = ls { lsDestination = x }+setLogSettingsDestination x ls = ls {lsDestination = x}  setLogSettingsFormat :: LogFormat -> LogSettings -> LogSettings-setLogSettingsFormat x ls = ls { lsFormat = x }+setLogSettingsFormat x ls = ls {lsFormat = x}  setLogSettingsColor :: LogColor -> LogSettings -> LogSettings-setLogSettingsColor x ls = ls { lsColor = x }+setLogSettingsColor x ls = ls {lsColor = x}  setLogSettingsBreakpoint :: Int -> LogSettings -> LogSettings-setLogSettingsBreakpoint x ls = ls { lsBreakpoint = x }+setLogSettingsBreakpoint x ls = ls {lsBreakpoint = x}  -- | Set the number of 'LoggerSet' Buffers used by @fast-logger@ --@@ -151,9 +152,8 @@ -- +-----------------------------+------------+ -- |  <3.0.5     | anywhere      | no         | -- +-----------------------------+------------+--- setLogSettingsConcurrency :: Maybe Int -> LogSettings -> LogSettings-setLogSettingsConcurrency x ls = ls { lsConcurrency = x }+setLogSettingsConcurrency x ls = ls {lsConcurrency = x}  getLogSettingsLevels :: LogSettings -> LogLevels getLogSettingsLevels = lsLevels

@@ -25,21 +25,18 @@ --   logger <- 'newLogger' =<< Env.'parse' --   'runLoggerLoggingT' logger $ -- ... -- @--- module Blammo.Logging.LogSettings.Env   ( parse   , parser--  -- | Specifying defaults other than 'defaultLogSettings'-  ---  -- For example, if you want logging to go to @stderr@ by default, but still-  -- support @LOG_DESTINATION@,-  ---  -- @-  -- settings <- Env.'parseWith'-  --   $ 'setLogSettingsDestination' 'LogDestinationStderr' 'defaultLogSettings'-  -- @-  --+    -- | Specifying defaults other than 'defaultLogSettings'+    --+    -- For example, if you want logging to go to @stderr@ by default, but still+    -- support @LOG_DESTINATION@,+    --+    -- @+    -- settings <- Env.'parseWith'+    --   $ 'setLogSettingsDestination' 'LogDestinationStderr' 'defaultLogSettings'+    -- @   , parseWith   , parserWith   ) where@@ -48,7 +45,7 @@  import Blammo.Logging.LogSettings import Data.Bifunctor (first)-import Data.Semigroup (Endo(..))+import Data.Semigroup (Endo (..)) import Env hiding (parse) import qualified Env import Text.Read (readEither)@@ -65,14 +62,16 @@ -- brittany-next-binding --columns 100  parserWith :: LogSettings -> Parser Error LogSettings-parserWith defaults = ($ defaults) . appEndo . mconcat <$> sequenceA-  [ var (endo readLogLevels setLogSettingsLevels) "LOG_LEVEL" (def mempty)-  , 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)-  , var (endo readEither (setLogSettingsConcurrency . Just)) "LOG_CONCURRENCY" (def mempty)-  ]+parserWith defaults =+  ($ defaults) . appEndo . mconcat+    <$> sequenceA+      [ var (endo readLogLevels setLogSettingsLevels) "LOG_LEVEL" (def mempty)+      , 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)+      , var (endo readEither (setLogSettingsConcurrency . Just)) "LOG_CONCURRENCY" (def mempty)+      ]  endo   :: AsUnread e

@@ -46,10 +46,9 @@ -- Where @<level>@ defines the minimum level for anything not overridden by -- source. If you go on to add any @<source:level>@ pairs, that will change the -- minimum level for messages from that source.--- module Blammo.Logging.LogSettings.LogLevels   ( LogLevels-  , LogLevel(..)+  , LogLevel (..)   , newLogLevels   , readLogLevels   , showLogLevels@@ -74,10 +73,11 @@   deriving stock (Eq, Show)  newLogLevels :: LogLevel -> [(LogSource, LogLevel)] -> LogLevels-newLogLevels level sourceLevels = LogLevels-  { llDefaultLevel = level-  , llSourceLevels = Map.fromList sourceLevels-  }+newLogLevels level sourceLevels =+  LogLevels+    { llDefaultLevel = level+    , llSourceLevels = Map.fromList sourceLevels+    }  readLogLevels :: String -> Either String LogLevels readLogLevels s = toLogLevels . partitionEithers =<< traverse readPiece pieces@@ -107,9 +107,12 @@  showLogLevels :: LogLevels -> String showLogLevels LogLevels {..} =-  unpack $ T.intercalate "," $ showLogLevel llDefaultLevel : map-    (\(s, l) -> s <> ":" <> showLogLevel l)-    (Map.toList llSourceLevels)+  unpack $+    T.intercalate "," $+      showLogLevel llDefaultLevel+        : map+          (\(s, l) -> s <> ":" <> showLogLevel l)+          (Map.toList llSourceLevels)  showLogLevel :: LogLevel -> Text showLogLevel = \case@@ -121,18 +124,18 @@  shouldLogLevel :: LogLevels -> LogSource -> LogLevel -> Bool shouldLogLevel LogLevels {..} source = (`lgte` minLevel)-  where minLevel = fromMaybe llDefaultLevel $ Map.lookup source llSourceLevels+ where+  minLevel = fromMaybe llDefaultLevel $ Map.lookup source llSourceLevels  defaultLogLevels :: LogLevels defaultLogLevels =-  LogLevels { llDefaultLevel = LevelInfo, llSourceLevels = Map.empty }+  LogLevels {llDefaultLevel = LevelInfo, llSourceLevels = Map.empty}  -- | Like '(>=)', but treats @'LevelOther' "trace"@ as below 'LevelDebug' -- -- Normally, 'LevelOther' is the highest level, but it's common to use the -- @trace@ level as more verbose than @debug@. With this comparison in use, we -- can safely use @'LevelOther' "trace"@ for that.--- lgte :: LogLevel -> LogLevel -> Bool lgte _ (LevelOther x) | T.toLower x == "trace" = True lgte (LevelOther x) _ | T.toLower x == "trace" = False

@@ -1,6 +1,6 @@ module Blammo.Logging.Logger   ( Logger-  , HasLogger(..)+  , HasLogger (..)   , newLogger   , flushLogger   , pushLogger@@ -12,9 +12,9 @@   , pushLogStrLn   , flushLogStr -  -- * Testing+    -- * Testing   , newTestLogger-  , LoggedMessage(..)+  , LoggedMessage (..)   , getLoggedMessages   , getLoggedMessagesLenient   , getLoggedMessagesUnsafe@@ -22,13 +22,14 @@  import Prelude +import Blammo.Logging.Internal.Logger import Blammo.Logging.LogSettings import Blammo.Logging.Terminal import Blammo.Logging.Test hiding (getLoggedMessages) import qualified Blammo.Logging.Test as LoggedMessages-import Control.Lens (Lens', view)+import Control.Lens (view) import Control.Monad (unless)-import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Logger.Aeson import Control.Monad.Reader (MonadReader) import Data.ByteString (ByteString)@@ -37,22 +38,19 @@ import Data.Text (Text) import GHC.Stack (HasCallStack) import System.IO (stderr, stdout)-import qualified System.Log.FastLogger as FastLogger-  (flushLogStr, pushLogStr, pushLogStrLn) import System.Log.FastLogger (LoggerSet, defaultBufSize)+import qualified System.Log.FastLogger as FastLogger+  ( flushLogStr+  , pushLogStr+  , pushLogStrLn+  ) import System.Log.FastLogger.Compat-  (newFileLoggerSetN, newStderrLoggerSetN, newStdoutLoggerSetN)+  ( newFileLoggerSetN+  , newStderrLoggerSetN+  , newStdoutLoggerSetN+  ) import UnliftIO.Exception (throwString) -data Logger = Logger-  { lLogSettings :: LogSettings-  , lLoggerSet :: LoggerSet-  , lReformat :: LogLevel -> ByteString -> ByteString-  , lShouldLog :: LogSource -> LogLevel -> Bool-  , lShouldColor :: Bool-  , lLoggedMessages :: Maybe LoggedMessages-  }- getLoggerLogSettings :: Logger -> LogSettings getLoggerLogSettings = lLogSettings @@ -72,25 +70,22 @@ pushLogStr logger str = case lLoggedMessages logger of   Nothing -> liftIO $ FastLogger.pushLogStr loggerSet str   Just lm -> appendLogStr lm str-  where loggerSet = getLoggerLoggerSet logger+ where+  loggerSet = getLoggerLoggerSet logger  pushLogStrLn :: MonadIO m => Logger -> LogStr -> m () pushLogStrLn logger str = case lLoggedMessages logger of   Nothing -> liftIO $ FastLogger.pushLogStrLn loggerSet str   Just lm -> appendLogStrLn lm str-  where loggerSet = getLoggerLoggerSet logger+ where+  loggerSet = getLoggerLoggerSet logger  flushLogStr :: MonadIO m => Logger -> m () flushLogStr logger = case lLoggedMessages logger of   Nothing -> liftIO $ FastLogger.flushLogStr loggerSet   Just _ -> pure ()-  where loggerSet = getLoggerLoggerSet logger--class HasLogger env where-    loggerL :: Lens' env Logger--instance HasLogger Logger where-  loggerL = id+ where+  loggerSet = getLoggerLoggerSet logger  newLogger :: MonadIO m => LogSettings -> m Logger newLogger settings = do@@ -118,7 +113,7 @@     lLoggedMessages = Nothing     lLogSettings = settings -  pure $ Logger { .. }+  pure $ Logger {..}  where   breakpoint = getLogSettingsBreakpoint settings   concurrency = getLogSettingsConcurrency settings@@ -141,17 +136,15 @@ -- | Create a 'Logger' that will capture log messages instead of logging them -- -- See "Blammo.Logging.LoggedMessages" for more details.--- newTestLogger :: MonadIO m => LogSettings -> m Logger newTestLogger settings = go <$> newLogger settings <*> newLoggedMessages  where   go logger loggedMessages =-    logger { lReformat = const id, lLoggedMessages = Just loggedMessages }+    logger {lReformat = const id, lLoggedMessages = Just loggedMessages}  -- | Return the logged messages if 'newTestLogger' was used -- -- If not, the empty list is returned.--- getLoggedMessages   :: (MonadIO m, MonadReader env m, HasLogger env)   => m [Either String LoggedMessage]@@ -171,10 +164,11 @@ getLoggedMessagesUnsafe = do   (failed, succeeded) <- partitionEithers <$> getLoggedMessages -  succeeded <$ unless-    (null failed)-    (throwString-    $ intercalate "\n"-    $ "Messages were logged that didn't parse as LoggedMessage:"-    : failed-    )+  succeeded+    <$ unless+      (null failed)+      ( throwString $+          intercalate "\n" $+            "Messages were logged that didn't parse as LoggedMessage:"+              : failed+      )

@@ -9,7 +9,7 @@  import Blammo.Logging import qualified Blammo.Logging.LogSettings.Env as Env-import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.IO.Unlift (MonadUnliftIO)  -- | Construct a 'Logger' configured via environment variables

@@ -13,7 +13,6 @@ -- This format was designed to match Python's -- [structlog](https://www.structlog.org/en/stable/) package in its default -- configuration.--- module Blammo.Logging.Terminal   ( reformatTerminal   ) where@@ -44,10 +43,13 @@   let     colors@Colors {..} = getColors useColor -    logTimestampPiece = logPiece dim $ pack $ formatTime-      defaultTimeLocale-      "%F %X"-      loggedMessageTimestamp+    logTimestampPiece =+      logPiece dim $+        pack $+          formatTime+            defaultTimeLocale+            "%F %X"+            loggedMessageTimestamp      logLevelPiece = case logLevel of       LevelDebug -> logPiece gray $ padTo 9 "debug"@@ -64,29 +66,28 @@      logMessagePiece = logPiece bold $ padTo 31 loggedMessageText -    logAttrsPiece = mconcat-      [ colorizeKeyMap " " colors loggedSourceAsMap-      , colorizeKeyMap " " colors loggedMessageThreadContext-      , colorizeKeyMap " " colors loggedMessageMeta-      ]+    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-          ]+      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+  pure $+    LogPiece.bytestring $+      if LogPiece.visibleLength oneLineLogPiece <= breakpoint         then oneLineLogPiece         else multiLineLogPiece 

@@ -5,15 +5,15 @@   , visibleLength   , bytestring -  -- * Built-in pieces+    -- * Built-in pieces   , offset   ) where  import Prelude  import Data.ByteString (ByteString)-import Data.Semigroup (Sum(..))-import Data.String (IsString(..))+import Data.Semigroup (Sum (..))+import Data.String (IsString (..)) import Data.Text (Text, pack) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8)@@ -22,15 +22,17 @@   { lpRendered :: Text   , lpVisibleLength :: Sum Int   }-  -- TODO: When we drop support for ghc-8.6:-  -- deriving stock Generic-  -- deriving (Semigroup, Monoid) via (GenericSemigroupMonoid LogPiece) +-- 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-    }+  a <> b =+    LogPiece+      { lpRendered = lpRendered a <> lpRendered b+      , lpVisibleLength = lpVisibleLength a <> lpVisibleLength b+      }  instance Monoid LogPiece where   mempty = LogPiece mempty mempty@@ -45,7 +47,7 @@   -- ^ Raw   -> LogPiece logPiece f t =-  LogPiece { lpRendered = f t, lpVisibleLength = Sum $ T.length t }+  LogPiece {lpRendered = f t, lpVisibleLength = Sum $ T.length t}  render :: LogPiece -> Text render = lpRendered@@ -57,4 +59,4 @@ visibleLength = getSum . lpVisibleLength  offset :: Int -> LogPiece-offset n = LogPiece { lpRendered = T.replicate n " ", lpVisibleLength = Sum n }+offset n = LogPiece {lpRendered = T.replicate n " ", lpVisibleLength = Sum n}

@@ -2,7 +2,7 @@  module Blammo.Logging.Test   ( LoggedMessages-  , LoggedMessage(..)+  , LoggedMessage (..)   , newLoggedMessages   , appendLogStr   , appendLogStrLn@@ -11,8 +11,8 @@  import Prelude -import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Logger.Aeson (LoggedMessage(..))+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Logger.Aeson (LoggedMessage (..)) import Data.Aeson (eitherDecodeStrict) import Data.DList (DList) import qualified Data.DList as DList

@@ -4,7 +4,7 @@   , requestLogger   , requestLoggerWith -  -- * Configuration+    -- * Configuration   , Config   , defaultConfig   , setConfigLogSource@@ -30,7 +30,7 @@ import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Network.HTTP.Types.Header (Header, HeaderName)-import Network.HTTP.Types.Status (Status(..))+import Network.HTTP.Types.Status (Status (..)) import Network.Wai   ( Middleware   , Request@@ -86,7 +86,6 @@ --   } -- } -- @--- requestLogger :: HasLogger env => env -> Middleware requestLogger = requestLoggerWith defaultConfig @@ -97,15 +96,17 @@   }  defaultConfig :: Config-defaultConfig = Config-  { cLogSource = "requestLogger"-  , cGetClientIp = \req ->-    fromMaybe (pack $ show $ remoteHost req)-      $ (firstValue =<< lookupRequestHeader "x-forwarded-for" req)-      <|> lookupRequestHeader "x-real-ip" req-  , cGetDestinationIp = lookupRequestHeader "x-real-ip"-  }-  where firstValue = find (not . T.null) . map T.strip . T.splitOn ","+defaultConfig =+  Config+    { cLogSource = "requestLogger"+    , cGetClientIp = \req ->+        fromMaybe (pack $ show $ remoteHost req) $+          (firstValue =<< lookupRequestHeader "x-forwarded-for" req)+            <|> lookupRequestHeader "x-real-ip" req+    , cGetDestinationIp = lookupRequestHeader "x-real-ip"+    }+ where+  firstValue = find (not . T.null) . map T.strip . T.splitOn ","  lookupRequestHeader :: HeaderName -> Request -> Maybe Text lookupRequestHeader h = fmap decodeUtf8 . lookup h . requestHeaders@@ -113,17 +114,15 @@ -- | Change the source used for log messages -- -- Default is @requestLogger@.--- setConfigLogSource :: LogSource -> Config -> Config-setConfigLogSource x c = c { cLogSource = x }+setConfigLogSource x c = c {cLogSource = x}  -- | Change how the @clientIp@ field is determined -- -- Default is looking up the first value in @x-forwarded-for@, then the -- @x-real-ip@ header, then finally falling back to 'Network.Wai.remoteHost'.--- setConfigGetClientIp :: (Request -> Text) -> Config -> Config-setConfigGetClientIp x c = c { cGetClientIp = x }+setConfigGetClientIp x c = c {cGetClientIp = x}  -- | Change how the @destinationIp@ field is determined --@@ -135,9 +134,8 @@ -- containerized Warp on AWS/ECS, where this value holds the ECS target -- container's IP address. This is valuable debugging information and could, if -- you squint, be considered a /destination/.--- setConfigGetDestinationIp :: (Request -> Maybe Text) -> Config -> Config-setConfigGetDestinationIp x c = c { cGetDestinationIp = x }+setConfigGetDestinationIp x c = c {cGetDestinationIp = x}  requestLoggerWith :: HasLogger env => Config -> env -> Middleware requestLoggerWith config env app req respond =@@ -172,15 +170,16 @@     [ "method" .= decodeUtf8 (requestMethod req)     , "path" .= decodeUtf8 (rawPathInfo req)     , "query" .= decodeUtf8 (rawQueryString req)-    , "status" .= object-      [ "code" .= statusCode status-      , "message" .= decodeUtf8 (statusMessage status)-      ]+    , "status"+        .= object+          [ "code" .= statusCode status+          , "message" .= decodeUtf8 (statusMessage status)+          ]     , "clientIp" .= cGetClientIp req     , "destinationIp" .= cGetDestinationIp req     , "durationMs" .= duration     , "requestHeaders"-      .= headerObject ["authorization", "cookie"] (requestHeaders req)+        .= headerObject ["authorization", "cookie"] (requestHeaders req)     , "responseHeaders" .= headerObject ["set-cookie"] (responseHeaders resp)     ] 

@@ -61,9 +61,8 @@       shouldLogLevel ll2 "bar" LevelInfo `shouldBe` False      it "can override multiple sources" $ do-      let-        ll =-          newLogLevels LevelDebug [("Amazonka", LevelWarn), ("SQL", LevelInfo)]+      let ll =+            newLogLevels LevelDebug [("Amazonka", LevelWarn), ("SQL", LevelInfo)]        shouldLogLevel ll "app" LevelDebug `shouldBe` True       shouldLogLevel ll "Amazonka" LevelInfo `shouldBe` False

@@ -9,7 +9,7 @@ import Blammo.Logging import Blammo.Logging.Logger import Control.Monad.Reader (runReaderT)-import Data.Aeson (Value(..))+import Data.Aeson (Value (..)) import qualified Data.Aeson.Compat as KeyMap import Data.Text (Text) import Test.Hspec

@@ -7,7 +7,7 @@ import Prelude  import Blammo.Logging-import Blammo.Logging.Logger (LoggedMessage(..))+import Blammo.Logging.Logger (LoggedMessage (..)) import Blammo.Logging.Terminal import Data.Aeson import Data.ByteString (ByteString)@@ -34,59 +34,71 @@      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]]-          }+        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]"-          ]+        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)-            ]-          }+        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"-          ]+        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"-          ]+        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 @@ -95,32 +107,38 @@    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)-          ]-        }+      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"-        ]+      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