packages feed

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 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 - [![Hackage](https://img.shields.io/hackage/v/Blammo.svg?style=flat)](https://hackage.haskell.org/package/Blammo) [![Stackage Nightly](http://stackage.org/package/Blammo/badge/nightly)](http://stackage.org/nightly/package/Blammo) [![Stackage LTS](http://stackage.org/package/Blammo/badge/lts)](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 - [![Hackage](https://img.shields.io/hackage/v/Blammo.svg?style=flat)](https://hackage.haskell.org/package/Blammo) [![Stackage Nightly](http://stackage.org/package/Blammo/badge/nightly)](http://stackage.org/nightly/package/Blammo) [![Stackage LTS](http://stackage.org/package/Blammo/badge/lts)](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