Blammo 1.1.3.0 → 1.2.0.0

raw patch · 8 files changed

+170/−116 lines, 8 filesdep −monad-loggerdep ~basedep ~clockdep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies removed: monad-logger

Dependency ranges changed: base, clock, containers, dlist, exceptions, http-types, lens, unliftio, vector, wai

API changes (from Hackage documentation)

Files

• Blammo.cabal +24/−20
• CHANGELOG.md +9/−1
• README.lhs +32/−34
• README.md +32/−34
• src/Blammo/Logging.hs +12/−22
• src/Blammo/Logging/Logger.hs +31/−2
• src/Blammo/Logging/WithLogger.hs +28/−0
• src/Network/Wai/Middleware/Logging.hs +2/−3

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            Blammo-version:         1.1.3.0+version:         1.2.0.0 license:         MIT license-file:    LICENSE maintainer:      Freckle Education@@ -31,6 +31,7 @@         Blammo.Logging.Terminal         Blammo.Logging.Terminal.LogPiece         Blammo.Logging.Test+        Blammo.Logging.WithLogger         Data.Aeson.Compat         Network.Wai.Middleware.Logging         System.Log.FastLogger.Compat@@ -39,8 +40,9 @@     other-modules:      Paths_Blammo     default-language:   Haskell2010     default-extensions:-        DerivingStrategies LambdaCase NoImplicitPrelude OverloadedStrings-        RecordWildCards TypeApplications+        DerivingStrategies GeneralizedNewtypeDeriving LambdaCase+        NoImplicitPrelude OverloadedStrings RecordWildCards+        TypeApplications      ghc-options:         -Weverything -Wno-all-missed-specialisations@@ -50,26 +52,26 @@      build-depends:         aeson >=1.5.2.0,-        base >=4.11.1.0 && <5,+        base >=4.12.0.0 && <5,         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,+        clock >=0.8,+        containers >=0.6.0.1,+        dlist >=0.8.0.7,         envparse >=0.5.0,-        exceptions >=0.10.0,+        exceptions >=0.10.4,         fast-logger >=3.2.3,-        http-types >=0.12.2,-        lens >=4.16.1,+        http-types >=0.12.3,+        lens >=4.17.1,         monad-logger-aeson >=0.4.0.3,         mtl >=2.2.2,         text >=1.2.3.1,         time >=1.8.0.2,-        unliftio >=0.2.9.0,+        unliftio >=0.2.12,         unliftio-core >=0.1.2.0,         unordered-containers >=0.2.10.0,-        vector >=0.12.0.2,-        wai >=3.2.1.2+        vector >=0.12.1.2,+        wai >=3.2.2.1      if impl(ghc >=9.8)         ghc-options: -Wno-missing-role-annotations@@ -87,8 +89,9 @@     other-modules:      Paths_Blammo     default-language:   Haskell2010     default-extensions:-        DerivingStrategies LambdaCase NoImplicitPrelude OverloadedStrings-        RecordWildCards TypeApplications+        DerivingStrategies GeneralizedNewtypeDeriving LambdaCase+        NoImplicitPrelude OverloadedStrings RecordWildCards+        TypeApplications      ghc-options:         -Weverything -Wno-all-missed-specialisations@@ -99,9 +102,9 @@     build-depends:         Blammo,         aeson >=1.5.2.0,-        base >=4.11.1.0 && <5,+        base >=4.12.0.0 && <5,+        lens >=4.17.1,         markdown-unlit >=0.5.0,-        monad-logger >=0.3.39,         mtl >=2.2.2,         text >=1.2.3.1 @@ -128,8 +131,9 @@      default-language:   Haskell2010     default-extensions:-        DerivingStrategies LambdaCase NoImplicitPrelude OverloadedStrings-        RecordWildCards TypeApplications+        DerivingStrategies GeneralizedNewtypeDeriving LambdaCase+        NoImplicitPrelude OverloadedStrings RecordWildCards+        TypeApplications      ghc-options:         -Weverything -Wno-all-missed-specialisations@@ -140,7 +144,7 @@     build-depends:         Blammo,         aeson >=1.5.2.0,-        base >=4.11.1.0 && <5,+        base >=4.12.0.0 && <5,         bytestring >=0.10.8.2,         envparse >=0.5.0,         hspec >=2.7.9,

@@ -1,4 +1,12 @@-## [_Unreleased_](https://github.com/freckle/blammo/compare/v1.1.3.0...main)+## [_Unreleased_](https://github.com/freckle/blammo/compare/v1.2.0.0...main)++## [v1.2.0.0](https://github.com/freckle/blammo/compare/v1.1.3.0...v1.2.0.0)++- New in `Blammo.Logging`: `withLogger`, `WithLogger(..), runWithLogger`+- New in `Blammo.Logging.Logger`: `runLogAction`+- WAI middleware no longer performs a log flush. Wrap your entire application+  in either `withLoggerLoggingT` or `withLogger` to ensure a log flush at+  application shutdown.  ## [v1.1.3.0](https://github.com/freckle/blammo/compare/v1.1.2.3...v1.1.3.0) 

@@ -26,8 +26,7 @@ ```haskell {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DerivingVia #-}  module Main (module Main) where @@ -37,9 +36,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))+import Control.Lens (lens)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Reader (MonadReader, ReaderT (runReaderT)) ``` --> @@ -142,7 +141,7 @@ ## Configuration  | 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>` |@@ -199,14 +198,17 @@  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`:+can derive `MonadLogger` via `WithLogger`:  ```haskell data AppEnv = AppEnv-  { appLogFunc :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()+  { appLogger :: Logger   -- ...   } +instance HasLogger AppEnv where+  loggerL = lens appLogger $ \x y -> x {appLogger = y}+ newtype App a = App   { unApp :: ReaderT AppEnv IO a }   deriving newtype@@ -216,11 +218,8 @@     , MonadIO     , MonadReader AppEnv     )--instance MonadLogger App where-  monadLoggerLog loc logSource logLevel msg = do-    logFunc <- asks appLogFunc-    liftIO $ logFunc loc logSource logLevel (toLogStr msg)+  deriving (MonadLogger, MonadLoggerIO)+    via (WithLogger AppEnv IO)  runApp :: AppEnv -> App a -> IO a runApp env action =@@ -237,20 +236,18 @@   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:+Initialize the app with `withLogger`.  ```haskell main2 :: IO ()-main2 = do-  logFunc <- runSimpleLoggingT askLoggerIO-  let appEnv =-        AppEnv-          { appLogFunc = logFunc-          -- ...-          }-  runApp appEnv app+main2 =+  withLogger defaultLogSettings $ \logger -> do+    let appEnv =+          AppEnv+            { appLogger = logger+            -- ...+            }+    runApp appEnv app ```  ## Integration with RIO@@ -299,11 +296,11 @@ instance HasLogger App where   -- ... -runApp :: ReaderT App (LoggingT IO) a -> IO a-runApp f = do-  logger <- newLogger defaultLogSettings-  app <- App logger <$> runLoggerLoggingT logger awsDiscover-  runLoggerLoggingT app $ runReaderT f app+runApp :: MonadUnliftIO m => ReaderT App m a -> m a+runApp f =+  withLogger defaultLogSettings $ \logger -> do+    aws <- runWithLogger logger awsDiscover+    runReaderT f $ App logger aws  awsDiscover :: (MonadIO m, MonadLoggerIO m) => m AWS.Env awsDiscover = do@@ -342,6 +339,8 @@ ## Integration with Warp  ```hs+import qualified Network.Wai.Handler.Warp as Warp+ instance HasLogger App where   -- ... @@ -349,11 +348,10 @@ warpSettings app = setOnException onEx $ defaultSettings  where   onEx _req ex =-    when (defaultShouldDisplayException ex)-      $ runLoggerLoggingT app+    when (Warp.defaultShouldDisplayException ex)+      $ runWithLogger app       $ logError-      $ "Warp exception"-      :# ["exception" .= displayException ex]+      $ "Warp exception" :# ["exception" .= displayException ex] ```  ## Integration with Yesod@@ -366,7 +364,7 @@   -- ...    messageLoggerSource app _logger loc source level msg =-    runLoggerLoggingT app $ monadLoggerLog loc source level msg+    runWithLogger app $ monadLoggerLog loc source level msg ```  ---

@@ -26,8 +26,7 @@ ```haskell {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DerivingVia #-}  module Main (module Main) where @@ -37,9 +36,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))+import Control.Lens (lens)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Reader (MonadReader, ReaderT (runReaderT)) ``` --> @@ -142,7 +141,7 @@ ## Configuration  | 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>` |@@ -199,14 +198,17 @@  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`:+can derive `MonadLogger` via `WithLogger`:  ```haskell data AppEnv = AppEnv-  { appLogFunc :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()+  { appLogger :: Logger   -- ...   } +instance HasLogger AppEnv where+  loggerL = lens appLogger $ \x y -> x {appLogger = y}+ newtype App a = App   { unApp :: ReaderT AppEnv IO a }   deriving newtype@@ -216,11 +218,8 @@     , MonadIO     , MonadReader AppEnv     )--instance MonadLogger App where-  monadLoggerLog loc logSource logLevel msg = do-    logFunc <- asks appLogFunc-    liftIO $ logFunc loc logSource logLevel (toLogStr msg)+  deriving (MonadLogger, MonadLoggerIO)+    via (WithLogger AppEnv IO)  runApp :: AppEnv -> App a -> IO a runApp env action =@@ -237,20 +236,18 @@   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:+Initialize the app with `withLogger`.  ```haskell main2 :: IO ()-main2 = do-  logFunc <- runSimpleLoggingT askLoggerIO-  let appEnv =-        AppEnv-          { appLogFunc = logFunc-          -- ...-          }-  runApp appEnv app+main2 =+  withLogger defaultLogSettings $ \logger -> do+    let appEnv =+          AppEnv+            { appLogger = logger+            -- ...+            }+    runApp appEnv app ```  ## Integration with RIO@@ -299,11 +296,11 @@ instance HasLogger App where   -- ... -runApp :: ReaderT App (LoggingT IO) a -> IO a-runApp f = do-  logger <- newLogger defaultLogSettings-  app <- App logger <$> runLoggerLoggingT logger awsDiscover-  runLoggerLoggingT app $ runReaderT f app+runApp :: MonadUnliftIO m => ReaderT App m a -> m a+runApp f =+  withLogger defaultLogSettings $ \logger -> do+    aws <- runWithLogger logger awsDiscover+    runReaderT f $ App logger aws  awsDiscover :: (MonadIO m, MonadLoggerIO m) => m AWS.Env awsDiscover = do@@ -342,6 +339,8 @@ ## Integration with Warp  ```hs+import qualified Network.Wai.Handler.Warp as Warp+ instance HasLogger App where   -- ... @@ -349,11 +348,10 @@ warpSettings app = setOnException onEx $ defaultSettings  where   onEx _req ex =-    when (defaultShouldDisplayException ex)-      $ runLoggerLoggingT app+    when (Warp.defaultShouldDisplayException ex)+      $ runWithLogger app       $ logError-      $ "Warp exception"-      :# ["exception" .= displayException ex]+      $ "Warp exception" :# ["exception" .= displayException ex] ```  ## Integration with Yesod@@ -366,7 +364,7 @@   -- ...    messageLoggerSource app _logger loc source level msg =-    runLoggerLoggingT app $ monadLoggerLog loc source level msg+    runWithLogger app $ monadLoggerLog loc source level msg ```  ---

@@ -13,6 +13,7 @@   , setLogSettingsConcurrency   , Logger   , HasLogger (..)+  , withLogger   , newLogger   , runLoggerLoggingT @@ -29,10 +30,12 @@   , myThreadContext   , Pair -    -- ** Transformer+    -- ** Transformers   , MonadLogger (..)   , MonadLoggerIO (..)   , LoggingT+  , WithLogger (..)+  , runWithLogger      -- ** Common logging functions @@ -54,36 +57,23 @@   , logOtherNS   ) where -import Prelude- import Blammo.Logging.LogSettings import Blammo.Logging.Logger-import Control.Lens ((^.))+import Blammo.Logging.WithLogger+import Control.Lens (view) import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Unlift (MonadUnliftIO) import Control.Monad.Logger.Aeson import Data.Aeson (Series) import Data.Aeson.Types (Pair)-import Data.ByteString (ByteString) import UnliftIO.Exception (finally) +-- | Initialize logging, pass a 'Logger' to the callback, and clean up at the end.+--+-- Applications should avoid calling this more than once in their lifecycle. runLoggerLoggingT   :: (MonadUnliftIO m, HasLogger env) => env -> LoggingT m a -> m a-runLoggerLoggingT env f = (`finally` flushLogStr logger) $ do-  runLoggingT-    (filterLogger (getLoggerShouldLog logger) f)-    (loggerOutput logger $ getLoggerReformat logger)+runLoggerLoggingT env f =+  runLoggingT f (runLogAction logger) `finally` flushLogStr logger  where-  logger = env ^. loggerL--loggerOutput-  :: Logger-  -> (LogLevel -> ByteString -> ByteString)-  -> Loc-  -> LogSource-  -> LogLevel-  -> LogStr-  -> IO ()-loggerOutput logger reformat =-  defaultOutputWith $ defaultOutputOptions $ \logLevel bytes -> do-    pushLogStrLn logger $ toLogStr $ reformat logLevel bytes+  logger = view loggerL env

@@ -1,6 +1,7 @@ module Blammo.Logging.Logger   ( Logger   , HasLogger (..)+  , withLogger   , newLogger   , flushLogger   , pushLogger@@ -11,6 +12,7 @@   , getLoggerShouldColor   , pushLogStrLn   , flushLogStr+  , runLogAction      -- * Testing   , newTestLogger@@ -28,7 +30,7 @@ import Blammo.Logging.Test hiding (getLoggedMessages) import qualified Blammo.Logging.Test as LoggedMessages import Control.Lens (view)-import Control.Monad (unless)+import Control.Monad (unless, when) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Logger.Aeson import Control.Monad.Reader (MonadReader)@@ -49,7 +51,34 @@   , newStderrLoggerSetN   , newStdoutLoggerSetN   )-import UnliftIO.Exception (throwString)+import UnliftIO (MonadUnliftIO)+import UnliftIO.Exception (finally, throwString)++-- | Initialize logging, pass a 'Logger' to the callback, and clean up at the end.+--+-- Applications should avoid calling this more than once in their lifecycle.+withLogger :: MonadUnliftIO m => LogSettings -> (Logger -> m a) -> m a+withLogger settings f = do+  logger <- newLogger settings+  f logger `finally` flushLogStr logger++-- | Write a message to the 'Logger', unless the logger's filter options+--   reject it based on its 'LogSource' and 'LogLevel'+runLogAction+  :: (MonadIO m, ToLogStr msg)+  => Logger+  -> Loc+  -> LogSource+  -> LogLevel+  -> msg+  -> m ()+runLogAction logger loc source level 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  getLoggerLogSettings :: Logger -> LogSettings getLoggerLogSettings = lLogSettings

@@ -0,0 +1,28 @@+module Blammo.Logging.WithLogger (WithLogger (..), runWithLogger) where++import Prelude++import Blammo.Logging.Logger (HasLogger (..), runLogAction)+import Control.Lens (view)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Logger.Aeson (MonadLogger (..), MonadLoggerIO (..))+import Control.Monad.Reader (MonadReader, ReaderT (ReaderT), asks)++-- | Useful with the @DerivingVia@ language extension to derive+--   'MonadLogger' for your application monad+newtype WithLogger env m a = WithLogger (ReaderT env m a)+  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader env)++runWithLogger :: env -> WithLogger env m a -> m a+runWithLogger env (WithLogger (ReaderT f)) = f env++instance (MonadIO m, HasLogger env) => MonadLogger (WithLogger env m) where+  monadLoggerLog loc source level msg = do+    logger <- asks (view loggerL)+    runLogAction logger loc source level msg++instance (MonadIO m, HasLogger env) => MonadLoggerIO (WithLogger env m) where+  askLoggerIO = do+    logger <- asks (view loggerL)+    pure $ \loc source level msg ->+      liftIO $ runLogAction logger loc source level msg

@@ -139,15 +139,14 @@  requestLoggerWith :: HasLogger env => Config -> env -> Middleware requestLoggerWith config env app req respond =-  runLoggerLoggingT env $ withRunInIO $ \runInIO -> do+  withRunInIO $ \runInIO -> do     begin <- getTime     app req $ \resp -> do       recvd <- respond resp       duration <- toMillis . subtract begin <$> getTime-      recvd <$ runInIO (logResponse config duration req resp)+      recvd <$ runInIO (runWithLogger env $ logResponse config duration req resp)  where   getTime = Clock.getTime Clock.Monotonic-   toMillis x = fromIntegral (Clock.toNanoSecs x) / nsPerMs  logResponse :: MonadLogger m => Config -> Double -> Request -> Response -> m ()