packages feed

heavy-logger 0.3.0.0 → 0.3.1.0

raw patch · 9 files changed

+284/−90 lines, 9 filesdep +stm

Dependencies added: stm

Files

ChangeLog.md view
@@ -23,3 +23,8 @@ * Added the IO module. * Introduced null logging backend. +## 0.3.1.0 -- 2017-10-30++* Introduced Dynamic backend, which allows to change backend or its settings in runtime.+* Introduced FilteringM backend, which allows to change filtering settings in runtime.+
README.md view
@@ -19,6 +19,9 @@ * Possiblity to write messages to several backends in parallel. * Logging backend settings can be defined dynamically; it is not necessary to   hardcode which backend you will use, you can load settings in runtime.+* It is possible to change backend or it's settings in runtime (more precisely,+  you can change underlying backend if you use `DynamicBackend` as a backend, +  or you can change backend's filter if you use `FilteringM` as a backend). * Sane default set of logging message severity levels and possibility to define   custom severity levels. * Logging context stacks support (aka mapped diagnostic contexts, MDC). Each
heavy-logger.cabal view
@@ -1,5 +1,5 @@ name:                heavy-logger-version:             0.3.0.0+version:             0.3.1.0 synopsis:            Full-weight logging based on fast-logger description:         This is Haskell logging library, which prefers functionality and extendability                      over light weight and simplicity. It can use fast-logger as backend, and is compatible @@ -20,9 +20,11 @@   exposed-modules:     System.Log.Heavy                        System.Log.Heavy.Level                        System.Log.Heavy.Types+                       System.Log.Heavy.Util                        System.Log.Heavy.LoggingT                        System.Log.Heavy.Format                        System.Log.Heavy.Backends+                       System.Log.Heavy.Backends.Dynamic                        System.Log.Heavy.Shortcuts                        System.Log.Heavy.TH                        System.Log.Heavy.IO@@ -45,7 +47,8 @@                        monad-logger >= 0.3.22,                        hsyslog >= 5,                        text-format-heavy >= 0.1.5.0,-                       thread-local-storage >= 0.1.1+                       thread-local-storage >= 0.1.1,+                       stm >= 2.4   hs-source-dirs:      src   default-language:    Haskell2010   ghc-options:         -fwarn-unused-imports
src/System/Log/Heavy.hs view
@@ -64,8 +64,13 @@     module System.Log.Heavy.Level,     module System.Log.Heavy.LoggingT,     module System.Log.Heavy.Backends,+    module System.Log.Heavy.Backends.Dynamic,+    -- * Logging functions+    logMessage,+    -- * Run actions with logging     withLogging, withLoggingF, withLoggingT,-    isLevelEnabledByBackend, isLevelEnabled,+    -- * Check current settings+    isLevelEnabledByBackend, isLevelEnabled   ) where  import Control.Monad.Trans@@ -75,8 +80,10 @@  import System.Log.Heavy.Types import System.Log.Heavy.Level+import System.Log.Heavy.Util import System.Log.Heavy.LoggingT import System.Log.Heavy.Backends+import System.Log.Heavy.Backends.Dynamic  -- | Execute actions with logging backend. -- This is mostly an utility function to be used to construct custom @@ -119,11 +126,11 @@ -- This function assumes that if some events filtering is enabled by the -- backend, it does not depend on message text, only on source and  -- severity level.-isLevelEnabledByBackend :: forall m. (Monad m, HasLogBackend AnyLogBackend m) => LogSource -> Level -> m Bool+isLevelEnabledByBackend :: forall m. (Monad m, MonadIO m, HasLogBackend AnyLogBackend m) => LogSource -> Level -> m Bool isLevelEnabledByBackend src level = do   backend <- getLogBackend :: m AnyLogBackend   let msg = LogMessage level src undefined TL.empty () []-  return $ wouldWriteMessage backend msg+  liftIO $ wouldWriteMessage backend msg  -- | Check if logging of events of specified level from specified source -- is enabled by both context and backend filter.@@ -131,11 +138,11 @@ -- This function assumes that if some events filtering is enabled by the -- backend, it does not depend on message text, only on source and  -- severity level.-isLevelEnabled :: forall m. (Monad m, HasLogBackend AnyLogBackend m, HasLogContext m) => LogSource -> Level -> m Bool+isLevelEnabled :: forall m. (Monad m, MonadIO m, HasLogBackend AnyLogBackend m, HasLogContext m) => LogSource -> Level -> m Bool isLevelEnabled src level = do   let msg = LogMessage level src undefined TL.empty () []   backend <- getLogBackend :: m AnyLogBackend-  let isEnabledByBackend = wouldWriteMessage backend msg+  isEnabledByBackend <- liftIO $ wouldWriteMessage backend msg   isEnabledByContext <- checkContextFilterM msg   return $ isEnabledByContext && isEnabledByBackend
src/System/Log/Heavy/Backends.hs view
@@ -18,18 +18,12 @@   defStderrSettings,   defFileSettings,   defaultSyslogSettings,-  defaultSyslogFormat,-  -- * Utilities for other backends implementation-  checkLogLevel, checkLogLevel',-  checkContextFilter, checkContextFilter', checkContextFilterM,-  logMessage+  defaultSyslogFormat   ) where  import Control.Monad import Control.Monad.Trans (liftIO)-import Control.Monad.Reader import Control.Concurrent-import Data.List (isPrefixOf) import qualified Data.ByteString.Unsafe as BSU import qualified Data.Text.Format.Heavy as F import qualified System.Posix.Syslog as Syslog@@ -40,6 +34,7 @@ import System.Log.Heavy.Types import System.Log.Heavy.Level import System.Log.Heavy.Format+import System.Log.Heavy.Util  -- $description --@@ -62,8 +57,12 @@ -- * Filtering - passes messages, that match specified filter, --   to underlying backend. --+-- * FilteringM - similar to Filtering, but allows to change the filter in runtime.+-- -- * Parallel - writes messages to several backends in parallel. --+-- * Dynamic - allows to change underlying backend or its settings in runtime.+--  -- | Default settings for fast-logger stdout output defStdoutSettings :: LogBackendSettings FastLoggerBackend@@ -177,8 +176,9 @@ instance IsLogBackend ParallelBackend where   data LogBackendSettings ParallelBackend = ParallelLogSettings [LoggingSettings] -  wouldWriteMessage (ParallelBackend list) msg =-    or [wouldWriteMessage backend msg | backend <- list]+  wouldWriteMessage (ParallelBackend list) msg = do+    results <- sequence [wouldWriteMessage backend msg | backend <- list]+    return $ or results    makeLogger (ParallelBackend list) msg =     forM_ list $ \(AnyLogBackend backend) -> makeLogger backend msg@@ -210,7 +210,8 @@ instance IsLogBackend b => IsLogBackend (Filtering b) where   data LogBackendSettings (Filtering b) = Filtering (LogMessage -> Bool) (LogBackendSettings b) -  wouldWriteMessage (FilteringBackend fltr _) msg = fltr msg+  wouldWriteMessage (FilteringBackend fltr _) msg = do+    return $ fltr msg    makeLogger (FilteringBackend fltr backend) msg = do     when (fltr msg) $ do@@ -230,79 +231,11 @@ instance IsLogBackend NullBackend where   data LogBackendSettings NullBackend = NullLogSettings -  wouldWriteMessage _ _ = False+  wouldWriteMessage _ _ = return False    makeLogger _ _ = return ()    initLogBackend _ = return NullBackend    cleanupLogBackend _ = return ()---- | Check if message level matches given filter.-checkLogLevel :: LogFilter -> LogMessage -> Bool-checkLogLevel fltr m =-    checkLogLevel' fltr (lmSource m) (lmLevel m)---- | Check if message level matches given filter.-checkLogLevel' :: LogFilter -> LogSource -> Level -> Bool-checkLogLevel' fltr source level =-    case lookup (bestMatch source (map fst fltr)) fltr of-      Nothing -> False-      Just min -> level <= min-  where-    bestMatch :: LogSource -> [LogSource] -> LogSource-    bestMatch src list = go [] src list--    go best src [] = best-    go best src (x:xs)-      | src == x = x-      | x `isPrefixOf` src && length x > length best = go x src xs-      | otherwise = go best src xs---- | Check if message source and level passes specified filters.------ The message is passed if:------ * No @include@ filters are defined in context stack, OR the message conforms to ANY of @include@ filters;------ * AND the message does not conform to any of @exclude@ filters in the stack.----checkContextFilter' :: [LogContextFilter] -> LogSource -> Level -> Bool-checkContextFilter' filters source level =-  let includeFilters = [fltr | LogContextFilter (Just fltr) _ <- filters]-      excludeFilters = [fltr | LogContextFilter _ (Just fltr) <- filters]-      includeOk = null includeFilters || or [checkLogLevel' fltr source level | fltr <- includeFilters]-      excludeOk = or [checkLogLevel' fltr source level | fltr <- excludeFilters]-  in  includeOk && not excludeOk---- | Check if message matches filters from logging context.------ The message is passed if:------ * No @include@ filters are defined in context stack, OR the message conforms to ANY of @include@ filters;------ * AND the message does not conform to any of @exclude@ filters in the stack.----checkContextFilter :: LogContext -> LogMessage -> Bool-checkContextFilter context msg =-  checkContextFilter' (map lcfFilter context) (lmSource msg) (lmLevel msg)---- | Check if message matches filters from logging context.--- This function is similar to @checkContextFilter@, but uses current context--- from monadic state.-checkContextFilterM :: HasLogContext m => LogMessage -> m Bool-checkContextFilterM msg = do-  context <- getLogContext-  return $ checkContextFilter context msg---- | Log a message. This will add current context to context specified--- in the message.--- This function checks current context filter.-logMessage :: forall m. (HasLogging m, MonadIO m) => LogMessage -> m ()-logMessage msg = do-  ok <- checkContextFilterM msg-  when ok $ do-    context <- getLogContext-    logger <- getLogger-    liftIO $ logger $ msg {lmContext = context ++ lmContext msg}
+ src/System/Log/Heavy/Backends/Dynamic.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances #-}+-- | This module incldues logging backend combinators that allow to change+-- underlying backend or it's settings in runtime.+module System.Log.Heavy.Backends.Dynamic+  (+    -- * Dynamic backend+    DynamicBackend,+    DynamicBackendHandle,+    newDynamicBackendHandle,+    updateDynamicBackendSettings,+    LogBackendSettings (..),+    -- * Dynamic filtering+    FilteringM, filteringM, excludingM+  ) where ++import Control.Monad (when)+import Control.Concurrent+import Control.Concurrent.STM++import System.Log.Heavy.Types+import System.Log.Heavy.Util++-- | Abstract handle, that is used to control @DynamicBackend@.+data DynamicBackendHandle = DynamicBackendHandle {+    dbhBroadcast :: TChan LoggingSettings -- ^ Broadcast TChan. It is write-only.+  , dbhDefault :: LoggingSettings         -- ^ Initial logging settings. Used only before first update in TChan.+                                          --   We cannot put this into TChan at beginning, because after dupTChan+                                          --   newly created TChan's will be empty anyway.+  }+-- I put these data into special Handle type, to hide the implementation detail+-- that it uses TChan inside. This detail can be changed in later versions.++-- | Create an instance of @DynamicBackendHandle@.+newDynamicBackendHandle :: LoggingSettings         -- ^ Initial logging settings. This can be changed later with @updateDynamicBackendSettings@.+                     -> IO DynamicBackendHandle+newDynamicBackendHandle settings = do+  broadcast <- newBroadcastTChanIO+  return $ DynamicBackendHandle broadcast settings++-- | Update settings of @DynamicBackend@, which was created by provided handle.+updateDynamicBackendSettings :: DynamicBackendHandle     -- ^ Handle of @DynamicBackend@.+                             -> LoggingSettings          -- ^ New logging settings.+                             -> IO ()+updateDynamicBackendSettings handle settings = do+  atomically $ writeTChan (dbhBroadcast handle) settings++-- | Dynamic logging backend allows to change logging backend or it's settings+-- in runtime. When it sees new backend settings, it deinitializes old backend+-- and initializes new one.+--+-- How to use it:+--+-- * Before creating @DynamicSettings@, you have to select some initial+--   @LoggingSettings@ and create @DynamicBackendHandle@ with it.+-- * When you decide that you want to use new backend settings, call+--   @updateDynamicBackendSettings@ on existing @DynamicBackendHandle@.+--   @DynamicBackend@ will use new settings for the next logging function call.+-- * It is responsibility of caller code to do not change backends too frequently;+--   for example, if you are checking your config file for updates of logging+--   settings each 10s, you have to check that settings actually changed since+--   last time.+-- +-- It is possible to create one instance of @DynamicBackendHandle@ and pass it+-- to multiple threads.+--+data DynamicBackend = DynamicBackend {+    dbCurrentBackend :: MVar AnyLogBackend -- ^ Currently used logging backend+  , dbNewSettings :: TChan LoggingSettings -- ^ TChan with updates of settings. This is read only.+  }++-- Implementation is based on idea that Backend instances theirself are thread-safe;+-- i.e. it is safe to create several instances of any IsLogBackend data type in several threads+-- and they will coexist without problems (they do not use any shared state).+-- So, we can have one TChan, in which we can push updated settings when we want;+-- Each instance of DynamicBackend will have its own instance of underlying backend.+instance IsLogBackend DynamicBackend where+  data LogBackendSettings DynamicBackend = DynamicSettings DynamicBackendHandle++  initLogBackend (DynamicSettings (DynamicBackendHandle broadcast (LoggingSettings dfltSettings))) = do+    -- Duplicate broadcast TChan - create "own copy".+    mySettingsChan <- atomically $ dupTChan broadcast+    -- Initialize default backend+    backend <- initLogBackend dfltSettings+    backendVar <- newMVar (AnyLogBackend backend)+    return $ DynamicBackend backendVar mySettingsChan++  cleanupLogBackend (DynamicBackend backendVar _) = do+    -- Cleanup currently used backend+    backend <- takeMVar backendVar+    cleanupLogBackend backend++  wouldWriteMessage (DynamicBackend backendVar _) msg = do+    -- Delegate the call to currently used backend.+    backend <- readMVar backendVar+    wouldWriteMessage backend msg++  makeLogger (DynamicBackend backendVar settingsChan) msg = do+    -- See if there is an update of settings queued.+    mbNewSettings <- atomically $ tryReadTChan settingsChan+    -- Note: tryReadTChan will remove element from channel, if there is any.+    -- But, it will affect only "our own copy" of TChan. If there are other+    -- instances of DynamicBackend living in other threads with the same+    -- Handle, they will still see settings update in their own copies of+    -- TChan.+    case mbNewSettings of+      Nothing -> do+          -- No updates. Use current backend.+          backend <- readMVar backendVar+          makeLogger backend msg+      Just (LoggingSettings newSettings) -> do+          -- New settings came. We have to switch backends.+          oldBackend <- takeMVar backendVar+          -- Cleanup old backend+          cleanupLogBackend oldBackend+          -- Initialize new backend+          newBackend <- initLogBackend newSettings+          putMVar backendVar (AnyLogBackend newBackend)+          -- Delegate call to new backend+          makeLogger newBackend msg++-- | Filtering backend with mutable filter.+data FilteringM b = FilteringBackendM (MVar (LogMessage -> Bool)) b++-- | Specify filter as @LogFilter@. This filter can be changed later.+filteringM :: IsLogBackend b => LogFilter -> LogBackendSettings b -> IO (LogBackendSettings (FilteringM b))+filteringM fltr b = do+  fltrVar <- newMVar (checkLogLevel fltr)+  return $ FilteringM fltrVar b++-- | Exclude messages by filter. This filter can be changed later.+excludingM :: IsLogBackend b => LogFilter -> LogBackendSettings b -> IO (LogBackendSettings (FilteringM b))+excludingM fltr b = do+    fltrVar <- newMVar ex+    return $ FilteringM fltrVar b+  where+    ex msg = not $ checkContextFilter' [LogContextFilter Nothing (Just fltr)] (lmSource msg) (lmLevel msg)++instance IsLogBackend b => IsLogBackend (FilteringM b) where+  data LogBackendSettings (FilteringM b) =+      FilteringM (MVar (LogMessage -> Bool)) (LogBackendSettings b)++  wouldWriteMessage (FilteringBackendM fltrVar _) msg = do+    fltr <- readMVar fltrVar+    return $ fltr msg++  makeLogger (FilteringBackendM fltrVar backend) msg = do+    fltr <- readMVar fltrVar+    when (fltr msg) $ do+      makeLogger backend msg++  initLogBackend (FilteringM fltrVar settings) = do+    backend <- initLogBackend settings+    return $ FilteringBackendM fltrVar backend++  cleanupLogBackend (FilteringBackendM _ backend) = cleanupLogBackend backend+
src/System/Log/Heavy/Shortcuts.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables, AllowAmbiguousTypes, FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables, FlexibleContexts #-}  -- | This module contains some shortcut functions that can be of use in simple usage cases. module System.Log.Heavy.Shortcuts@@ -15,7 +15,7 @@  import System.Log.Heavy.Types import System.Log.Heavy.Level-import System.Log.Heavy.Backends+import System.Log.Heavy.Util  -- | Message stub with Info severity. infoMessage :: F.VarContainer vars => TL.Text -> vars -> LogMessage
src/System/Log/Heavy/Types.hs view
@@ -112,8 +112,8 @@   -- | Should return True if the specified message would be   -- actually written to the log. Default implementation    -- always returns True.-  wouldWriteMessage :: b -> LogMessage -> Bool-  wouldWriteMessage _ _ = True+  wouldWriteMessage :: b -> LogMessage -> IO Bool+  wouldWriteMessage _ _ = return True    -- | Cleanup logging backend (release resources and so on)   cleanupLogBackend :: b -> IO ()
+ src/System/Log/Heavy/Util.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables, FlexibleContexts #-}++module System.Log.Heavy.Util+  (+    -- * Functions of common use+    logMessage,+    -- * Utilities for backends implementation+    checkLogLevel, checkLogLevel',+    checkContextFilter, checkContextFilter', checkContextFilterM+  ) where++import Control.Monad (when)+import Control.Monad.Trans+import Data.List (isPrefixOf)++import System.Log.Heavy.Types+import System.Log.Heavy.Level++-- | Check if message source and level passes specified filters.+--+-- The message is passed if:+--+-- * No @include@ filters are defined in context stack, OR the message conforms to ANY of @include@ filters;+--+-- * AND the message does not conform to any of @exclude@ filters in the stack.+--+checkContextFilter' :: [LogContextFilter] -> LogSource -> Level -> Bool+checkContextFilter' filters source level =+  let includeFilters = [fltr | LogContextFilter (Just fltr) _ <- filters]+      excludeFilters = [fltr | LogContextFilter _ (Just fltr) <- filters]+      includeOk = null includeFilters || or [checkLogLevel' fltr source level | fltr <- includeFilters]+      excludeOk = or [checkLogLevel' fltr source level | fltr <- excludeFilters]+  in  includeOk && not excludeOk++-- | Check if message matches filters from logging context.+--+-- The message is passed if:+--+-- * No @include@ filters are defined in context stack, OR the message conforms to ANY of @include@ filters;+--+-- * AND the message does not conform to any of @exclude@ filters in the stack.+--+checkContextFilter :: LogContext -> LogMessage -> Bool+checkContextFilter context msg =+  checkContextFilter' (map lcfFilter context) (lmSource msg) (lmLevel msg)++-- | Check if message matches filters from logging context.+-- This function is similar to @checkContextFilter@, but uses current context+-- from monadic state.+checkContextFilterM :: HasLogContext m => LogMessage -> m Bool+checkContextFilterM msg = do+  context <- getLogContext+  return $ checkContextFilter context msg++-- | Check if message level matches given filter.+checkLogLevel :: LogFilter -> LogMessage -> Bool+checkLogLevel fltr m =+    checkLogLevel' fltr (lmSource m) (lmLevel m)++-- | Check if message level matches given filter.+checkLogLevel' :: LogFilter -> LogSource -> Level -> Bool+checkLogLevel' fltr source level =+    case lookup (bestMatch source (map fst fltr)) fltr of+      Nothing -> False+      Just min -> level <= min+  where+    bestMatch :: LogSource -> [LogSource] -> LogSource+    bestMatch src list = go [] src list++    go :: LogSource -> LogSource -> [LogSource] -> LogSource+    go best src [] = best+    go best src (x:xs)+      | src == x = x+      | (x `isPrefixOf` src) && (length x > length best) = go x src xs+      | otherwise = go best src xs++-- | Log a message. This will add current context to context specified+-- in the message.+-- This function checks current context filter.+logMessage :: forall m. (HasLogging m, MonadIO m) => LogMessage -> m ()+logMessage msg = do+  ok <- checkContextFilterM msg+  when ok $ do+    context <- getLogContext+    logger <- getLogger+    liftIO $ logger $ msg {lmContext = context ++ lmContext msg}+