log-base 0.8.0.1 → 0.9.0.0

raw patch · 6 files changed

+121/−74 lines, 6 filesdep ~basedep ~unliftio-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, unliftio-core

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• log-base.cabal +4/−4
• src/Log/Backend/StandardOutput.hs +31/−26
• src/Log/Backend/StandardOutput/Bulk.hs +26/−21
• src/Log/Logger.hs +33/−17
• src/Log/Monad.hs +17/−6

@@ -1,3 +1,13 @@+# log-base-0.9.0.0 (2020-09-07)+* Always make data attached to a log message a json object+* Add unliftio-core-0.2 compatiblity+* Tidy up flushing stdout in stdout loggers+* Use `simpleStdoutLogger` in `withSimpleStdOutLogger` instead of `stdoutLogger`+* Remove deprecated functions+* Add JSON loggers+* Make `mkLogger` use bounded queue internally (similar to `mkBulkLogger`)+* Get rid of a space leak in bounded queue used in `mkBulkLogger`+ # log-base-0.8.0.1 (2020-05-08) * Update version bounds. 

@@ -1,5 +1,5 @@ name:                log-base-version:             0.8.0.1+version:             0.9.0.0 synopsis:            Structured logging solution (base package)  description:         A library that provides a way to record structured log@@ -21,7 +21,7 @@ build-type:          Simple cabal-version:       >=1.10 extra-source-files:  CHANGELOG.md, README.md-tested-with:         GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.3 || ==8.10.1+tested-with:         GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.2  Source-repository head   Type:     git@@ -52,11 +52,11 @@                        text,                        time >= 1.5,                        transformers-base,-                       unliftio-core >= 0.1.2.0 && < 0.2,+                       unliftio-core >= 0.1.2.0 && < 0.3,                        unordered-containers   hs-source-dirs:      src -  ghc-options:         -O2 -Wall -funbox-strict-fields+  ghc-options:         -Wall    default-language:   Haskell2010   default-extensions: BangPatterns

@@ -1,41 +1,46 @@ -- | Stdout logging back-end.-module Log.Backend.StandardOutput (-    simpleStdoutLogger-  , stdoutLogger-  , withSimpleStdOutLogger+module Log.Backend.StandardOutput+  ( withSimpleStdOutLogger+  , withStdOutLogger+  , withJsonStdOutLogger   ) where +import Data.Aeson import Prelude-import qualified Data.Text.IO as T import System.IO+import qualified Data.Text.IO as T+import qualified Data.ByteString.Lazy.Char8 as BSL  import Log.Data import Log.Internal.Logger import Log.Logger --- | Create a 'simpleStdoutlogger' for the duration of the given--- action, making sure that stdout is flushed afterwards.+-- | Create a simple, synchronous logger that prints messages to standard output+-- and flushes 'stdout' on each call to 'loggerWriteMessage' for the duration of+-- the given action. withSimpleStdOutLogger :: (Logger -> IO r) -> IO r-withSimpleStdOutLogger act = do-  logger <- stdoutLogger-  withLogger logger act--{-# DEPRECATED simpleStdoutLogger "Use 'withSimpleStdOutLogger'" #-}---- | Simple, synchronous logger that prints messages to standard--- output. Flushes 'stdout' on each call to 'loggerWriteMessage'. Use--- 'Log.Backend.StandardOutput.Bulk.withBulkStdOutLogger' if you want--- buffering.-simpleStdoutLogger :: Logger-simpleStdoutLogger = Logger {-    loggerWriteMessage = \msg -> (T.putStrLn . showLogMessage Nothing $ msg)-                                 >> hFlush stdout-  , loggerWaitForWrite = hFlush stdout+withSimpleStdOutLogger = withLogger $ Logger+  { loggerWriteMessage = \msg -> do+      T.putStrLn $ showLogMessage Nothing msg+      hFlush stdout+  , loggerWaitForWrite = return ()   , loggerShutdown     = return ()   } -{-# DEPRECATED stdoutLogger "Use 'withSimpleStdOutLogger'" #-}+-- | Create a logger that prints messages to standard output for the duration of+-- the given action.+withStdOutLogger :: (Logger -> IO r) -> IO r+withStdOutLogger act = do+  logger <- mkLogger "stdout" $ \msg -> do+    T.putStrLn $ showLogMessage Nothing msg+    hFlush stdout+  withLogger logger act --- | Create a logger that prints messages to standard output.-stdoutLogger :: IO Logger-stdoutLogger = mkLogger "stdout" $ T.putStrLn . showLogMessage Nothing+-- | Create a logger that prints messages in the JSON format to standard output+-- for the duration of the given action.+withJsonStdOutLogger :: (Logger -> IO r) -> IO r+withJsonStdOutLogger act = do+  logger <- mkLogger "stdout-json" $ \msg -> do+    BSL.putStrLn $ encode msg+    hFlush stdout+  withLogger logger act

@@ -1,34 +1,39 @@--- | Bulk stdout logging back-end, useful mainly for testing.-module Log.Backend.StandardOutput.Bulk (-    withBulkStdOutLogger,-    bulkStdoutLogger+-- | Bulk stdout logging back-end.+module Log.Backend.StandardOutput.Bulk+  ( withBulkStdOutLogger+  , withBulkJsonStdOutLogger   ) where +import Data.Aeson import Prelude-import qualified Data.Text.IO as T import System.IO (hFlush, stdout)+import qualified Data.Text.IO as T+import qualified Data.ByteString.Lazy.Char8 as BSL  import Log.Data import Log.Logger import Log.Internal.Logger --- | Create a 'bulkStdoutLogger' for the duration of the given action,--- and shut it down afterwards, making sure that all buffered messages--- are actually written to stdout. Flushes 'stdout' on each bulk write.+-- | Create an asynchronouis logger thread that prints messages to standard+-- output once per second for the duration of the given action. Flushes 'stdout'+-- on each bulk write. withBulkStdOutLogger :: (Logger -> IO r) -> IO r withBulkStdOutLogger act = do-  logger <- bulkStdoutLogger+  logger <- mkBulkLogger "stdout-bulk"+    (\msgs -> do+        mapM_ (T.putStrLn . showLogMessage Nothing) msgs+        hFlush stdout+    ) (return ())   withLogger logger act -{-# DEPRECATED bulkStdoutLogger "Use 'withBulkStdOutLogger' instead!" #-}---- | Start an asynchronous logger thread that prints messages to--- standard output.------ Please use 'withBulkStdOutLogger'' instead, which is more exception-safe--- (see the note attached to 'mkBulkLogger').-bulkStdoutLogger :: IO Logger-bulkStdoutLogger = mkBulkLogger "stdout-bulk"-                   (\msgs -> mapM_ (T.putStrLn . showLogMessage Nothing) msgs-                             >> hFlush stdout)-                   (hFlush stdout)+-- | Create a bulk logger that prints messages in the JSON format to standard+-- output once per second for the duration of the given action. Flushes 'stdout'+-- on each bulk write.+withBulkJsonStdOutLogger :: (Logger -> IO r) -> IO r+withBulkJsonStdOutLogger act = do+  logger <- mkBulkLogger "stdout-bulk-json"+    (\msgs -> do+        mapM_ (BSL.putStrLn . encode) msgs+        hFlush stdout+    ) (return ())+  withLogger logger act

@@ -3,6 +3,7 @@   ( LoggerEnv(..)   , Logger   , mkLogger+  , mkLogger'   , mkBulkLogger   , mkBulkLogger'   , execLogger@@ -34,20 +35,33 @@   }  -- | Start a logger thread that consumes one queued message at a time.+--+-- /Note:/ a bounded queue of size 1000000 is used internally to avoid+-- unrestricted memory consumption. mkLogger :: T.Text -> (LogMessage -> IO ()) -> IO Logger-mkLogger name exec = mkLoggerImpl-  newTQueueIO isEmptyTQueue readTQueue writeTQueue (return ())-  name exec (return ())+mkLogger = mkLogger' defaultQueueCapacity --- | Start an asynchronous logger thread that consumes all queued--- messages once per second. Uses a bounded queue internally to avoid--- space leaks. To make sure that the messages get written out in the--- presence of exceptions, use high-level wrappers like 'withLogger',+-- | Like 'mkBulkLogger', but with configurable queue size.+--+-- @since 0.9.0.0+mkLogger' :: Int -> T.Text -> (LogMessage -> IO ()) -> IO Logger+mkLogger' cap name exec = mkLoggerImpl+  (newTBQueueIO $ fromIntegral cap) isEmptyTBQueue readTBQueue writeTBQueue+  (return ()) name exec (return ())++-- | Start an asynchronous logger thread that consumes all queued messages once+-- per second.+--+-- /Note:/ a bounded queue of size 1000000 is used internally to avoid+-- unrestricted memory consumption.+--+-- To make sure that the messages get written out in the presence of exceptions,+-- use high-level wrappers like 'withLogger', -- 'Log.Backend.ElasticSearch.withElasticSearchLogger' or--- 'Log.Backend.StandardOutput.Bulk.withBulkStdOutLogger' instead of--- this function directly.+-- 'Log.Backend.StandardOutput.Bulk.withBulkStdOutLogger' instead of this+-- function directly. ----- Note: some messages can be lost when the main thread shuts down+-- /Note:/ some messages can be lost when the main thread shuts down -- without making sure that all logger threads have written out all -- messages, because in that case child threads are not given a chance -- to clean up by the RTS. This is apparently a feature:@@ -88,7 +102,7 @@ --    -- in the presence of exceptions in the child thread. -- @ mkBulkLogger :: T.Text -> ([LogMessage] -> IO ()) -> IO () -> IO Logger-mkBulkLogger = mkBulkLogger' sbDefaultCapacity 1000000+mkBulkLogger = mkBulkLogger' defaultQueueCapacity 1000000  -- | Like 'mkBulkLogger', but with configurable queue size and thread delay. --@@ -106,14 +120,15 @@  ---------------------------------------- +-- | Default capacity of log queues (TBQueue for regular logger, 'SBQueue' for+-- bulk loggers). This corresponds to approximately 200 MiB memory residency+-- when the queue is full.+defaultQueueCapacity :: Int+defaultQueueCapacity = 1000000+ -- | A simple STM based bounded queue. data SBQueue a = SBQueue !(TVar [a]) !(TVar Int) !Int --- | Default capacity of a 'SBQueue'. This corresponds to--- approximately 200 MiB memory residency when the queue is full.-sbDefaultCapacity :: Int-sbDefaultCapacity = 1000000- -- | Create an instance of 'SBQueue' with a given capacity. newSBQueueIO :: Int -> IO (SBQueue a) newSBQueueIO capacity = SBQueue <$> newTVarIO [] <*> newTVarIO 0 <*> pure capacity@@ -141,7 +156,8 @@   numElems <- readTVar count   if numElems < capacity     then do modifyTVar queue (a :)-            modifyTVar count (+1)+            -- Strict modification of the queue size to avoid space leak+            modifyTVar' count (+1)     else return ()  ----------------------------------------

@@ -80,11 +80,23 @@       , 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+          -- If lmData is not an object, we make it so and put previous data as+          -- the singleton value with key reflecting its type. It's required for+          -- ElasticSearch as ES needs fields with the same name to be of the+          -- same type in all log messages.+          Object obj      -> Object . H.union obj $ H.fromList leData+          _ | null leData -> object [dataTyped data_ .= data_]+            | otherwise   -> object $ (dataTyped data_, data_) : leData       } +    dataTyped = \case+      Object{} -> "__data_object"+      Array{}  -> "__data_array"+      String{} -> "__data_string"+      Number{} -> "__data_number"+      Bool{}   -> "__data_bool"+      Null{}   -> "__data_null"+ -- | 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.@@ -124,9 +136,8 @@   {-# INLINE restoreM #-}  instance MonadUnliftIO m => MonadUnliftIO (LogT m) where-  askUnliftIO = do-    UnliftIO runInIO <- LogT askUnliftIO-    return $ UnliftIO $ runInIO . unLogT+  withRunInIO inner = LogT $ withRunInIO $ \run -> inner (run . unLogT)+  {-# INLINE withRunInIO #-}  instance (MonadBase IO m, MonadTime m) => MonadLog (LogT m) where   logMessage time level message data_ = LogT . ReaderT $ \logEnv ->