monad-logger 0.3.1.1 → 0.3.2.0
raw patch · 2 files changed
+91/−4 lines, 2 filesdep +lifted-basedep +monad-loopsdep +stm
Dependencies added: lifted-base, monad-loops, stm, stm-chans
Files
- Control/Monad/Logger.hs +86/−3
- monad-logger.cabal +5/−1
Control/Monad/Logger.hs view
@@ -1,8 +1,10 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE UndecidableInstances #-} -- | This module provides the facilities needed for a decoupled logging system. --@@ -26,6 +28,7 @@ , LoggingT (..) , runStderrLoggingT , runStdoutLoggingT+ , withChannelLogger , NoLoggingT (..) -- * TH logging , logDebug@@ -41,6 +44,18 @@ , logOtherS -- * TH util , liftLoc+ -- * Non-TH logging+ , logDebugN+ , logInfoN+ , logWarnN+ , logErrorN+ , logOtherN+ -- * Non-TH logging with source+ , logDebugNS+ , logInfoNS+ , logWarnNS+ , logErrorNS+ , logOtherNS ) where import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation)@@ -49,8 +64,12 @@ import Data.Monoid (Monoid) import Control.Applicative (Applicative (..))-import Control.Monad (liftM, ap)+import Control.Concurrent.STM+import Control.Concurrent.STM.TBChan+import Control.Exception.Lifted+import Control.Monad (liftM, ap, when, void) import Control.Monad.Base (MonadBase (liftBase))+import Control.Monad.Loops (untilM) import Control.Monad.Trans.Control (MonadBaseControl (..), MonadTransControl (..)) import Data.Functor.Identity (Identity) import Control.Monad.ST (ST)@@ -170,7 +189,7 @@ -- | Generates a function that takes a 'LogSource' and 'Text' and logs a 'LevelDebug' message. Usage: ----- > $logDebug "SomeSource" "This is a debug log message"+-- > $logDebugS "SomeSource" "This is a debug log message" logDebugS :: Q Exp logDebugS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelDebug (b :: Text)|] @@ -186,7 +205,7 @@ -- | Generates a function that takes a 'LogSource', a level name and a 'Text' and logs a 'LevelOther' message. Usage: ----- > $logOther "SomeSource" "My new level" "This is a log message"+-- > $logOtherS "SomeSource" "My new level" "This is a log message" logOtherS :: Q Exp logOtherS = [|\src level msg -> monadLoggerLog $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|] @@ -336,6 +355,27 @@ runStdoutLoggingT :: MonadIO m => LoggingT m a -> m a runStdoutLoggingT = (`runLoggingT` defaultOutput stdout) +-- | Within the 'LoggingT' monad, capture all log messages to a bounded+-- channel of the indicated size, and only actually log them if there is an+-- exception.+--+-- Since 0.3.2+withChannelLogger :: (MonadBaseControl IO m, MonadIO m)+ => Int -- ^ Number of mesasges to keep+ -> LoggingT m a+ -> LoggingT m a+withChannelLogger size action = LoggingT $ \logger -> do+ chan <- liftIO $ newTBChanIO size+ runLoggingT action (channelLogger chan logger) `onException` dumpLogs chan+ where+ channelLogger chan logger loc src lvl str = atomically $ do+ full <- isFullTBChan chan+ when full $ void $ readTBChan chan+ writeTBChan chan $ logger loc src lvl str++ dumpLogs chan = liftIO $+ sequence_ =<< atomically (untilM (readTBChan chan) (isEmptyTBChan chan))+ instance MonadCont m => MonadCont (LoggingT m) where callCC f = LoggingT $ \i -> callCC $ \c -> runLoggingT (f (LoggingT . const . c)) i @@ -360,3 +400,46 @@ tell = Trans.lift . tell listen = mapLoggingT listen pass = mapLoggingT pass++defaultLoc :: Loc+defaultLoc = Loc "<unknown>" "<unknown>" "<unknown>" (0,0) (0,0)++logDebugN :: MonadLogger m => Text -> m ()+logDebugN msg =+ monadLoggerLog defaultLoc "" LevelDebug msg++logInfoN :: MonadLogger m => Text -> m ()+logInfoN msg =+ monadLoggerLog defaultLoc "" LevelInfo msg++logWarnN :: MonadLogger m => Text -> m ()+logWarnN msg =+ monadLoggerLog defaultLoc "" LevelWarn msg++logErrorN :: MonadLogger m => Text -> m ()+logErrorN msg =+ monadLoggerLog defaultLoc "" LevelError msg++logOtherN :: MonadLogger m => LogLevel -> Text -> m ()+logOtherN level msg =+ monadLoggerLog defaultLoc "" level msg++logDebugNS :: MonadLogger m => Text -> Text -> m ()+logDebugNS src msg =+ monadLoggerLog defaultLoc src LevelDebug msg++logInfoNS :: MonadLogger m => Text -> Text -> m ()+logInfoNS src msg =+ monadLoggerLog defaultLoc src LevelInfo msg++logWarnNS :: MonadLogger m => Text -> Text -> m ()+logWarnNS src msg =+ monadLoggerLog defaultLoc src LevelWarn msg++logErrorNS :: MonadLogger m => Text -> Text -> m ()+logErrorNS src msg =+ monadLoggerLog defaultLoc src LevelError msg++logOtherNS :: MonadLogger m => Text -> LogLevel -> Text -> m ()+logOtherNS src level msg =+ monadLoggerLog defaultLoc src level msg
monad-logger.cabal view
@@ -1,5 +1,5 @@ name: monad-logger-version: 0.3.1.1+version: 0.3.2.0 synopsis: A class of monads which can log messages. description: This package uses template-haskell for determining source code locations of messages. homepage: https://github.com/kazu-yamamoto/logger@@ -18,10 +18,14 @@ , template-haskell , transformers , text+ , stm+ , stm-chans+ , lifted-base , resourcet >= 0.4 && < 0.5 , conduit >= 1.0 && < 1.1 , fast-logger >= 0.2 && < 0.4 , transformers-base , monad-control+ , monad-loops , mtl , bytestring