log-base 0.7.4.0 → 0.8.0.0

raw patch · 5 files changed

+63/−30 lines, 5 filesdep +unliftio-coredep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: unliftio-core

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• log-base.cabal +4/−2
• src/Log/Class.hs +5/−0
• src/Log/Logger.hs +15/−2
• src/Log/Monad.hs +36/−26

@@ -1,3 +1,6 @@+# log-base-0.8.0.0 (2019-04-09)+* Add `getLoggerEnv` function to `MonadLog` class, add `getLoggerIO` utility.+ # log-base-0.7.4.0 (2017-10-27) * Add `mkBulkLogger'` ([#40](https://github.com/scrive/log/pull/40). 

@@ -1,5 +1,5 @@ name:                log-base-version:             0.7.4.0+version:             0.8.0.0 synopsis:            Structured logging solution (base package)  description:         A library that provides a way to record structured log@@ -21,7 +21,8 @@ build-type:          Simple cabal-version:       >=1.10 extra-source-files:  CHANGELOG.md, README.md-tested-with:         GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1+tested-with:         GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4,+                     GHC == 8.6.2  Source-repository head   Type:     git@@ -52,6 +53,7 @@                        text,                        time >= 1.5,                        transformers-base,+                       unliftio-core,                        unordered-containers   hs-source-dirs:      src 

@@ -23,6 +23,7 @@ import qualified Data.Text as T  import Log.Data+import Log.Logger  -- | Represents the family of monads with logging capabilities. Each -- 'MonadLog' carries with it some associated state (the logging@@ -39,6 +40,9 @@   localData   :: [Pair] -> m a -> m a   -- | Extend the current application domain locally.   localDomain :: T.Text -> m a -> m a+  -- | Get current 'LoggerEnv' object. Useful for construction of logging+  -- functions that work in a different monad, see 'getLoggerIO' as an example.+  getLoggerEnv :: m LoggerEnv  -- | Generic, overlapping instance. instance (@@ -49,6 +53,7 @@     logMessage time level message = lift . logMessage time level message     localData data_ m = controlT $ \run -> localData data_ (run m)     localDomain domain m = controlT $ \run -> localDomain domain (run m)+    getLoggerEnv = lift getLoggerEnv  controlT :: (MonadTransControl t, Monad (t m), Monad m)          => (Run t -> m (StT t a)) -> t m a

@@ -1,6 +1,7 @@ -- | The 'Logger' type of logging back-ends.-module Log.Logger (-    Logger+module Log.Logger+  ( LoggerEnv(..)+  , Logger   , mkLogger   , mkBulkLogger   , mkBulkLogger'@@ -16,12 +17,22 @@ import Control.Monad import Data.Semigroup import Prelude+import qualified Data.Aeson.Types as A import qualified Data.Text as T import qualified Data.Text.IO as T  import Log.Data import Log.Internal.Logger +-- | The state that every 'LogT' carries around.+data LoggerEnv = LoggerEnv+  { leLogger    :: !Logger   -- ^ The 'Logger' to use.+  , leComponent :: !T.Text   -- ^ Current application component.+  , leDomain    :: ![T.Text] -- ^ Current application domain.+  , leData      :: ![A.Pair] -- ^ Additional data to be merged with the log+                             -- message\'s data.+  }+ -- | Start a logger thread that consumes one queued message at a time. mkLogger :: T.Text -> (LogMessage -> IO ()) -> IO Logger mkLogger name exec = mkLoggerImpl@@ -80,6 +91,8 @@ mkBulkLogger = mkBulkLogger' sbDefaultCapacity 1000000  -- | Like 'mkBulkLogger', but with configurable queue size and thread delay.+--+-- @since 0.7.4.0 mkBulkLogger'     :: Int                      -- ^ queue capacity (default 1000000)     -> Int                      -- ^ thread delay (microseconds, default 1000000)

@@ -7,6 +7,8 @@   , LogT(..)   , runLogT   , mapLogT+  , logMessageIO+  , getLoggerIO   ) where  import Control.Applicative@@ -14,13 +16,13 @@ import Control.Monad.Base import Control.Monad.Catch import Control.Monad.Error.Class+import Control.Monad.IO.Unlift import Control.Monad.Morph (MFunctor (..)) import Control.Monad.Reader import Control.Monad.State.Class import Control.Monad.Trans.Control import Control.Monad.Writer.Class import Data.Aeson-import Data.Aeson.Types import Data.Text (Text) import Prelude import qualified Control.Exception as E@@ -30,15 +32,6 @@ import Log.Data import Log.Logger --- | The state that every 'LogT' carries around.-data LoggerEnv = LoggerEnv {-  leLogger    :: !Logger -- ^ The 'Logger' to use.-, leComponent :: !Text   -- ^ Current application component.-, leDomain    :: ![Text] -- ^ Current application domain.-, leData      :: ![Pair] -- ^ Additional data to be merged with the-                         -- log message\'s data.-}- type InnerLogT = ReaderT LoggerEnv  -- | Monad transformer that adds logging capabilities to the underlying monad.@@ -73,6 +66,30 @@ mapLogT :: (m a -> n b) -> LogT m a -> LogT n b mapLogT f = LogT . mapReaderT f . unLogT +-- | Base implementation of 'logMessage' for use with a specific+-- 'LoggerEnv'. Useful for reimplementation of 'MonadLog' instance.+logMessageIO :: LoggerEnv -> UTCTime -> LogLevel -> Text -> Value -> IO ()+logMessageIO LoggerEnv{..} time level message data_ =+  execLogger leLogger =<< E.evaluate (force lm)+  where+    lm = LogMessage+      { lmComponent = leComponent+      , lmDomain = leDomain+      , lmTime = time+      , lmLevel = level+      , lmMessage = message+      , lmData = case data_ of+          Object obj -> Object . H.union obj $ H.fromList leData+          _ | null leData -> data_+            | otherwise -> object $ ("_data", data_) : leData+      }++-- | Return an IO action that logs messages using the current 'MonadLog'+-- context. Useful for interfacing with libraries such as @aws@ or @amazonka@+-- that accept logging callbacks operating in IO.+getLoggerIO :: MonadLog m => m (UTCTime -> LogLevel -> Text -> Value -> IO ())+getLoggerIO = logMessageIO <$> getLoggerEnv+ -- | @'hoist' = 'mapLogT'@ -- -- @since 0.7.2@@ -105,26 +122,19 @@   {-# INLINE liftBaseWith #-}   {-# INLINE restoreM #-} +instance MonadUnliftIO m => MonadUnliftIO (LogT m) where+  askUnliftIO = do+    UnliftIO runInIO <- LogT askUnliftIO+    return $ UnliftIO $ runInIO . unLogT+ instance (MonadBase IO m, MonadTime m) => MonadLog (LogT m) where-  logMessage time level message data_ = LogT $ ReaderT logMsg-    where-      logMsg LoggerEnv{..} = liftBase $ do-        execLogger leLogger =<< E.evaluate (force lm)-        where-          lm = LogMessage {-            lmComponent = leComponent-          , lmDomain = leDomain-          , lmTime = time-          , lmLevel = level-          , lmMessage = message-          , lmData = case data_ of-            Object obj -> Object . H.union obj $ H.fromList leData-            _ | null leData -> data_-              | otherwise -> object $ ("_data", data_) : leData-          }+  logMessage time level message data_ = LogT . ReaderT $ \logEnv ->+    liftBase $ logMessageIO logEnv time level message data_    localData data_ =     LogT . local (\e -> e { leData = data_ ++ leData e }) . unLogT    localDomain domain =     LogT . local (\e -> e { leDomain = leDomain e ++ [domain] }) . unLogT++  getLoggerEnv = LogT ask