monad-logger 0.2.2 → 0.2.3
raw patch · 2 files changed
+173/−6 lines, 2 filesdep +bytestringdep +monad-controldep +mtldep ~resourcet
Dependencies added: bytestring, monad-control, mtl, transformers-base
Dependency ranges changed: resourcet
Files
- Control/Monad/Logger.hs +168/−5
- monad-logger.cabal +5/−1
Control/Monad/Logger.hs view
@@ -1,10 +1,32 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+-- | This module provides the facilities needed for a decoupled logging system.+--+-- The 'MonadLogger' class is implemented by monads that give access to a+-- logging facility. Note that although 'IO', 'Identity' and 'ST' are+-- instances of 'MonadLogger', they will /discard all log messages/. If you're+-- defining a custom monad, then you may define an instance of 'MonadLogger'+-- that routes the log messages to the appropriate place (e.g., that's what+-- @yesod-core@'s @GHandler@ does). Otherwise, you may use the 'LoggingT'+-- monad included in this module (see 'runStderrLoggingT').+--+-- As a user of the logging facility, we provide you some convenient Template+-- Haskell splices that use the 'MonadLogger' class. They will record their+-- source file and position, which is very helpful when debugging. See+-- 'logDebug' for more information. module Control.Monad.Logger ( -- * MonadLogger MonadLogger(..) , LogLevel(..) , LogSource+ -- * Helper transformer+ , LoggingT (..)+ , runStderrLoggingT+ , runStdoutLoggingT -- * TH logging , logDebug , logInfo@@ -19,15 +41,25 @@ , logOtherS ) where -import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (Loc), qLocation)-import System.Log.FastLogger (ToLogStr)+import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation)+import System.Log.FastLogger (ToLogStr (toLogStr), LogStr (..)) import Data.Monoid (Monoid) +import Control.Applicative (Applicative (..))+import Control.Monad (liftM, ap)+import Control.Monad.Base (MonadBase (liftBase))+import Control.Monad.Trans.Control (MonadBaseControl (..), MonadTransControl (..)) import Data.Functor.Identity (Identity) import Control.Monad.ST (ST) import qualified Control.Monad.ST.Lazy as Lazy (ST)+import qualified Control.Monad.Trans.Class as Trans +import System.IO (stdout, stderr, Handle)++import Control.Monad.IO.Class (MonadIO (liftIO))+import Control.Monad.Trans.Resource (MonadResource (liftResourceT), MonadThrow (monadThrow))+ import Control.Monad.Trans.Identity ( IdentityT) import Control.Monad.Trans.List ( ListT ) import Control.Monad.Trans.Maybe ( MaybeT )@@ -44,10 +76,17 @@ import qualified Control.Monad.Trans.State.Strict as Strict ( StateT ) import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT ) -import Control.Monad.Trans.Class (MonadTrans)-import qualified Control.Monad.Trans.Class as Trans+import Data.Text (Text, pack, unpack, empty)+import qualified Data.Text as T+import qualified Data.ByteString.Char8 as S8+import Data.Text.Encoding (encodeUtf8) -import Data.Text (Text, pack, unpack)+import Control.Monad.Cont.Class ( MonadCont (..) )+import Control.Monad.Error.Class ( MonadError (..) )+import Control.Monad.RWS.Class ( MonadRWS )+import Control.Monad.Reader.Class ( MonadReader (..) )+import Control.Monad.State.Class ( MonadState (..) )+import Control.Monad.Writer.Class ( MonadWriter (..) ) data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text deriving (Eq, Prelude.Show, Prelude.Read, Ord)@@ -139,3 +178,127 @@ -- > $logOther "SomeSource" "My new level" "This is a log message" logOtherS :: Q Exp logOtherS = [|\src level msg -> monadLoggerLogSource $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|]++-- | Monad transformer that adds a new logging function.+--+-- Since 0.2.2+newtype LoggingT m a = LoggingT { runLoggingT :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a }++instance Monad m => Functor (LoggingT m) where+ fmap = liftM++instance Monad m => Applicative (LoggingT m) where+ pure = return+ (<*>) = ap++instance Monad m => Monad (LoggingT m) where+ return = LoggingT . const . return+ LoggingT ma >>= f = LoggingT $ \r -> do+ a <- ma r+ let LoggingT f' = f a+ f' r++instance MonadIO m => MonadIO (LoggingT m) where+ liftIO = Trans.lift . liftIO++instance MonadThrow m => MonadThrow (LoggingT m) where+ monadThrow = Trans.lift . monadThrow++instance MonadResource m => MonadResource (LoggingT m) where+ liftResourceT = Trans.lift . liftResourceT++instance MonadBase b m => MonadBase b (LoggingT m) where+ liftBase = Trans.lift . liftBase++instance Trans.MonadTrans LoggingT where+ lift = LoggingT . const++instance MonadTransControl LoggingT where+ newtype StT LoggingT a = StReader {unStReader :: a}+ liftWith f = LoggingT $ \r -> f $ \(LoggingT t) -> liftM StReader $ t r+ restoreT = LoggingT . const . liftM unStReader+ {-# INLINE liftWith #-}+ {-# INLINE restoreT #-}++instance MonadBaseControl b m => MonadBaseControl b (LoggingT m) where+ newtype StM (LoggingT m) a = StMT (StM m a)+ liftBaseWith f = LoggingT $ \reader' ->+ liftBaseWith $ \runInBase ->+ f $ liftM StMT . runInBase . (\(LoggingT r) -> r reader')+ restoreM (StMT base) = LoggingT $ const $ restoreM base++instance MonadIO m => MonadLogger (LoggingT m) where+ monadLoggerLog a b c = monadLoggerLogSource a empty b c+ monadLoggerLogSource a b c d = LoggingT $ \f -> liftIO $ f a b c (toLogStr d)++defaultOutput :: Handle+ -> Loc+ -> LogSource+ -> LogLevel+ -> LogStr+ -> IO ()+defaultOutput h loc src level msg =+ S8.hPutStrLn h $ S8.concat bs+ where+ bs =+ [ S8.pack "["+ , case level of+ LevelOther t -> encodeUtf8 t+ _ -> encodeUtf8 $ pack $ drop 5 $ show level+ , if T.null src+ then S8.empty+ else encodeUtf8 $ '#' `T.cons` src+ , S8.pack "] "+ , case msg of+ LS s -> encodeUtf8 $ pack s+ LB b -> b+ , S8.pack " @("+ , encodeUtf8 $ pack fileLocStr+ , S8.pack ")\n"+ ]++ -- taken from file-location package+ -- turn the TH Loc loaction information into a human readable string+ -- leaving out the loc_end parameter+ fileLocStr = (loc_package loc) ++ ':' : (loc_module loc) +++ ' ' : (loc_filename loc) ++ ':' : (line loc) ++ ':' : (char loc)+ where+ line = show . fst . loc_start+ char = show . snd . loc_start++-- | Run a block using a @MonadLogger@ instance which prints to stderr.+--+-- Since 0.2.2+runStderrLoggingT :: MonadIO m => LoggingT m a -> m a+runStderrLoggingT = (`runLoggingT` defaultOutput stderr)++-- | Run a block using a @MonadLogger@ instance which prints to stdout.+--+-- Since 0.2.2+runStdoutLoggingT :: MonadIO m => LoggingT m a -> m a+runStdoutLoggingT = (`runLoggingT` defaultOutput stdout)++instance MonadCont m => MonadCont (LoggingT m) where+ callCC f = LoggingT $ \i -> callCC $ \c -> runLoggingT (f (LoggingT . const . c)) i++instance MonadError e m => MonadError e (LoggingT m) where+ throwError = Trans.lift . throwError+ catchError r h = LoggingT $ \i -> runLoggingT r i `catchError` \e -> runLoggingT (h e) i++instance MonadRWS r w s m => MonadRWS r w s (LoggingT m)++instance MonadReader r m => MonadReader r (LoggingT m) where+ ask = Trans.lift ask+ local = mapLoggingT . local++mapLoggingT :: (m a -> n b) -> LoggingT m a -> LoggingT n b+mapLoggingT f = LoggingT . (f .) . runLoggingT++instance MonadState s m => MonadState s (LoggingT m) where+ get = Trans.lift get+ put = Trans.lift . put++instance MonadWriter w m => MonadWriter w (LoggingT m) where+ tell = Trans.lift . tell+ listen = mapLoggingT listen+ pass = mapLoggingT pass
monad-logger.cabal view
@@ -1,5 +1,5 @@ name: monad-logger-version: 0.2.2+version: 0.2.3 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@@ -21,3 +21,7 @@ , resourcet >= 0.3 && < 0.5 , conduit >= 0.5 && < 0.6 , fast-logger >= 0.2 && < 0.4+ , transformers-base+ , monad-control+ , mtl+ , bytestring