Blammo 1.1.1.0 → 1.1.1.1

raw patch · 10 files changed

+157/−29 lines, 10 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• Blammo.cabal +2/−1
• CHANGELOG.md +8/−1
• README.lhs +15/−0
• README.md +15/−0
• src/Blammo/Logging.hs +3/−1
• src/Blammo/Logging/LogSettings.hs +30/−0
• src/Blammo/Logging/LogSettings/Env.hs +1/−0
• src/Blammo/Logging/Logger.hs +55/−26
• src/Blammo/Logging/Test.hs +4/−0
• src/System/Log/FastLogger/Compat.hs +24/−0

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            Blammo-version:         1.1.1.0+version:         1.1.1.1 license:         MIT license-file:    LICENSE maintainer:      Freckle Education@@ -32,6 +32,7 @@         Blammo.Logging.Test         Data.Aeson.Compat         Network.Wai.Middleware.Logging+        System.Log.FastLogger.Compat      hs-source-dirs:     src     other-modules:      Paths_Blammo

@@ -1,4 +1,11 @@-## [_Unreleased_](https://github.com/freckle/blammo/compare/v1.1.1.0...main)+## [_Unreleased_](https://github.com/freckle/blammo/compare/v1.1.1.1...main)++## [v1.1.1.1](https://github.com/freckle/blammo/compare/v1.1.1.0...v1.1.1.1)++- Add `getLogSettingsConcurrency`+- Add `getLoggerShouldColor`+- Add `pushLoggerStr` & `pushLoggerStrLn`+- Add `getLoggerLogSettings`  ## [v1.1.1.0](https://github.com/freckle/blammo/compare/v1.1.0.0...v1.1.1.0) 

@@ -114,6 +114,20 @@ This breakpoint can be controlled with `LOG_BREAKPOINT`. Set an unreasonably large number to disable this feature. +## 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.++For such cases, you can set `LOG_CONCURRENCY=1` to use a single buffer.++[fast-logger]: https://hackage.haskell.org/package/fast-logger+ ## Configuration  | Setting     | Setter                      | Environment variable and format           |@@ -122,6 +136,7 @@ | Destination | `setLogSettingsDestination` | `LOG_DESTINATION=stdout\|stderr\|@<path>` | | Color       | `setLogSettingsColor `      | `LOG_COLOR=auto\|always\|never`           | | Breakpoint  | `setLogSettingsBreakpoint`  | `LOG_BREAKPOINT=<number>`                 |+| Concurrency | `setLogSettingsConcurrency` | `LOG_CONCURRENCY=<number>`                |  ## Advanced Usage 

@@ -114,6 +114,20 @@ This breakpoint can be controlled with `LOG_BREAKPOINT`. Set an unreasonably large number to disable this feature. +## 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.++For such cases, you can set `LOG_CONCURRENCY=1` to use a single buffer.++[fast-logger]: https://hackage.haskell.org/package/fast-logger+ ## Configuration  | Setting     | Setter                      | Environment variable and format           |@@ -122,6 +136,7 @@ | Destination | `setLogSettingsDestination` | `LOG_DESTINATION=stdout\|stderr\|@<path>` | | Color       | `setLogSettingsColor `      | `LOG_COLOR=auto\|always\|never`           | | Breakpoint  | `setLogSettingsBreakpoint`  | `LOG_BREAKPOINT=<number>`                 |+| Concurrency | `setLogSettingsConcurrency` | `LOG_CONCURRENCY=<number>`                |  ## Advanced Usage 

@@ -9,6 +9,8 @@   , setLogSettingsDestination   , setLogSettingsFormat   , setLogSettingsColor+  , setLogSettingsBreakpoint+  , setLogSettingsConcurrency   , Logger   , HasLogger(..)   , newLogger@@ -52,8 +54,8 @@  import Prelude -import Blammo.Logging.LogSettings import Blammo.Logging.Logger+import Blammo.Logging.LogSettings import Control.Lens ((^.)) import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Unlift (MonadUnliftIO)

@@ -20,6 +20,7 @@   , setLogSettingsFormat   , setLogSettingsColor   , setLogSettingsBreakpoint+  , setLogSettingsConcurrency    -- * Access   , getLogSettingsLevels@@ -27,6 +28,7 @@   , getLogSettingsFormat   , getLogSettingsColor   , getLogSettingsBreakpoint+  , getLogSettingsConcurrency    -- * Logic   , shouldLogLevel@@ -48,6 +50,7 @@   , lsFormat :: LogFormat   , lsColor :: LogColor   , lsBreakpoint :: Int+  , lsConcurrency :: Maybe Int   }  readLogLevels :: String -> Either String LogLevels@@ -111,6 +114,7 @@   , lsFormat = LogFormatTerminal   , lsColor = LogColorAuto   , lsBreakpoint = 120+  , lsConcurrency = Nothing   }  setLogSettingsLevels :: LogLevels -> LogSettings -> LogSettings@@ -128,6 +132,29 @@ setLogSettingsBreakpoint :: Int -> LogSettings -> LogSettings setLogSettingsBreakpoint x ls = ls { lsBreakpoint = x } +-- | 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@.+--+-- Support for this option depends on your version of @fast-logger@:+--+-- +-----------------------------+------------++-- | fast-logger | Destination   | Supported? |+-- +=============+===============+============++-- | >=3.1.1     | anywhere      | yes        |+-- +-----------------------------+------------++-- | >=3.0.5     | file          | yes        |+-- +-----------------------------+------------++-- | >=3.0.5     | stdout/stderr | no         |+-- +-----------------------------+------------++-- |  <3.0.5     | anywhere      | no         |+-- +-----------------------------+------------++--+setLogSettingsConcurrency :: Maybe Int -> LogSettings -> LogSettings+setLogSettingsConcurrency x ls = ls { lsConcurrency = x }+ getLogSettingsLevels :: LogSettings -> LogLevels getLogSettingsLevels = lsLevels @@ -142,6 +169,9 @@  getLogSettingsBreakpoint :: LogSettings -> Int getLogSettingsBreakpoint = lsBreakpoint++getLogSettingsConcurrency :: LogSettings -> Maybe Int+getLogSettingsConcurrency = lsConcurrency  shouldLogLevel :: LogSettings -> LogSource -> LogLevel -> Bool shouldLogLevel = LogLevels.shouldLogLevel . getLogSettingsLevels

@@ -71,6 +71,7 @@   , 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) "LOG_CONCURRENCY" (def mempty)   ]  endo

@@ -3,8 +3,12 @@   , HasLogger(..)   , newLogger   , flushLogger+  , pushLogger+  , pushLoggerLn+  , getLoggerLogSettings   , getLoggerReformat   , getLoggerShouldLog+  , getLoggerShouldColor   , pushLogStrLn   , flushLogStr @@ -30,25 +34,28 @@ import Data.ByteString (ByteString) import Data.Either (partitionEithers, rights) import Data.List (intercalate)+import Data.Text (Text) import GHC.Stack (HasCallStack) import System.IO (stderr, stdout)-import System.Log.FastLogger-  ( LoggerSet-  , defaultBufSize-  , newFileLoggerSet-  , newStderrLoggerSet-  , newStdoutLoggerSet-  )-import qualified System.Log.FastLogger as FastLogger (flushLogStr, pushLogStrLn)+import qualified System.Log.FastLogger as FastLogger+  (flushLogStr, pushLogStr, pushLogStrLn)+import System.Log.FastLogger (LoggerSet, defaultBufSize)+import System.Log.FastLogger.Compat+  (newFileLoggerSetN, newStderrLoggerSetN, newStdoutLoggerSetN) import UnliftIO.Exception (throwString)  data Logger = Logger-  { lLoggerSet :: LoggerSet+  { lLogSettings :: LogSettings+  , lLoggerSet :: LoggerSet   , lReformat :: LogLevel -> ByteString -> ByteString   , lShouldLog :: LogSource -> LogLevel -> Bool+  , lShouldColor :: Bool   , lLoggedMessages :: Maybe LoggedMessages   } +getLoggerLogSettings :: Logger -> LogSettings+getLoggerLogSettings = lLogSettings+ getLoggerLoggerSet :: Logger -> LoggerSet getLoggerLoggerSet = lLoggerSet @@ -58,10 +65,19 @@ getLoggerShouldLog :: Logger -> LogSource -> LogLevel -> Bool getLoggerShouldLog = lShouldLog +getLoggerShouldColor :: Logger -> Bool+getLoggerShouldColor = lShouldColor++pushLogStr :: MonadIO m => Logger -> LogStr -> m ()+pushLogStr logger str = case lLoggedMessages logger of+  Nothing -> liftIO $ FastLogger.pushLogStr loggerSet str+  Just lm -> appendLogStr lm str+  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 -> appendLogStr lm str+  Just lm -> appendLogStrLn lm str   where loggerSet = getLoggerLoggerSet logger  flushLogStr :: MonadIO m => Logger -> m ()@@ -78,36 +94,49 @@  newLogger :: MonadIO m => LogSettings -> m Logger newLogger settings = do-  (lLoggerSet, useColor) <- liftIO $ case getLogSettingsDestination settings of-    LogDestinationStdout ->-      (,)-        <$> newStdoutLoggerSet defaultBufSize-        <*> shouldColorHandle settings stdout-    LogDestinationStderr ->-      (,)-        <$> newStderrLoggerSet defaultBufSize-        <*> shouldColorHandle settings stderr-    LogDestinationFile path ->-      (,) <$> newFileLoggerSet defaultBufSize path <*> shouldColorAuto-        settings-        (pure False)+  (lLoggerSet, lShouldColor) <-+    liftIO $ case getLogSettingsDestination settings of+      LogDestinationStdout ->+        (,)+          <$> newStdoutLoggerSetN defaultBufSize concurrency+          <*> shouldColorHandle settings stdout+      LogDestinationStderr ->+        (,)+          <$> newStderrLoggerSetN defaultBufSize concurrency+          <*> shouldColorHandle settings stderr+      LogDestinationFile path ->+        (,)+          <$> newFileLoggerSetN defaultBufSize concurrency path+          <*> shouldColorAuto settings (pure False)    let-    breakpoint = getLogSettingsBreakpoint settings-     lReformat = case getLogSettingsFormat settings of       LogFormatJSON -> const id -- breakpoint and color ignored-      LogFormatTerminal -> reformatTerminal breakpoint useColor+      LogFormatTerminal -> reformatTerminal breakpoint lShouldColor      lShouldLog = shouldLogLevel settings     lLoggedMessages = Nothing+    lLogSettings = settings    pure $ Logger { .. }+ where+  breakpoint = getLogSettingsBreakpoint settings+  concurrency = getLogSettingsConcurrency settings  flushLogger :: (MonadIO m, MonadReader env m, HasLogger env) => m () flushLogger = do   logger <- view loggerL   flushLogStr logger++pushLogger :: (MonadIO m, MonadReader env m, HasLogger env) => Text -> m ()+pushLogger msg = do+  logger <- view loggerL+  pushLogStr logger $ toLogStr msg++pushLoggerLn :: (MonadIO m, MonadReader env m, HasLogger env) => Text -> m ()+pushLoggerLn msg = do+  logger <- view loggerL+  pushLogStrLn logger $ toLogStr msg  -- | Create a 'Logger' that will capture log messages instead of logging them --

@@ -5,6 +5,7 @@   , LoggedMessage(..)   , newLoggedMessages   , appendLogStr+  , appendLogStrLn   , getLoggedMessages   ) where @@ -28,6 +29,9 @@ appendLogStr :: MonadIO m => LoggedMessages -> LogStr -> m () appendLogStr (LoggedMessages ref) str =   atomicModifyIORef' ref $ \x -> (DList.snoc x str, ())++appendLogStrLn :: MonadIO m => LoggedMessages -> LogStr -> m ()+appendLogStrLn lm = appendLogStr lm . (<> "\n")  getLoggedMessages :: MonadIO m => LoggedMessages -> m [Either String LoggedMessage] getLoggedMessages (LoggedMessages ref) =

@@ -0,0 +1,24 @@+{-# LANGUAGE CPP #-}++module System.Log.FastLogger.Compat+  ( newFileLoggerSetN+  , newStdoutLoggerSetN+  , newStderrLoggerSetN+  ) where++import System.Log.FastLogger++#if !MIN_VERSION_fast_logger(3, 1, 1)+import Prelude++newStdoutLoggerSetN :: BufSize -> Maybe Int -> IO LoggerSet+newStdoutLoggerSetN size _ = newStdoutLoggerSet size++newStderrLoggerSetN :: BufSize -> Maybe Int -> IO LoggerSet+newStderrLoggerSetN size _ = newStderrLoggerSet size++#if !MIN_VERSION_fast_logger(3, 0, 5)+newFileLoggerSetN :: BufSize -> Maybe Int -> FilePath -> IO LoggerSet+newFileLoggerSetN size _ = newFileLoggerSet size+#endif+#endif