Rewrite Terminal formatter with Prettyprinter

Blammo/Blammo.cabal

@@ -26,8 +26,6 @@ source-repository head
 library
   exposed-modules:
       Blammo.Logging
-      Blammo.Logging.Colors
-      Blammo.Logging.Internal.Colors
       Blammo.Logging.Internal.Logger
       Blammo.Logging.Logger
       Blammo.Logging.LogSettings
@@ -36,7 +34,7 @@ library
       Blammo.Logging.Setup
       Blammo.Logging.Simple
       Blammo.Logging.Terminal
-      Blammo.Logging.Terminal.LogPiece
+      Blammo.Logging.Terminal.Doc
       Blammo.Logging.Test
       Blammo.Logging.ThreadContext
       Blammo.Logging.WithLogger
@@ -67,6 +65,8 @@ library
     , lens
     , monad-logger-aeson
     , mtl
+    , prettyprinter
+    , prettyprinter-ansi-terminal
     , text
     , time
     , unliftio
@@ -136,7 +136,6 @@ test-suite spec
       Blammo
     , aeson
     , base <5
-    , bytestring
     , envparse
     , hspec
     , mtl

Blammo/package.yaml

@@ -57,6 +57,8 @@ library:
     - lens
     - monad-logger-aeson
     - mtl
+    - prettyprinter
+    - prettyprinter-ansi-terminal
     - text
     - time
     - vector
@@ -74,7 +76,6 @@ tests:
       - Blammo
       - aeson
       - envparse
-      - bytestring
       - hspec
       - mtl
       - text

Blammo/src/Blammo/Logging/LogSettings.hs

@@ -40,9 +40,9 @@ module Blammo.Logging.LogSettings
 
 import Prelude
 
-import Blammo.Logging.Internal.Colors (Colors)
 import Blammo.Logging.LogSettings.LogLevels (LogLevels)
 import qualified Blammo.Logging.LogSettings.LogLevels as LogLevels
+import Blammo.Logging.Terminal.Doc
 import Control.Monad.IO.Class (MonadIO (..))
 import Control.Monad.Logger.Aeson
 import System.IO (Handle, hIsTerminalDevice)
@@ -53,7 +53,7 @@ data LogSettings = LogSettings
   , lsDestination :: LogDestination
   , lsFormat :: LogFormat
   , lsColor :: LogColor
-  , lsColors :: Colors -> Colors
+  , lsColors :: Ann -> AnsiStyle
   , lsBreakpoint :: Int
   , lsConcurrency :: Maybe Int
   }
@@ -121,7 +121,7 @@ defaultLogSettings =
     , lsDestination = LogDestinationStdout
     , lsFormat = LogFormatTerminal
     , lsColor = LogColorAuto
-    , lsColors = id
+    , lsColors = annToAnsi
     , lsBreakpoint = 120
     , lsConcurrency = Just 1
     }
@@ -174,7 +174,7 @@ 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 :: (Ann -> AnsiStyle) -> LogSettings -> LogSettings
 setLogSettingsColors f ls = ls {lsColors = f}
 
 getLogSettingsLevels :: LogSettings -> LogLevels
@@ -195,7 +195,7 @@ getLogSettingsBreakpoint = lsBreakpoint
 getLogSettingsConcurrency :: LogSettings -> Maybe Int
 getLogSettingsConcurrency = lsConcurrency
 
-adjustColors :: LogSettings -> Colors -> Colors
+adjustColors :: LogSettings -> Ann -> AnsiStyle
 adjustColors = lsColors
 
 shouldLogLevel :: LogSettings -> LogSource -> LogLevel -> Bool

Blammo/src/Blammo/Logging/LogSettings/Env.hs

@@ -57,8 +57,8 @@ module Blammo.Logging.LogSettings.Env
 
 import Prelude
 
-import Blammo.Logging.Colors (Colors (..))
 import Blammo.Logging.LogSettings
+import Blammo.Logging.Terminal.Doc
 import Data.Bifunctor (first)
 import Data.Bool (bool)
 import Data.Semigroup (Endo (..))
@@ -88,7 +88,7 @@ parserWith defaults =
       , endoVar readLogFormat setLogSettingsFormat "LOG_FORMAT"
       , endoSwitch (setLogSettingsColor LogColorNever) "NO_COLOR"
       , endoOn "dumb" (setLogSettingsColor LogColorNever) "TERM"
-      , endoOn "true" (setLogSettingsColors fixGitHubActions) "GITHUB_ACTIONS"
+      , endoOn "true" (setLogSettingsColors annToAnsiGHA) "GITHUB_ACTIONS"
       ]
 
 endoVar
@@ -124,17 +124,26 @@ 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.
+-- GitHub Actions doesn't support 'faint' (such content just appears white). But
+-- if you use gray (@'colorDull' 'White'@), it looks like 'faint' 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
+-- We can help by automatically substituting gray for 'faint', 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}
+--
+-- __NOTE__: for now, you can ignore all that. @prettyprinter-ansi-terminal@
+-- doesn't actually support 'faint' yet:
+--
+-- <https://github.com/quchen/prettyprinter/pull/224>
+--
+-- So our normal 'annToAnsi' is already using gray always (and it just looks
+-- bad) and this function uses it as-is for now.
+annToAnsiGHA :: Ann -> AnsiStyle
+annToAnsiGHA = annToAnsi

Blammo/src/Blammo/Logging/Logger.hs

@@ -25,10 +25,11 @@ module Blammo.Logging.Logger
 
 import Prelude
 
-import Blammo.Logging.Colors (Colors, getColors)
 import Blammo.Logging.Internal.Logger
 import Blammo.Logging.LogSettings
 import Blammo.Logging.Terminal
+import Blammo.Logging.Terminal.Doc (Ann, Doc, RenderSettings (..))
+import qualified Blammo.Logging.Terminal.Doc as Doc
 import Blammo.Logging.Test hiding (getLoggedMessages)
 import qualified Blammo.Logging.Test as LoggedMessages
 import Control.Lens (view)
@@ -42,6 +43,7 @@ import Data.Either (partitionEithers, rights)
 import Data.List (intercalate)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
 import GHC.Stack (HasCallStack)
 import System.IO (stderr, stdout)
 import System.Log.FastLogger (LoggerSet, defaultBufSize)
@@ -94,18 +96,14 @@ getLoggerReformat :: Logger -> LogLevel -> ByteString -> ByteString
 getLoggerReformat = lReformat
 
 setLoggerReformat
-  :: (LogSettings -> Colors -> LogLevel -> LoggedMessage -> ByteString)
+  :: (LogLevel -> LoggedMessage -> Doc Ann)
   -> Logger
   -> Logger
 setLoggerReformat f logger =
   logger
     { lReformat = \level bytes -> fromMaybe bytes $ do
         lm <- Aeson.decodeStrict bytes
-        let colors =
-              adjustColors (lLogSettings logger)
-                $ getColors
-                $ lShouldColor logger
-        pure $ f (lLogSettings logger) colors level lm
+        pure $ encodeUtf8 $ renderDoc logger $ f level lm
     }
 
 getLoggerShouldLog :: Logger -> LogSource -> LogLevel -> Bool
@@ -173,15 +171,15 @@ flushLogger = do
   logger <- view loggerL
   flushLogStr logger
 
-pushLogger :: (MonadIO m, MonadReader env m, HasLogger env) => Text -> m ()
-pushLogger msg = do
+pushLogger :: (MonadIO m, MonadReader env m, HasLogger env) => Doc Ann -> m ()
+pushLogger doc = do
   logger <- view loggerL
-  pushLogStr logger $ toLogStr msg
+  pushLogStr logger $ toLogStr $ renderDoc logger doc
 
-pushLoggerLn :: (MonadIO m, MonadReader env m, HasLogger env) => Text -> m ()
-pushLoggerLn msg = do
+pushLoggerLn :: (MonadIO m, MonadReader env m, HasLogger env) => Doc Ann -> m ()
+pushLoggerLn doc = do
   logger <- view loggerL
-  pushLogStrLn logger $ toLogStr msg
+  pushLogStrLn logger $ toLogStr $ renderDoc logger doc
 
 -- | Create a 'Logger' that will capture log messages instead of logging them
 --
@@ -222,3 +220,16 @@ getLoggedMessagesUnsafe = do
           $ "Messages were logged that didn't parse as LoggedMessage:"
             : failed
       )
+
+renderDoc :: Logger -> Doc Ann -> Text
+renderDoc = Doc.renderDoc . loggerRenderSettings
+
+loggerRenderSettings :: Logger -> RenderSettings
+loggerRenderSettings logger =
+  RenderSettings
+    { rsUseColor = getLoggerShouldColor logger
+    , rsPageWidth = getLogSettingsBreakpoint settings
+    , rsAnnToAnsi = adjustColors settings
+    }
+ where
+  settings = getLoggerLogSettings logger