packages feed

log-base 0.11.1.0 → 0.12.0.0

raw patch · 13 files changed

+93/−82 lines, 13 filesdep ~mmorphdep ~monad-control

Dependency ranges changed: mmorph, monad-control

Files

CHANGELOG.md view
@@ -1,3 +1,8 @@+# log-base-0.12.0.0 (2022-09-21)+* Deprecate `withSimpleStdOutLogger` as it's broken in multithreaded environments.+* Generalize logger related functions to `MonadUnliftIO`.+* Remove redundant `INLINE` pragmas.+ # log-base-0.11.1.0 (2022-04-04) * Add support for aeson 2.0.1.0. * Add support for GHC 9.2.
README.md view
@@ -1,5 +1,40 @@-# log-base [![Hackage version](https://img.shields.io/hackage/v/log-base.svg?label=Hackage)](https://hackage.haskell.org/package/log-base) [![Build Status](https://secure.travis-ci.org/scrive/log.svg?branch=master)](http://travis-ci.org/scrive/log)+# log -Base package for the `log` library suite. Includes only the standard output-back end. Use this package in conjunction with `log-elasticsearch` or-`log-postgres`, depending on which back end you need.+[![Hackage version](https://img.shields.io/hackage/v/log-base.svg?label=Hackage)](https://hackage.haskell.org/package/log-base)+[![Build Status](https://github.com/scrive/log/workflows/Haskell-CI/badge.svg?branch=master)](https://github.com/scrive/log/actions?query=branch%3Amaster)++A set of libraries that provide a way to record structured log messages with+multiple backends.++Supported backends:++* Standard output via+  [`log-base`](https://hackage.haskell.org/package/log-base).+* Elasticsearch via+  [`log-elasticsearch`](https://hackage.haskell.org/package/log-elasticsearch).+* PostgreSQL via+  [`log-postgres`](https://hackage.haskell.org/package/log-postgres).++## Example++A sample usage for logging to both standard output and Elasticsearch:++```haskell+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Log+import Log.Backend.ElasticSearch+import Log.Backend.StandardOutput++main :: IO ()+main = do+  let config = defaultElasticSearchConfig+        { esServer = "http://localhost:9200"+        , esIndex  = "logs"+        }+  withStdOutLogger $ \stdoutLogger -> do+    withElasticSearchLogger config $ \esLogger -> do+      runLogT "main" (stdoutLogger <> esLogger) defaultLogLevel $ do+        logInfo_ "Hi there"+```
log-base.cabal view
@@ -1,5 +1,5 @@ name:                log-base-version:             0.11.1.0+version:             0.12.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.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.2+tested-with:         GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.2  Source-repository head   Type:     git@@ -46,7 +46,7 @@                        deepseq,                        exceptions >=0.6,                        mmorph >=1.0.9 && <1.2,-                       monad-control >=0.3,+                       monad-control >=1.0.3,                        mtl,                        semigroups,                        stm >=2.4,@@ -66,7 +66,6 @@                     , GeneralizedNewtypeDeriving                     , LambdaCase                     , MultiParamTypeClasses-                    , NoImplicitPrelude                     , OverloadedStrings                     , RankNTypes                     , RecordWildCards
src/Log/Backend/LogList.hs view
@@ -9,8 +9,7 @@   ) where  import Control.Concurrent.MVar-import System.IO-import Prelude+import Control.Monad.IO.Unlift  import Log.Data import Log.Internal.Logger@@ -19,25 +18,27 @@   deriving Eq  -- | Create a new, empty list.-newLogList :: IO LogList-newLogList = LogList <$> newMVar []+newLogList :: MonadIO m => m LogList+newLogList = LogList <$> liftIO (newMVar [])  -- | Retrieve messages stored in the list.-getLogList :: LogList -> IO [LogMessage]-getLogList (LogList ll) = reverse <$> readMVar ll+getLogList :: MonadIO m => LogList -> m [LogMessage]+getLogList (LogList ll) = reverse <$> liftIO (readMVar ll)  -- | Put a message into the list.-putLogList :: LogList -> LogMessage -> IO ()-putLogList (LogList ll) msg = modifyMVar_ ll $ \msgs -> return $! msg : msgs+putLogList :: MonadIO m => LogList -> LogMessage -> m ()+putLogList (LogList ll) msg = liftIO . modifyMVar_ ll $ \msgs -> return $! msg : msgs  -- | Clear the list.-clearLogList :: LogList -> IO ()-clearLogList (LogList ll) = modifyMVar_ ll . const $ return []+clearLogList :: MonadIO m => LogList -> m ()+clearLogList (LogList ll) = liftIO . modifyMVar_ ll . const $ return []  -- | Creates a logger that stores messages in the given 'LogList'.-withLogListLogger :: LogList -> (Logger -> IO r) -> IO r-withLogListLogger ll = withLogger $ Logger-  { loggerWriteMessage = putLogList ll-  , loggerWaitForWrite = return ()-  , loggerShutdown     = return ()-  }+withLogListLogger :: MonadUnliftIO m => LogList -> (Logger -> m r) -> m r+withLogListLogger ll act = withRunInIO $ \unlift -> withLogger logger (unlift . act)+  where+    logger = Logger+      { loggerWriteMessage = putLogList ll+      , loggerWaitForWrite = return ()+      , loggerShutdown     = return ()+      }
src/Log/Backend/StandardOutput.hs view
@@ -5,8 +5,8 @@   , withJsonStdOutLogger   ) where +import Control.Monad.IO.Unlift import Data.Aeson-import Prelude import System.IO import qualified Data.Text.IO as T import qualified Data.ByteString.Lazy.Char8 as BSL@@ -15,32 +15,24 @@ import Log.Internal.Logger import Log.Logger --- | 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 = withLogger $ Logger-  { loggerWriteMessage = \msg -> do-      T.putStrLn $ showLogMessage Nothing msg-      hFlush stdout-  , loggerWaitForWrite = return ()-  , loggerShutdown     = return ()-  }+withSimpleStdOutLogger :: MonadUnliftIO m => (Logger -> m r) -> m r+withSimpleStdOutLogger = withStdOutLogger+{-# DEPRECATED withSimpleStdOutLogger "Use withStdOutLogger instead" #-}  -- | 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+withStdOutLogger :: MonadUnliftIO m => (Logger -> m r) -> m r+withStdOutLogger act = withRunInIO $ \unlift -> do   logger <- mkLogger "stdout" $ \msg -> do     T.putStrLn $ showLogMessage Nothing msg     hFlush stdout-  withLogger logger act+  withLogger logger (unlift . act)  -- | 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+withJsonStdOutLogger :: MonadUnliftIO m => (Logger -> m r) -> m r+withJsonStdOutLogger act = withRunInIO $ \unlift -> do   logger <- mkLogger "stdout-json" $ \msg -> do     BSL.putStrLn $ encode msg     hFlush stdout-  withLogger logger act+  withLogger logger (unlift . act)
src/Log/Backend/StandardOutput/Bulk.hs view
@@ -4,8 +4,8 @@   , withBulkJsonStdOutLogger   ) where +import Control.Monad.IO.Unlift import Data.Aeson-import Prelude import System.IO (hFlush, stdout) import qualified Data.Text.IO as T import qualified Data.ByteString.Lazy.Char8 as BSL@@ -17,23 +17,23 @@ -- | 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+withBulkStdOutLogger :: MonadUnliftIO m => (Logger -> m r) -> m r+withBulkStdOutLogger act = withRunInIO $ \unlift -> do   logger <- mkBulkLogger "stdout-bulk"     (\msgs -> do         mapM_ (T.putStrLn . showLogMessage Nothing) msgs         hFlush stdout     ) (return ())-  withLogger logger act+  withLogger logger (unlift . act)  -- | 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+withBulkJsonStdOutLogger :: MonadUnliftIO m => (Logger -> m r) -> m r+withBulkJsonStdOutLogger act = withRunInIO $ \unlift -> do   logger <- mkBulkLogger "stdout-bulk-json"     (\msgs -> do         mapM_ (BSL.putStrLn . encode) msgs         hFlush stdout     ) (return ())-  withLogger logger act+  withLogger logger (unlift . act)
src/Log/Backend/Text.hs view
@@ -2,10 +2,8 @@ -- testing. module Log.Backend.Text ( withSimpleTextLogger ) where -import Control.Applicative+import Control.Monad.IO.Unlift import Data.IORef-import Data.Monoid-import Prelude import qualified Data.Text as T import qualified Data.Text.Lazy as L import qualified Data.Text.Lazy.Builder as B@@ -16,8 +14,8 @@ -- | Create an in-memory logger for the duration of the given action, -- returning both the result of the action and the logger's output as -- a 'Text' value afterwards.-withSimpleTextLogger :: (Logger -> IO r) -> IO (T.Text, r)-withSimpleTextLogger act = do+withSimpleTextLogger :: MonadUnliftIO m => (Logger -> m r) -> m (T.Text, r)+withSimpleTextLogger act = withRunInIO $ \unlift -> do   builderRef <- newIORef mempty   let logger = Logger         { loggerWriteMessage = \msg -> do@@ -26,6 +24,6 @@         , loggerWaitForWrite = return ()         , loggerShutdown     = return ()         }-  r <- act logger+  r <- unlift $ act logger   txt <- L.toStrict . B.toLazyText <$> readIORef builderRef   return (txt, r)
src/Log/Class.hs view
@@ -15,7 +15,6 @@ import Data.Aeson import Data.Aeson.Types import Data.Time-import Prelude import qualified Data.Text as T  import Log.Data
src/Log/Data.hs view
@@ -16,7 +16,6 @@ import Data.Aeson.Types import Data.ByteString.Lazy (toStrict) import Data.Time-import Prelude import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Monoid as Monoid@@ -30,7 +29,6 @@ -- | This function is partial. readLogLevel :: T.Text -> LogLevel readLogLevel = either error id . readLogLevelEither-{-# INLINE readLogLevel #-}  readLogLevelEither :: T.Text -> Either String LogLevel readLogLevelEither "attention" = Right LogAttention
src/Log/Internal/Aeson/Compat.hs view
@@ -9,7 +9,6 @@   ) where  import Data.Text-import Prelude  #if MIN_VERSION_aeson(2,0,1) import Data.Aeson.KeyMap as Map
src/Log/Internal/Logger.hs view
@@ -8,9 +8,7 @@   , withLogger   ) where -import Data.Semigroup import Control.Exception-import Prelude  import Log.Data @@ -50,6 +48,10 @@ withLogger logger act = act logger `finally` cleanup   where     cleanup = waitForLogger logger >> shutdownLogger logger+-- Prevent GHC from inlining this function so its callers are small and+-- considered for inlining instead (as they will be generalized to MonadIO or+-- MonadUnliftIO).+{-# NOINLINE withLogger #-}  instance Semigroup Logger where   l1 <> l2 = Logger {
src/Log/Logger.hs view
@@ -11,13 +11,10 @@   , shutdownLogger   ) where -import Control.Applicative import Control.Concurrent import Control.Concurrent.STM import Control.Exception 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@@ -221,3 +218,7 @@       when (not isEmpty || isInProgress) retry      printLoggerTerminated = T.putStrLn $ name <> ": logger thread terminated"+-- Prevent GHC from inlining this function so its callers are small and+-- considered for inlining instead (as they will be generalized to MonadIO or+-- MonadUnliftIO).+{-# NOINLINE mkLoggerImpl #-}
src/Log/Monad.hs view
@@ -25,7 +25,6 @@ import Data.Aeson import Data.Text (Text) import Data.Time-import Prelude import qualified Control.Monad.Fail as MF import qualified Control.Exception as E @@ -115,34 +114,17 @@     hoist f = mapLogT f  instance MonadTransControl LogT where-#if MIN_VERSION_monad_control(1,0,0)   type StT LogT m = StT InnerLogT m   liftWith = defaultLiftWith LogT unLogT   restoreT = defaultRestoreT LogT-#else-  newtype StT LogT m = StLogT { unStLogT :: StT InnerLogT m }-  liftWith = defaultLiftWith LogT unLogT StLogT-  restoreT = defaultRestoreT LogT unStLogT-#endif-  {-# INLINE liftWith #-}-  {-# INLINE restoreT #-}  instance MonadBaseControl b m => MonadBaseControl b (LogT m) where-#if MIN_VERSION_monad_control(1,0,0)   type StM (LogT m) a = ComposeSt LogT m a   liftBaseWith = defaultLiftBaseWith   restoreM     = defaultRestoreM-#else-  newtype StM (LogT m) a = StMLogT { unStMLogT :: ComposeSt LogT m a }-  liftBaseWith = defaultLiftBaseWith StMLogT-  restoreM     = defaultRestoreM unStMLogT-#endif-  {-# INLINE liftBaseWith #-}-  {-# INLINE restoreM #-}  instance MonadUnliftIO m => MonadUnliftIO (LogT m) where   withRunInIO inner = LogT $ withRunInIO $ \run -> inner (run . unLogT)-  {-# INLINE withRunInIO #-}  instance MonadBase IO m => MonadLog (LogT m) where   logMessage level message data_ = LogT . ReaderT $ \logEnv -> liftBase $ do