Blammo 1.1.2.1 → 1.1.2.2
raw patch · 7 files changed
+358/−60 lines, 7 filesdep +monad-loggerdep ~aesondep ~bytestringdep ~case-insensitivePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: monad-logger
Dependency ranges changed: aeson, bytestring, case-insensitive, clock, containers, dlist, envparse, exceptions, fast-logger, hspec, http-types, lens, markdown-unlit, monad-logger-aeson, mtl, text, time, unliftio, unliftio-core, unordered-containers, vector, wai
API changes (from Hackage documentation)
+ Blammo.Logging.LogSettings: instance GHC.Classes.Eq Blammo.Logging.LogSettings.LogColor
+ Blammo.Logging.LogSettings: instance GHC.Show.Show Blammo.Logging.LogSettings.LogColor
- Blammo.Logging: (.=) :: (KeyValue kv, ToJSON v) => Key -> v -> kv
+ Blammo.Logging: (.=) :: (KeyValue e kv, ToJSON v) => Key -> v -> kv
- Blammo.Logging: data LogLevel
+ Blammo.Logging: data () => LogLevel
- Blammo.Logging: data LoggingT (m :: Type -> Type) a
+ Blammo.Logging: data () => LoggingT (m :: Type -> Type) a
- Blammo.Logging: data Message
+ Blammo.Logging: data () => Message
- Blammo.Logging: data Series
+ Blammo.Logging: data () => Series
- Blammo.Logging.LogSettings.LogLevels: data LogLevel
+ Blammo.Logging.LogSettings.LogLevels: data () => LogLevel
- Blammo.Logging.Logger: data LoggedMessage
+ Blammo.Logging.Logger: data () => LoggedMessage
- Blammo.Logging.Test: data LoggedMessage
+ Blammo.Logging.Test: data () => LoggedMessage
- Data.Aeson.Compat: data Key
+ Data.Aeson.Compat: data () => Key
- Data.Aeson.Compat: data KeyMap v
+ Data.Aeson.Compat: data () => KeyMap v
Files
- Blammo.cabal +43/−30
- CHANGELOG.md +10/−1
- README.lhs +72/−8
- README.md +72/−8
- src/Blammo/Logging/LogSettings.hs +16/−5
- src/Blammo/Logging/LogSettings/Env.hs +43/−8
- tests/Blammo/Logging/LogSettings/EnvSpec.hs +102/−0
Blammo.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: Blammo-version: 1.1.2.1+version: 1.1.2.2 license: MIT license-file: LICENSE maintainer: Freckle Education@@ -49,28 +49,31 @@ -Wno-safe -Wno-unsafe build-depends:- aeson,+ aeson >=1.5.2.0, base >=4.11.1.0 && <5,- bytestring,- case-insensitive,- clock,- containers,- dlist,- envparse,- exceptions,- fast-logger,- http-types,- lens,- monad-logger-aeson,- mtl,- text,- time,- unliftio,- unliftio-core,- unordered-containers,- vector,- wai+ bytestring >=0.10.8.2,+ case-insensitive >=1.2.0.11,+ clock >=0.7.2,+ containers >=0.5.11.0,+ dlist >=0.8.0.5,+ envparse >=0.5.0,+ exceptions >=0.10.0,+ fast-logger >=2.4.11,+ http-types >=0.12.2,+ lens >=4.16.1,+ monad-logger-aeson >=0.3.0.2,+ mtl >=2.2.2,+ text >=1.2.3.1,+ time >=1.8.0.2,+ unliftio >=0.2.9.0,+ unliftio-core >=0.1.2.0,+ unordered-containers >=0.2.10.0,+ vector >=0.12.0.2,+ wai >=3.2.1.2 + if impl(ghc >=9.8)+ ghc-options: -Wno-missing-role-annotations+ if impl(ghc >=9.2) ghc-options: -Wno-missing-kind-signatures @@ -95,11 +98,16 @@ build-depends: Blammo,- aeson,+ aeson >=1.5.2.0, base >=4.11.1.0 && <5,- markdown-unlit,- text+ markdown-unlit >=0.5.0,+ monad-logger >=0.3.30,+ mtl >=2.2.2,+ text >=1.2.3.1 + if impl(ghc >=9.8)+ ghc-options: -Wno-missing-role-annotations+ if impl(ghc >=9.2) ghc-options: -Wno-missing-kind-signatures @@ -113,6 +121,7 @@ hs-source-dirs: tests other-modules: Blammo.Logging.LoggerSpec+ Blammo.Logging.LogSettings.EnvSpec Blammo.Logging.LogSettings.LogLevelsSpec Blammo.Logging.TerminalSpec Paths_Blammo@@ -130,13 +139,17 @@ build-depends: Blammo,- aeson,+ aeson >=1.5.2.0, base >=4.11.1.0 && <5,- bytestring,- hspec,- mtl,- text,- time+ bytestring >=0.10.8.2,+ envparse >=0.5.0,+ hspec >=2.7.9,+ mtl >=2.2.2,+ text >=1.2.3.1,+ time >=1.8.0.2++ if impl(ghc >=9.8)+ ghc-options: -Wno-missing-role-annotations if impl(ghc >=9.2) ghc-options: -Wno-missing-kind-signatures
CHANGELOG.md view
@@ -1,4 +1,13 @@-## [_Unreleased_](https://github.com/freckle/blammo/compare/v1.1.2.1...main)+## [_Unreleased_](https://github.com/freckle/blammo/compare/v1.1.2.2...main)++## [v1.1.2.2](https://github.com/freckle/blammo/compare/v1.1.2.1...v1.1.2.2)++- Don't automatically colorize if `TERM=dumb` is found in ENV+- Respect [`NO_COLOR`](http://no-color.org/)+- Automatically adjust log concurrency based on `LOG_FORMAT`:++ Disable concurrency for `tty` (making that the new default) and enable it for+ `json`. Setting `LOG_CONCURRENCY` will still be respected. ## [v1.1.2.1](https://github.com/freckle/blammo/compare/v1.1.2.0...v1.1.2.1)
README.lhs view
@@ -1,6 +1,5 @@ # Blammo - [](https://hackage.haskell.org/package/Blammo) [](http://stackage.org/nightly/package/Blammo) [](http://stackage.org/lts/package/Blammo)@@ -28,6 +27,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Main (module Main) where @@ -37,6 +37,9 @@ import Data.Text (Text) import GHC.Generics (Generic) import Text.Markdown.Unlit ()+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.Logger (Loc, LogStr, ToLogStr (toLogStr))+import Control.Monad.Reader (asks, MonadReader, ReaderT (runReaderT)) ``` --> @@ -123,14 +126,16 @@ ## Out of Order Messages Blammo is built on [fast-logger], which offers concurrent logging through-multiple buffers. By default, it uses {number-of-processors} buffers. This-concurrent logging is fast, but may deliver messages out of order. You want this-on production: your aggregator should be inspecting the message's time-stamp to-re-order as necessary on the other side. However, this can be problematic in a-CLI, where there is both little need for such high performance and a lower-tolerance for the confusion of out of order messages.+multiple buffers. This concurrent logging is fast, but may deliver messages out+of order. You want this on production: your aggregator should be inspecting the+message's time-stamp to re-order as necessary on the other side. However, this+can be problematic in a CLI, where there is both little need for such high+performance and a lower tolerance for the confusion of out of order messages. -For such cases, you can set `LOG_CONCURRENCY=1` to use a single buffer.+For this reason, the default behavior is to _not_ use concurrent logging, but+setting the format to `json` will automatically enable it (with+{number-of-cores} as the value). To handle this explicitly, set+`LOG_CONCURRENCY`. [fast-logger]: https://hackage.haskell.org/package/fast-logger @@ -138,6 +143,7 @@ | Setting | Setter | Environment variable and format | | --- | --- | --- |+| Format | `setLogSettingsFormat` | `LOG_FORMAT=tty\|json` | | Level(s) | `setLogSettingsLevels` | `LOG_LEVEL=<level>[,<source:level>,...]` | | Destination | `setLogSettingsDestination` | `LOG_DESTINATION=stdout\|stderr\|@<path>` | | Color | `setLogSettingsColor ` | `LOG_COLOR=auto\|always\|never` |@@ -187,6 +193,64 @@ ```hs runAppT :: App -> ReaderT App (LoggingT IO) a -> IO a runAppT app f = runLoggerLoggingT app $ runReaderT f app+```++## Use without `LoggingT`++If your app monad is not a transformer stack containing `LoggingT` (ex: the+[ReaderT pattern](https://www.fpcomplete.com/blog/readert-design-pattern/)), you+can implement a custom instance of `MonadLogger`:++```haskell+data AppEnv = AppEnv+ { appLogFunc :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()+ -- ...+ }++newtype App a = App+ { unApp :: ReaderT AppEnv IO a }+ deriving newtype+ ( Functor+ , Applicative+ , Monad+ , MonadIO+ , MonadReader AppEnv+ )++instance MonadLogger App where+ monadLoggerLog loc logSource logLevel msg = do+ logFunc <- asks appLogFunc+ liftIO $ logFunc loc logSource logLevel (toLogStr msg)++runApp :: AppEnv -> App a -> IO a+runApp env action =+ runReaderT (unApp action) env+```++In your app you can use code written against the `MonadLogger` interface, like+the actions defined earlier:++```haskell+app :: App ()+app = do+ action1+ action2+```++To retrieve the log function from Blammo, use `askLoggerIO` (from+`MonadLoggerIO`) with `runSimpleLoggingT` (or `runLoggerLoggingT` if you need+more customization options), when you initialize the app:++```haskell+main2 :: IO ()+main2 = do+ logFunc <- runSimpleLoggingT askLoggerIO+ let appEnv =+ AppEnv+ { appLogFunc = logFunc+ -- ...+ }+ runApp appEnv app ``` ## Integration with RIO
README.md view
@@ -1,6 +1,5 @@ # Blammo - [](https://hackage.haskell.org/package/Blammo) [](http://stackage.org/nightly/package/Blammo) [](http://stackage.org/lts/package/Blammo)@@ -28,6 +27,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Main (module Main) where @@ -37,6 +37,9 @@ import Data.Text (Text) import GHC.Generics (Generic) import Text.Markdown.Unlit ()+import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.Logger (Loc, LogStr, ToLogStr (toLogStr))+import Control.Monad.Reader (asks, MonadReader, ReaderT (runReaderT)) ``` --> @@ -123,14 +126,16 @@ ## Out of Order Messages Blammo is built on [fast-logger], which offers concurrent logging through-multiple buffers. By default, it uses {number-of-processors} buffers. This-concurrent logging is fast, but may deliver messages out of order. You want this-on production: your aggregator should be inspecting the message's time-stamp to-re-order as necessary on the other side. However, this can be problematic in a-CLI, where there is both little need for such high performance and a lower-tolerance for the confusion of out of order messages.+multiple buffers. This concurrent logging is fast, but may deliver messages out+of order. You want this on production: your aggregator should be inspecting the+message's time-stamp to re-order as necessary on the other side. However, this+can be problematic in a CLI, where there is both little need for such high+performance and a lower tolerance for the confusion of out of order messages. -For such cases, you can set `LOG_CONCURRENCY=1` to use a single buffer.+For this reason, the default behavior is to _not_ use concurrent logging, but+setting the format to `json` will automatically enable it (with+{number-of-cores} as the value). To handle this explicitly, set+`LOG_CONCURRENCY`. [fast-logger]: https://hackage.haskell.org/package/fast-logger @@ -138,6 +143,7 @@ | Setting | Setter | Environment variable and format | | --- | --- | --- |+| Format | `setLogSettingsFormat` | `LOG_FORMAT=tty\|json` | | Level(s) | `setLogSettingsLevels` | `LOG_LEVEL=<level>[,<source:level>,...]` | | Destination | `setLogSettingsDestination` | `LOG_DESTINATION=stdout\|stderr\|@<path>` | | Color | `setLogSettingsColor ` | `LOG_COLOR=auto\|always\|never` |@@ -187,6 +193,64 @@ ```hs runAppT :: App -> ReaderT App (LoggingT IO) a -> IO a runAppT app f = runLoggerLoggingT app $ runReaderT f app+```++## Use without `LoggingT`++If your app monad is not a transformer stack containing `LoggingT` (ex: the+[ReaderT pattern](https://www.fpcomplete.com/blog/readert-design-pattern/)), you+can implement a custom instance of `MonadLogger`:++```haskell+data AppEnv = AppEnv+ { appLogFunc :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()+ -- ...+ }++newtype App a = App+ { unApp :: ReaderT AppEnv IO a }+ deriving newtype+ ( Functor+ , Applicative+ , Monad+ , MonadIO+ , MonadReader AppEnv+ )++instance MonadLogger App where+ monadLoggerLog loc logSource logLevel msg = do+ logFunc <- asks appLogFunc+ liftIO $ logFunc loc logSource logLevel (toLogStr msg)++runApp :: AppEnv -> App a -> IO a+runApp env action =+ runReaderT (unApp action) env+```++In your app you can use code written against the `MonadLogger` interface, like+the actions defined earlier:++```haskell+app :: App ()+app = do+ action1+ action2+```++To retrieve the log function from Blammo, use `askLoggerIO` (from+`MonadLoggerIO`) with `runSimpleLoggingT` (or `runLoggerLoggingT` if you need+more customization options), when you initialize the app:++```haskell+main2 :: IO ()+main2 = do+ logFunc <- runSimpleLoggingT askLoggerIO+ let appEnv =+ AppEnv+ { appLogFunc = logFunc+ -- ...+ }+ runApp appEnv app ``` ## Integration with RIO
src/Blammo/Logging/LogSettings.hs view
@@ -86,6 +86,7 @@ = LogColorAuto | LogColorAlways | LogColorNever+ deriving stock (Eq, Show) readLogColor :: String -> Either String LogColor readLogColor x@@ -115,7 +116,7 @@ , lsFormat = LogFormatTerminal , lsColor = LogColorAuto , lsBreakpoint = 120- , lsConcurrency = Nothing+ , lsConcurrency = Just 1 } setLogSettingsLevels :: LogLevels -> LogSettings -> LogSettings@@ -125,7 +126,17 @@ setLogSettingsDestination x ls = ls {lsDestination = x} setLogSettingsFormat :: LogFormat -> LogSettings -> LogSettings-setLogSettingsFormat x ls = ls {lsFormat = x}+setLogSettingsFormat x ls = case x of+ LogFormatTerminal ->+ ls+ { lsFormat = x+ , lsConcurrency = Just 1+ }+ _ ->+ ls+ { lsFormat = x+ , lsConcurrency = Nothing+ } setLogSettingsColor :: LogColor -> LogSettings -> LogSettings setLogSettingsColor x ls = ls {lsColor = x}@@ -135,9 +146,9 @@ -- | Set the number of 'LoggerSet' Buffers used by @fast-logger@ ----- By default this matches 'getNumCapabilities', which is more performant but--- does not guarantee message order. If this matters, such as in a CLI, set this--- value to @1@.+-- A value of 'Nothing' means to use 'getNumCapabilities'. Higher is more+-- performant, but may deliver messages out of order. The defualt is set for TTY+-- usage (so, @1@), but is also changed through 'setLogSettingsFormat' is used. -- -- Support for this option depends on your version of @fast-logger@: --
src/Blammo/Logging/LogSettings/Env.hs view
@@ -14,6 +14,17 @@ -- recognized (e.g. @yes@ or @no@) but should not be relied on. Unrecognized -- values will produce an error --+-- - @LOG_BREAKPOINT@: a number representing the column-width at which to break+-- into multi-line format.+--+-- - @LOG_CONCURRENCY@: number of log buffers to use. More will perform faster+-- but result in out-of-order delivery. This is automatically disabled for+-- @LOG_FORMAT=tty@ and set to /number-of-cores/ for @LOG_FORMAT=json@.+--+-- - @NO_COLOR@: if present and non-empty, behave as if @LOG_COLOR=never@+--+-- - @TERM@: if present and the value @dumb@, behave as if @LOG_COLOR=never@.+-- -- This module is meant to be imported @qualified@. -- -- @@@ -45,7 +56,9 @@ import Blammo.Logging.LogSettings import Data.Bifunctor (first)+import Data.Bool (bool) import Data.Semigroup (Endo (..))+import Data.Text (Text) import Env hiding (parse) import qualified Env import Text.Read (readEither)@@ -59,20 +72,30 @@ parseWith :: LogSettings -> IO LogSettings parseWith = Env.parse id . parserWith --- 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)+ [ endoVar readLogLevels setLogSettingsLevels "LOG_LEVEL"+ , endoVar readLogDestination setLogSettingsDestination "LOG_DESTINATION"+ , endoVar readLogColor setLogSettingsColor "LOG_COLOR"+ , endoVar readEither setLogSettingsBreakpoint "LOG_BREAKPOINT"+ , endoVar readEither (setLogSettingsConcurrency . Just) "LOG_CONCURRENCY"+ , endoVar readLogFormat setLogSettingsFormat "LOG_FORMAT"+ , endoSwitch (setLogSettingsColor LogColorNever) "NO_COLOR"+ , endoOn "dumb" (setLogSettingsColor LogColorNever) "TERM" ] +endoVar+ :: (AsUnset e, AsUnread e)+ => (String -> Either String a)+ -- ^ How to parse the value+ -> (a -> b -> b)+ -- ^ How to turn the parsed value into a setter+ -> String+ -> Parser e (Endo b)+endoVar reader setter x = var (endo reader setter) x $ def mempty+ endo :: AsUnread e => (String -> Either String a)@@ -81,3 +104,15 @@ -- ^ How to turn the parsed value into a setter -> Reader e (Endo b) endo reader setter x = first unread $ Endo . setter <$> reader x++endoSwitch :: (a -> a) -> String -> Parser e (Endo a)+endoSwitch f x = endoWhen f <$> switch x mempty++endoOn :: AsUnset e => Text -> (a -> a) -> String -> Parser e (Endo a)+endoOn val f x = endoWhen f . (== Just val) <$> optional (var str x mempty)++endoWhen+ :: (a -> a)+ -> Bool+ -> Endo a+endoWhen f = bool mempty (Endo f)
+ tests/Blammo/Logging/LogSettings/EnvSpec.hs view
@@ -0,0 +1,102 @@+module Blammo.Logging.LogSettings.EnvSpec+ ( spec+ ) where++import Prelude++import Blammo.Logging.LogSettings+import qualified Blammo.Logging.LogSettings.Env as LogSettingsEnv+import Blammo.Logging.LogSettings.LogLevels+import Data.List (intercalate)+import qualified Env+import Test.Hspec++spec :: Spec+spec = do+ context "LOG_LEVEL" $ do+ it "reads a simple log-level" $ do+ let env = [("LOG_LEVEL", "debug")]++ settings <- parseLogSettings env+ getLogSettingsLevels settings `shouldBe` newLogLevels LevelDebug []++ context "LOG_FORMAT and LOG_CONCURRENCY" $ do+ it "Sets LOG_CONCURRENCY if format is tty" $ do+ settings <- parseLogSettings []+ settingsTTY <- parseLogSettings [("LOG_FORMAT", "tty")]++ getLogSettingsConcurrency settings `shouldBe` Just 1+ getLogSettingsConcurrency settingsTTY `shouldBe` Just 1++ it "Unsets LOG_CONCURRENCY if format is not tty" $ do+ settings <- parseLogSettings [("LOG_FORMAT", "json")]++ getLogSettingsConcurrency settings `shouldBe` Nothing++ it "Respects explicit LOG_CONCURRENCY" $ do+ settingsTTY1 <-+ parseLogSettings [("LOG_CONCURRENCY", "2"), ("LOG_FORMAT", "tty")]+ settingsTTY2 <-+ parseLogSettings [("LOG_FORMAT", "tty"), ("LOG_CONCURRENCY", "3")]+ settingsJSON1 <-+ parseLogSettings [("LOG_FORMAT", "json"), ("LOG_CONCURRENCY", "4")]+ settingsJSON2 <-+ parseLogSettings [("LOG_CONCURRENCY", "5"), ("LOG_FORMAT", "json")]++ getLogSettingsConcurrency settingsTTY1 `shouldBe` Just 2+ getLogSettingsConcurrency settingsTTY2 `shouldBe` Just 3+ getLogSettingsConcurrency settingsJSON1 `shouldBe` Just 4+ getLogSettingsConcurrency settingsJSON2 `shouldBe` Just 5++ context "NO_COLOR" $ do+ it "changes LOG_COLOR to never" $ do+ settings <- parseLogSettings []+ settingsC <- parseLogSettings [("NO_COLOR", "")]+ settingsNC <- parseLogSettings [("NO_COLOR", "x")]++ getLogSettingsColor settings `shouldBe` LogColorAuto+ getLogSettingsColor settingsC `shouldBe` LogColorAuto+ getLogSettingsColor settingsNC `shouldBe` LogColorNever++ it "respects explicit LOG_COLOR after" $ do+ settings1 <- parseLogSettings [("LOG_COLOR", "always"), ("NO_COLOR", "x")]+ settings2 <- parseLogSettings [("NO_COLOR", "x"), ("LOG_COLOR", "always")]++ getLogSettingsColor settings1 `shouldBe` LogColorAlways+ getLogSettingsColor settings2 `shouldBe` LogColorAlways++ context "TERM=dumb" $ do+ it "changes LOG_COLOR to never" $ do+ settings <- parseLogSettings []+ settingsC <- parseLogSettings [("TERM", "xterm")]+ settingsNC <- parseLogSettings [("TERM", "dumb")]++ getLogSettingsColor settings `shouldBe` LogColorAuto+ getLogSettingsColor settingsC `shouldBe` LogColorAuto+ getLogSettingsColor settingsNC `shouldBe` LogColorNever++ it "respects explicit LOG_COLOR after" $ do+ settings1 <- parseLogSettings [("LOG_COLOR", "always"), ("TERM", "dumb")]+ settings2 <- parseLogSettings [("TERM", "dumb"), ("LOG_COLOR", "always")]++ getLogSettingsColor settings1 `shouldBe` LogColorAlways+ getLogSettingsColor settings2 `shouldBe` LogColorAlways++parseLogSettings :: [(String, String)] -> IO LogSettings+parseLogSettings env = do+ case Env.parsePure LogSettingsEnv.parser env of+ Left es -> expectationFailure (failureMessage es) *> error "Unreachable"+ Right s -> pure s+ where+ failureMessage :: [(String, Env.Error)] -> String+ failureMessage =+ ("Expected parse to succeed, but there were errors:\n" <>)+ . intercalate "\n "+ . map showEnvError++ showEnvError :: (String, Env.Error) -> String+ showEnvError (name, e) =+ name <> " :" <> case e of+ Env.UnsetError -> "expected, but not set"+ Env.EmptyError -> "expected, but was empty"+ Env.UnreadError x -> "invalid: " <> show x