Blammo 2.1.2.0 → 2.1.3.0

raw patch · 9 files changed

+141/−81 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Blammo.cabal +2/−1
• CHANGELOG.md +5/−1
• src/Blammo/Logging/Colors.hs +6/−55
• src/Blammo/Logging/Internal/Colors.hs +66/−0
• src/Blammo/Logging/LogSettings.hs +14/−2
• src/Blammo/Logging/LogSettings/Env.hs +22/−0
• src/Blammo/Logging/LogSettings/LogLevels.hs +6/−6
• src/Blammo/Logging/Logger.hs +12/−8
• src/Blammo/Logging/Terminal.hs +8/−8

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

@@ -1,4 +1,8 @@-## [_Unreleased_](https://github.com/freckle/blammo/compare/Blammo-v2.1.2.0...main)+## [_Unreleased_](https://github.com/freckle/blammo/compare/Blammo-v2.1.3.0...main)++## [v2.1.3.0](https://github.com/freckle/blammo/compare/v2.1.2.0...Blammo-v2.1.3.0)++- Add `setLogSettingsColors` to support customizing colors  ## [v2.1.2.0](https://github.com/freckle/blammo/compare/v2.1.1.0...Blammo-v2.1.2.0) 

@@ -18,68 +18,19 @@  import Prelude +import Blammo.Logging.Internal.Colors import Blammo.Logging.Internal.Logger-import Blammo.Logging.LogSettings (shouldColorHandle)+import Blammo.Logging.LogSettings (adjustColors, 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-  , black :: Text -> Text-  , cyan :: Text -> Text-  , magenta :: Text -> Text-  , blue :: Text -> Text-  , yellow :: Text -> Text-  , green :: Text -> Text-  , red :: Text -> Text-  , bold :: Text -> Text-  , dim :: Text -> Text-  }--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"-    }- 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-    }--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)+getColorsLogger = do+  f <- view $ loggerL . to (adjustColors . lLogSettings)+  view $ loggerL . to (f . getColors . lShouldColor)  -- | Return 'Colors' consistent with logging, but for 'Handle' --@@ -100,7 +51,7 @@   :: (MonadIO m, MonadReader env m, HasLogger env) => Handle -> m Colors getColorsHandle h = do   ls <- view $ loggerL . to lLogSettings-  getColors <$> shouldColorHandle ls h+  adjustColors ls . getColors <$> shouldColorHandle ls h  -- | Short-cut for @'getColorsHandle' 'stdout'@ getColorsStdout :: (MonadIO m, MonadReader env m, HasLogger env) => m Colors

@@ -0,0 +1,66 @@+module Blammo.Logging.Internal.Colors+  ( Colors (..)+  , colors+  , noColors+  , getColors+  ) where++import Prelude++import Data.Text (Text)++data Colors = Colors+  { gray :: Text -> Text+  , black :: Text -> Text+  , cyan :: Text -> Text+  , magenta :: Text -> Text+  , blue :: Text -> Text+  , yellow :: Text -> Text+  , green :: Text -> Text+  , red :: Text -> Text+  , bold :: Text -> Text+  , dim :: Text -> Text+  }++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"+    }+ 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+    }++-- | Return colorful 'Colors' if given 'True'+--+-- __NOTE__: Direct use of this function is discouraged. It does not apply any+-- color modifications done through 'LogSettings'. Use one of the @get@+-- functions in "Blammo.Logging.Colors" instead, which do.+getColors :: Bool -> Colors+getColors = \case+  True -> colors+  False -> noColors

@@ -19,6 +19,7 @@   , setLogSettingsDestination   , setLogSettingsFormat   , setLogSettingsColor+  , setLogSettingsColors   , setLogSettingsBreakpoint   , setLogSettingsConcurrency @@ -31,6 +32,7 @@   , getLogSettingsConcurrency      -- * Logic+  , adjustColors   , shouldLogLevel   , shouldColorAuto   , shouldColorHandle@@ -38,6 +40,7 @@  import Prelude +import Blammo.Logging.Internal.Colors (Colors) import Blammo.Logging.LogSettings.LogLevels (LogLevels) import qualified Blammo.Logging.LogSettings.LogLevels as LogLevels import Control.Monad.IO.Class (MonadIO (..))@@ -50,6 +53,7 @@   , lsDestination :: LogDestination   , lsFormat :: LogFormat   , lsColor :: LogColor+  , lsColors :: Colors -> Colors   , lsBreakpoint :: Int   , lsConcurrency :: Maybe Int   }@@ -69,8 +73,8 @@   "null" -> Right $ LogDestinationFile nullDevice   ('@' : path) -> Right $ LogDestinationFile path   x ->-    Left $-      "Invalid log destination "+    Left+      $ "Invalid log destination "         <> x         <> ", must be stdout, stderr, null, or @{path}" @@ -117,6 +121,7 @@     , lsDestination = LogDestinationStdout     , lsFormat = LogFormatTerminal     , lsColor = LogColorAuto+    , lsColors = id     , lsBreakpoint = 120     , lsConcurrency = Just 1     }@@ -168,6 +173,10 @@ setLogSettingsConcurrency :: Maybe Int -> LogSettings -> LogSettings setLogSettingsConcurrency x ls = ls {lsConcurrency = x} +-- | Set a function to modify 'Colors' used in logging+setLogSettingsColors :: (Colors -> Colors) -> LogSettings -> LogSettings+setLogSettingsColors f ls = ls {lsColors = f}+ getLogSettingsLevels :: LogSettings -> LogLevels getLogSettingsLevels = lsLevels @@ -185,6 +194,9 @@  getLogSettingsConcurrency :: LogSettings -> Maybe Int getLogSettingsConcurrency = lsConcurrency++adjustColors :: LogSettings -> Colors -> Colors+adjustColors = lsColors  shouldLogLevel :: LogSettings -> LogSource -> LogLevel -> Bool shouldLogLevel = LogLevels.shouldLogLevel . getLogSettingsLevels

@@ -25,6 +25,9 @@ -- -- - @TERM@: if present and the value @dumb@, behave as if @LOG_COLOR=never@. --+-- - @GITHUB_ACTIONS@: if present and the value @true@, adjust some colors for+--   better behavior on GitHub Actions.+-- -- This module is meant to be imported @qualified@. -- -- @@@ -54,6 +57,7 @@  import Prelude +import Blammo.Logging.Colors (Colors (..)) import Blammo.Logging.LogSettings import Data.Bifunctor (first) import Data.Bool (bool)@@ -84,6 +88,7 @@       , endoVar readLogFormat setLogSettingsFormat "LOG_FORMAT"       , endoSwitch (setLogSettingsColor LogColorNever) "NO_COLOR"       , endoOn "dumb" (setLogSettingsColor LogColorNever) "TERM"+      , endoOn "true" (setLogSettingsColors fixGitHubActions) "GITHUB_ACTIONS"       ]  endoVar@@ -116,3 +121,20 @@   -> Bool   -> Endo a endoWhen f = bool mempty (Endo f)++-- |+--+-- GitHub Actions doesn't support 'dim' (such content just appears white). But+-- if you use 'gray', it looks like 'dim' should. But one shouldn't just use+-- 'gray' all the time because that won't look right /not/ in GitHub Actions.+--+-- We can help by automatically substituting 'gray' for 'dim', only in the+-- GitHub Actions environment. We take on this extra complexity because:+--+-- 1. It's trivial and zero dependency+-- 2. It's lower complexity overall to do here, vs from the outside+-- 3. GitHub Actions is a very common logging environment, and+-- 4. I suspect we'll encounter more cases where GitHub Actions can be improved+--    though such means, increasing its usefulness+fixGitHubActions :: Colors -> Colors+fixGitHubActions colors = colors {dim = gray colors}

@@ -107,12 +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

@@ -77,9 +77,9 @@   -> msg   -> m () runLogAction logger loc source level msg =-  liftIO $-    when (lShouldLog logger source level) $-      defaultOutputWith options loc source level (toLogStr msg)+  liftIO+    $ when (lShouldLog logger source level)+    $ defaultOutputWith options loc source level (toLogStr msg)  where   options = defaultOutputOptions $ \logLevel bytes ->     pushLogStrLn logger $ toLogStr $ getLoggerReformat logger logLevel bytes@@ -101,7 +101,11 @@   logger     { lReformat = \level bytes -> fromMaybe bytes $ do         lm <- Aeson.decodeStrict bytes-        pure $ f (lLogSettings logger) (getColors $ lShouldColor logger) level lm+        let colors =+              adjustColors (lLogSettings logger)+                $ getColors+                $ lShouldColor logger+        pure $ f (lLogSettings logger) colors level lm     }  getLoggerShouldLog :: Logger -> LogSource -> LogLevel -> Bool@@ -213,8 +217,8 @@   succeeded     <$ unless       (null failed)-      ( throwString $-          intercalate "\n" $-            "Messages were logged that didn't parse as LoggedMessage:"-              : failed+      ( throwString+          $ intercalate "\n"+          $ "Messages were logged that didn't parse as LoggedMessage:"+            : failed       )

@@ -39,20 +39,20 @@ reformatTerminal   :: LogSettings -> Colors -> LogLevel -> LoggedMessage -> ByteString reformatTerminal settings colors@Colors {..} logLevel LoggedMessage {..} = do-  LogPiece.bytestring $-    if LogPiece.visibleLength oneLineLogPiece <= breakpoint+  LogPiece.bytestring+    $ if LogPiece.visibleLength oneLineLogPiece <= breakpoint       then oneLineLogPiece       else multiLineLogPiece  where   breakpoint = getLogSettingsBreakpoint settings    logTimestampPiece =-    logPiece dim $-      pack $-        formatTime-          defaultTimeLocale-          "%F %X"-          loggedMessageTimestamp+    logPiece dim+      $ pack+      $ formatTime+        defaultTimeLocale+        "%F %X"+        loggedMessageTimestamp    logLevelPiece = case logLevel of     LevelDebug -> logPiece gray $ padTo 9 "debug"