{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
#if WITH_CALLSTACK
{-# LANGUAGE ImplicitParams #-}
#endif
#if WITH_TEMPLATE_HASKELL
{-# LANGUAGE TemplateHaskell #-}
#endif
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TupleSections #-}
module Control.Monad.Logger
(
MonadLogger(..)
, MonadLoggerIO (..)
, LogLevel(..)
, LogLine
, LogSource
, LogStr
, ToLogStr(..)
, fromLogStr
, LoggingT (..)
, runStderrLoggingT
, runStdoutLoggingT
, runChanLoggingT
, runFileLoggingT
, unChanLoggingT
, withChannelLogger
, filterLogger
, NoLoggingT (..)
, mapNoLoggingT
, WriterLoggingT (..)
, execWriterLoggingT
, runWriterLoggingT
, mapLoggingT
#if WITH_TEMPLATE_HASKELL
, logDebug
, logInfo
, logWarn
, logError
, logOther
, logDebugSH
, logInfoSH
, logWarnSH
, logErrorSH
, logOtherSH
, logDebugS
, logInfoS
, logWarnS
, logErrorS
, logOtherS
, liftLoc
#endif
, logDebugN
, logInfoN
, logWarnN
, logErrorN
, logOtherN
, logWithoutLoc
, logDebugNS
, logInfoNS
, logWarnNS
, logErrorNS
, logOtherNS
#if WITH_CALLSTACK
, logDebugCS
, logInfoCS
, logWarnCS
, logErrorCS
, logOtherCS
#endif
, defaultLogStr
, Loc (..)
, defaultLoc
) where
#if WITH_TEMPLATE_HASKELL
import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation)
#endif
import Data.Functor ((<$>))
import Data.Monoid (Monoid)
import Control.Applicative (Applicative (..), WrappedMonad(..))
import Control.Concurrent.Chan (Chan(),writeChan,readChan)
import Control.Concurrent.STM
import Control.Concurrent.STM.TBChan
import Control.Exception.Lifted (onException, bracket)
import Control.Monad (liftM, when, void, forever)
import Control.Monad.Base (MonadBase (liftBase), liftBaseDefault)
#if MIN_VERSION_base(4, 9, 0)
import qualified Control.Monad.Fail as Fail
#endif
import Control.Monad.IO.Unlift
import Control.Monad.Loops (untilM)
import Control.Monad.Trans.Control (MonadBaseControl (..), MonadTransControl (..), ComposeSt, defaultLiftBaseWith, defaultRestoreM)
import qualified Control.Monad.Trans.Class as Trans
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Resource (MonadResource (liftResourceT))
import Control.Monad.Catch (MonadThrow (..), MonadCatch (..), MonadMask (..)
#if MIN_VERSION_exceptions(0, 10, 0)
, ExitCase (..)
#endif
)
import Control.Monad.Trans.Identity ( IdentityT)
import Control.Monad.Trans.List ( ListT )
import Control.Monad.Trans.Maybe ( MaybeT )
import Control.Monad.Trans.Error ( ErrorT, Error)
import Control.Monad.Trans.Except ( ExceptT )
import Control.Monad.Trans.Reader ( ReaderT )
import Control.Monad.Trans.Cont ( ContT )
import Control.Monad.Trans.State ( StateT )
import Control.Monad.Trans.Writer ( WriterT )
import Control.Monad.Trans.RWS ( RWST )
import Control.Monad.Trans.Resource ( ResourceT)
import Data.Conduit.Internal ( Pipe, ConduitM )
import qualified Control.Monad.Trans.RWS.Strict as Strict ( RWST )
import qualified Control.Monad.Trans.State.Strict as Strict ( StateT )
import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )
import Data.Text (Text, pack, unpack)
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as S8
import Data.Monoid (mappend, mempty)
import System.Log.FastLogger
import System.IO (Handle, IOMode(AppendMode), BufferMode(LineBuffering), openFile, hClose, hSetBuffering, stdout, stderr)
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 (..) )
#if WITH_CALLSTACK
import GHC.Stack as GHC
#endif
import Data.Conduit.Lazy (MonadActive, monadActive)
data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text
deriving (LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Prelude.Show, ReadPrec [LogLevel]
ReadPrec LogLevel
Int -> ReadS LogLevel
ReadS [LogLevel]
(Int -> ReadS LogLevel)
-> ReadS [LogLevel]
-> ReadPrec LogLevel
-> ReadPrec [LogLevel]
-> Read LogLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogLevel]
$creadListPrec :: ReadPrec [LogLevel]
readPrec :: ReadPrec LogLevel
$creadPrec :: ReadPrec LogLevel
readList :: ReadS [LogLevel]
$creadList :: ReadS [LogLevel]
readsPrec :: Int -> ReadS LogLevel
$creadsPrec :: Int -> ReadS LogLevel
Prelude.Read, Eq LogLevel
Eq LogLevel =>
(LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c< :: LogLevel -> LogLevel -> Bool
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
$cp1Ord :: Eq LogLevel
Ord)
type LogSource = Text
#if WITH_TEMPLATE_HASKELL
instance Lift LogLevel where
lift :: LogLevel -> Q Exp
lift LevelDebug = [|LevelDebug|]
lift LevelInfo = [|LevelInfo|]
lift LevelWarn = [|LevelWarn|]
lift LevelError = [|LevelError|]
lift (LevelOther x :: Text
x) = [|LevelOther $ pack $(lift $ unpack x)|]
#else
data Loc
= Loc { loc_filename :: String
, loc_package :: String
, loc_module :: String
, loc_start :: CharPos
, loc_end :: CharPos }
type CharPos = (Int, Int)
#endif
class Monad m => MonadLogger m where
monadLoggerLog :: ToLogStr msg => Loc -> LogSource -> LogLevel -> msg -> m ()
default monadLoggerLog :: (MonadLogger m', Trans.MonadTrans t, MonadLogger (t m'), ToLogStr msg, m ~ t m')
=> Loc -> LogSource -> LogLevel -> msg -> m ()
monadLoggerLog loc :: Loc
loc src :: Text
src lvl :: LogLevel
lvl msg :: msg
msg = m' () -> m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m' () -> m ()) -> m' () -> m ()
forall a b. (a -> b) -> a -> b
$ Loc -> Text -> LogLevel -> msg -> m' ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog Loc
loc Text
src LogLevel
lvl msg
msg
class (MonadLogger m, MonadIO m) => MonadLoggerIO m where
askLoggerIO :: m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
default askLoggerIO :: (Trans.MonadTrans t, MonadLoggerIO n, m ~ t n)
=> m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
askLoggerIO = n (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> t n (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift n (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall (m :: * -> *).
MonadLoggerIO m =>
m (Loc -> Text -> LogLevel -> LogStr -> IO ())
askLoggerIO
#define DEF monadLoggerLog a b c d = Trans.lift $ monadLoggerLog a b c d
instance MonadLogger m => MonadLogger (IdentityT m) where DEF
instance MonadLogger m => MonadLogger (ListT m) where DEF
instance MonadLogger m => MonadLogger (MaybeT m) where DEF
instance (MonadLogger m, Error e) => MonadLogger (ErrorT e m) where DEF
instance MonadLogger m => MonadLogger (ExceptT e m) where DEF
instance MonadLogger m => MonadLogger (ReaderT r m) where DEF
instance MonadLogger m => MonadLogger (ContT r m) where DEF
instance MonadLogger m => MonadLogger (StateT s m) where DEF
instance (MonadLogger m, Monoid w) => MonadLogger (WriterT w m) where DEF
instance (MonadLogger m, Monoid w) => MonadLogger (RWST r w s m) where DEF
instance MonadLogger m => MonadLogger (ResourceT m) where DEF
instance MonadLogger m => MonadLogger (Pipe l i o u m) where DEF
instance MonadLogger m => MonadLogger (ConduitM i o m) where DEF
instance MonadLogger m => MonadLogger (Strict.StateT s m) where DEF
instance (MonadLogger m, Monoid w) => MonadLogger (Strict.WriterT w m) where DEF
instance (MonadLogger m, Monoid w) => MonadLogger (Strict.RWST r w s m) where DEF
#undef DEF
instance MonadLoggerIO m => MonadLoggerIO (IdentityT m)
instance MonadLoggerIO m => MonadLoggerIO (ListT m)
instance MonadLoggerIO m => MonadLoggerIO (MaybeT m)
instance (MonadLoggerIO m, Error e) => MonadLoggerIO (ErrorT e m)
instance MonadLoggerIO m => MonadLoggerIO (ExceptT e m)
instance MonadLoggerIO m => MonadLoggerIO (ReaderT r m)
instance MonadLoggerIO m => MonadLoggerIO (ContT r m)
instance MonadLoggerIO m => MonadLoggerIO (StateT s m)
instance (MonadLoggerIO m, Monoid w) => MonadLoggerIO (WriterT w m)
instance (MonadLoggerIO m, Monoid w) => MonadLoggerIO (RWST r w s m)
instance MonadLoggerIO m => MonadLoggerIO (ResourceT m)
instance MonadLoggerIO m => MonadLoggerIO (Pipe l i o u m)
instance MonadLoggerIO m => MonadLoggerIO (ConduitM i o m)
instance MonadLoggerIO m => MonadLoggerIO (Strict.StateT s m)
instance (MonadLoggerIO m, Monoid w) => MonadLoggerIO (Strict.WriterT w m)
instance (MonadLoggerIO m, Monoid w) => MonadLoggerIO (Strict.RWST r w s m)
#if WITH_TEMPLATE_HASKELL
logTH :: LogLevel -> Q Exp
logTH :: LogLevel -> Q Exp
logTH level :: LogLevel
level =
[|monadLoggerLog $(qLocation >>= liftLoc) (pack "") $(lift level)
. (id :: Text -> Text)|]
logTHShow :: LogLevel -> Q Exp
logTHShow :: LogLevel -> Q Exp
logTHShow level :: LogLevel
level =
[|monadLoggerLog $(qLocation >>= liftLoc) (pack "") $(lift level)
. ((pack . show) :: Show a => a -> Text)|]
logDebug :: Q Exp
logDebug :: Q Exp
logDebug = LogLevel -> Q Exp
logTH LogLevel
LevelDebug
logInfo :: Q Exp
logInfo :: Q Exp
logInfo = LogLevel -> Q Exp
logTH LogLevel
LevelInfo
logWarn :: Q Exp
logWarn :: Q Exp
logWarn = LogLevel -> Q Exp
logTH LogLevel
LevelWarn
logError :: Q Exp
logError :: Q Exp
logError = LogLevel -> Q Exp
logTH LogLevel
LevelError
logOther :: Text -> Q Exp
logOther :: Text -> Q Exp
logOther = LogLevel -> Q Exp
logTH (LogLevel -> Q Exp) -> (Text -> LogLevel) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogLevel
LevelOther
logDebugSH :: Q Exp
logDebugSH :: Q Exp
logDebugSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelDebug
logInfoSH :: Q Exp
logInfoSH :: Q Exp
logInfoSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelInfo
logWarnSH :: Q Exp
logWarnSH :: Q Exp
logWarnSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelWarn
logErrorSH :: Q Exp
logErrorSH :: Q Exp
logErrorSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelError
logOtherSH :: Text -> Q Exp
logOtherSH :: Text -> Q Exp
logOtherSH = LogLevel -> Q Exp
logTHShow (LogLevel -> Q Exp) -> (Text -> LogLevel) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogLevel
LevelOther
liftLoc :: Loc -> Q Exp
liftLoc :: Loc -> Q Exp
liftLoc (Loc a :: String
a b :: String
b c :: String
c (d1 :: Int
d1, d2 :: Int
d2) (e1 :: Int
e1, e2 :: Int
e2)) = [|Loc
$(lift a)
$(lift b)
$(lift c)
($(lift d1), $(lift d2))
($(lift e1), $(lift e2))
|]
logDebugS :: Q Exp
logDebugS :: Q Exp
logDebugS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelDebug (b :: Text)|]
logInfoS :: Q Exp
logInfoS :: Q Exp
logInfoS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelInfo (b :: Text)|]
logWarnS :: Q Exp
logWarnS :: Q Exp
logWarnS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelWarn (b :: Text)|]
logErrorS :: Q Exp
logErrorS :: Q Exp
logErrorS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelError (b :: Text)|]
logOtherS :: Q Exp
logOtherS :: Q Exp
logOtherS = [|\src level msg -> monadLoggerLog $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|]
#endif
newtype NoLoggingT m a = NoLoggingT { NoLoggingT m a -> m a
runNoLoggingT :: m a }
deriving (a -> NoLoggingT m b -> NoLoggingT m a
(a -> b) -> NoLoggingT m a -> NoLoggingT m b
(forall a b. (a -> b) -> NoLoggingT m a -> NoLoggingT m b)
-> (forall a b. a -> NoLoggingT m b -> NoLoggingT m a)
-> Functor (NoLoggingT m)
forall a b. a -> NoLoggingT m b -> NoLoggingT m a
forall a b. (a -> b) -> NoLoggingT m a -> NoLoggingT m b
forall (m :: * -> *) a b.
Functor m =>
a -> NoLoggingT m b -> NoLoggingT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> NoLoggingT m a -> NoLoggingT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NoLoggingT m b -> NoLoggingT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> NoLoggingT m b -> NoLoggingT m a
fmap :: (a -> b) -> NoLoggingT m a -> NoLoggingT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> NoLoggingT m a -> NoLoggingT m b
Functor, Functor (NoLoggingT m)
a -> NoLoggingT m a
Functor (NoLoggingT m) =>
(forall a. a -> NoLoggingT m a)
-> (forall a b.
NoLoggingT m (a -> b) -> NoLoggingT m a -> NoLoggingT m b)
-> (forall a b c.
(a -> b -> c)
-> NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m c)
-> (forall a b. NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b)
-> (forall a b. NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m a)
-> Applicative (NoLoggingT m)
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m a
NoLoggingT m (a -> b) -> NoLoggingT m a -> NoLoggingT m b
(a -> b -> c) -> NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m c
forall a. a -> NoLoggingT m a
forall a b. NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m a
forall a b. NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
forall a b.
NoLoggingT m (a -> b) -> NoLoggingT m a -> NoLoggingT m b
forall a b c.
(a -> b -> c) -> NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (NoLoggingT m)
forall (m :: * -> *) a. Applicative m => a -> NoLoggingT m a
forall (m :: * -> *) a b.
Applicative m =>
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m a
forall (m :: * -> *) a b.
Applicative m =>
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
forall (m :: * -> *) a b.
Applicative m =>
NoLoggingT m (a -> b) -> NoLoggingT m a -> NoLoggingT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m c
<* :: NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m a
*> :: NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
liftA2 :: (a -> b -> c) -> NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m c
<*> :: NoLoggingT m (a -> b) -> NoLoggingT m a -> NoLoggingT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
NoLoggingT m (a -> b) -> NoLoggingT m a -> NoLoggingT m b
pure :: a -> NoLoggingT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> NoLoggingT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (NoLoggingT m)
Applicative, Applicative (NoLoggingT m)
a -> NoLoggingT m a
Applicative (NoLoggingT m) =>
(forall a b.
NoLoggingT m a -> (a -> NoLoggingT m b) -> NoLoggingT m b)
-> (forall a b. NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b)
-> (forall a. a -> NoLoggingT m a)
-> Monad (NoLoggingT m)
NoLoggingT m a -> (a -> NoLoggingT m b) -> NoLoggingT m b
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
forall a. a -> NoLoggingT m a
forall a b. NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
forall a b.
NoLoggingT m a -> (a -> NoLoggingT m b) -> NoLoggingT m b
forall (m :: * -> *). Monad m => Applicative (NoLoggingT m)
forall (m :: * -> *) a. Monad m => a -> NoLoggingT m a
forall (m :: * -> *) a b.
Monad m =>
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
forall (m :: * -> *) a b.
Monad m =>
NoLoggingT m a -> (a -> NoLoggingT m b) -> NoLoggingT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> NoLoggingT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> NoLoggingT m a
>> :: NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
>>= :: NoLoggingT m a -> (a -> NoLoggingT m b) -> NoLoggingT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
NoLoggingT m a -> (a -> NoLoggingT m b) -> NoLoggingT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (NoLoggingT m)
Monad, Monad (NoLoggingT m)
Monad (NoLoggingT m) =>
(forall a. IO a -> NoLoggingT m a) -> MonadIO (NoLoggingT m)
IO a -> NoLoggingT m a
forall a. IO a -> NoLoggingT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (NoLoggingT m)
forall (m :: * -> *) a. MonadIO m => IO a -> NoLoggingT m a
liftIO :: IO a -> NoLoggingT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> NoLoggingT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (NoLoggingT m)
MonadIO, Monad (NoLoggingT m)
e -> NoLoggingT m a
Monad (NoLoggingT m) =>
(forall e a. Exception e => e -> NoLoggingT m a)
-> MonadThrow (NoLoggingT m)
forall e a. Exception e => e -> NoLoggingT m a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (NoLoggingT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> NoLoggingT m a
throwM :: e -> NoLoggingT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> NoLoggingT m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (NoLoggingT m)
MonadThrow, MonadThrow (NoLoggingT m)
MonadThrow (NoLoggingT m) =>
(forall e a.
Exception e =>
NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a)
-> MonadCatch (NoLoggingT m)
NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
forall e a.
Exception e =>
NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (NoLoggingT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
catch :: NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (NoLoggingT m)
MonadCatch, MonadCatch (NoLoggingT m)
MonadCatch (NoLoggingT m) =>
(forall b.
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b)
-> (forall b.
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b)
-> (forall a b c.
NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c))
-> MonadMask (NoLoggingT m)
NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c)
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
forall b.
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
forall a b c.
NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (NoLoggingT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
forall (m :: * -> *) a b c.
MonadMask m =>
NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c)
generalBracket :: NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c)
uninterruptibleMask :: ((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
mask :: ((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (NoLoggingT m)
MonadMask, Monad (NoLoggingT m)
NoLoggingT m Bool
Monad (NoLoggingT m) =>
NoLoggingT m Bool -> MonadActive (NoLoggingT m)
forall (m :: * -> *). Monad m => m Bool -> MonadActive m
forall (m :: * -> *). MonadActive m => Monad (NoLoggingT m)
forall (m :: * -> *). MonadActive m => NoLoggingT m Bool
monadActive :: NoLoggingT m Bool
$cmonadActive :: forall (m :: * -> *). MonadActive m => NoLoggingT m Bool
$cp1MonadActive :: forall (m :: * -> *). MonadActive m => Monad (NoLoggingT m)
MonadActive, MonadBase b)
deriving instance MonadResource m => MonadResource (NoLoggingT m)
instance MonadActive m => MonadActive (LoggingT m) where
monadActive :: LoggingT m Bool
monadActive = m Bool -> LoggingT m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift m Bool
forall (m :: * -> *). MonadActive m => m Bool
monadActive
instance Trans.MonadTrans NoLoggingT where
lift :: m a -> NoLoggingT m a
lift = m a -> NoLoggingT m a
forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT
instance MonadTransControl NoLoggingT where
type StT NoLoggingT a = a
liftWith :: (Run NoLoggingT -> m a) -> NoLoggingT m a
liftWith f :: Run NoLoggingT -> m a
f = m a -> NoLoggingT m a
forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT (m a -> NoLoggingT m a) -> m a -> NoLoggingT m a
forall a b. (a -> b) -> a -> b
$ Run NoLoggingT -> m a
f Run NoLoggingT
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT
restoreT :: m (StT NoLoggingT a) -> NoLoggingT m a
restoreT = m (StT NoLoggingT a) -> NoLoggingT m a
forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT
{-# INLINE liftWith #-}
{-# INLINE restoreT #-}
#if MIN_VERSION_base(4, 9, 0)
instance (Fail.MonadFail m) => Fail.MonadFail (NoLoggingT m) where
fail :: String -> NoLoggingT m a
fail = m a -> NoLoggingT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m a -> NoLoggingT m a)
-> (String -> m a) -> String -> NoLoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail
#endif
instance MonadBaseControl b m => MonadBaseControl b (NoLoggingT m) where
type StM (NoLoggingT m) a = StM m a
liftBaseWith :: (RunInBase (NoLoggingT m) b -> b a) -> NoLoggingT m a
liftBaseWith f :: RunInBase (NoLoggingT m) b -> b a
f = m a -> NoLoggingT m a
forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT (m a -> NoLoggingT m a) -> m a -> NoLoggingT m a
forall a b. (a -> b) -> a -> b
$
(RunInBase m b -> b a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase m b -> b a) -> m a) -> (RunInBase m b -> b a) -> m a
forall a b. (a -> b) -> a -> b
$ \runInBase :: RunInBase m b
runInBase ->
RunInBase (NoLoggingT m) b -> b a
f (RunInBase (NoLoggingT m) b -> b a)
-> RunInBase (NoLoggingT m) b -> b a
forall a b. (a -> b) -> a -> b
$ m a -> b (StM m a)
RunInBase m b
runInBase (m a -> b (StM m a))
-> (NoLoggingT m a -> m a) -> NoLoggingT m a -> b (StM m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoLoggingT m a -> m a
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT
restoreM :: StM (NoLoggingT m) a -> NoLoggingT m a
restoreM = m a -> NoLoggingT m a
forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT (m a -> NoLoggingT m a)
-> (StM m a -> m a) -> StM m a -> NoLoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM
instance Monad m => MonadLogger (NoLoggingT m) where
monadLoggerLog :: Loc -> Text -> LogLevel -> msg -> NoLoggingT m ()
monadLoggerLog _ _ _ _ = () -> NoLoggingT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance MonadIO m => MonadLoggerIO (NoLoggingT m) where
askLoggerIO :: NoLoggingT m (Loc -> Text -> LogLevel -> LogStr -> IO ())
askLoggerIO = (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> NoLoggingT m (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Loc -> Text -> LogLevel -> LogStr -> IO ())
-> NoLoggingT m (Loc -> Text -> LogLevel -> LogStr -> IO ()))
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> NoLoggingT m (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall a b. (a -> b) -> a -> b
$ \_ _ _ _ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
instance MonadUnliftIO m => MonadUnliftIO (NoLoggingT m) where
#if MIN_VERSION_unliftio_core(0, 1, 1)
{-# INLINE withRunInIO #-}
withRunInIO :: ((forall a. NoLoggingT m a -> IO a) -> IO b) -> NoLoggingT m b
withRunInIO inner :: (forall a. NoLoggingT m a -> IO a) -> IO b
inner =
m b -> NoLoggingT m b
forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT (m b -> NoLoggingT m b) -> m b -> NoLoggingT m b
forall a b. (a -> b) -> a -> b
$
((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
forall a b. (a -> b) -> a -> b
$ \run :: forall a. m a -> IO a
run ->
(forall a. NoLoggingT m a -> IO a) -> IO b
inner (m a -> IO a
forall a. m a -> IO a
run (m a -> IO a) -> (NoLoggingT m a -> m a) -> NoLoggingT m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoLoggingT m a -> m a
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT)
#else
askUnliftIO =
NoLoggingT $
withUnliftIO $ \u ->
return (UnliftIO (unliftIO u . runNoLoggingT))
#endif
type LogLine = (Loc, LogSource, LogLevel, LogStr)
newtype WriterLoggingT m a = WriterLoggingT { WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT :: m (a, DList LogLine) }
newtype DList a = DList { DList a -> [a] -> [a]
unDList :: [a] -> [a] }
emptyDList :: DList a
emptyDList :: DList a
emptyDList = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList [a] -> [a]
forall a. a -> a
id
singleton :: a -> DList a
singleton :: a -> DList a
singleton = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList (([a] -> [a]) -> DList a) -> (a -> [a] -> [a]) -> a -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)
dListToList :: DList a -> [a]
dListToList :: DList a -> [a]
dListToList (DList dl :: [a] -> [a]
dl) = [a] -> [a]
dl []
appendDList :: DList a -> DList a -> DList a
appendDList :: DList a -> DList a -> DList a
appendDList dl1 :: DList a
dl1 dl2 :: DList a
dl2 = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DList (DList a -> [a] -> [a]
forall a. DList a -> [a] -> [a]
unDList DList a
dl1 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a] -> [a]
forall a. DList a -> [a] -> [a]
unDList DList a
dl2)
runWriterLoggingT :: Functor m => WriterLoggingT m a -> m (a, [LogLine])
runWriterLoggingT :: WriterLoggingT m a -> m (a, [LogLine])
runWriterLoggingT (WriterLoggingT ma :: m (a, DList LogLine)
ma) = (DList LogLine -> [LogLine])
-> (a, DList LogLine) -> (a, [LogLine])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList LogLine -> [LogLine]
forall a. DList a -> [a]
dListToList ((a, DList LogLine) -> (a, [LogLine]))
-> m (a, DList LogLine) -> m (a, [LogLine])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a, DList LogLine)
ma
execWriterLoggingT :: Functor m => WriterLoggingT m a -> m [LogLine]
execWriterLoggingT :: WriterLoggingT m a -> m [LogLine]
execWriterLoggingT ma :: WriterLoggingT m a
ma = (a, [LogLine]) -> [LogLine]
forall a b. (a, b) -> b
snd ((a, [LogLine]) -> [LogLine]) -> m (a, [LogLine]) -> m [LogLine]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterLoggingT m a -> m (a, [LogLine])
forall (m :: * -> *) a.
Functor m =>
WriterLoggingT m a -> m (a, [LogLine])
runWriterLoggingT WriterLoggingT m a
ma
instance Monad m => Monad (WriterLoggingT m) where
return :: a -> WriterLoggingT m a
return = WrappedMonad (WriterLoggingT m) a -> WriterLoggingT m a
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad (WriterLoggingT m) a -> WriterLoggingT m a)
-> (a -> WrappedMonad (WriterLoggingT m) a)
-> a
-> WriterLoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> WrappedMonad (WriterLoggingT m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(WriterLoggingT ma :: m (a, DList LogLine)
ma) >>= :: WriterLoggingT m a
-> (a -> WriterLoggingT m b) -> WriterLoggingT m b
>>= f :: a -> WriterLoggingT m b
f = m (b, DList LogLine) -> WriterLoggingT m b
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m (b, DList LogLine) -> WriterLoggingT m b)
-> m (b, DList LogLine) -> WriterLoggingT m b
forall a b. (a -> b) -> a -> b
$ do
(a :: a
a, msgs :: DList LogLine
msgs) <- m (a, DList LogLine)
ma
(a' :: b
a', msgs' :: DList LogLine
msgs') <- WriterLoggingT m b -> m (b, DList LogLine)
forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT (WriterLoggingT m b -> m (b, DList LogLine))
-> WriterLoggingT m b -> m (b, DList LogLine)
forall a b. (a -> b) -> a -> b
$ a -> WriterLoggingT m b
f a
a
(b, DList LogLine) -> m (b, DList LogLine)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
a', DList LogLine -> DList LogLine -> DList LogLine
forall a. DList a -> DList a -> DList a
appendDList DList LogLine
msgs DList LogLine
msgs')
instance Applicative m => Applicative (WriterLoggingT m) where
pure :: a -> WriterLoggingT m a
pure a :: a
a = m (a, DList LogLine) -> WriterLoggingT m a
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m (a, DList LogLine) -> WriterLoggingT m a)
-> ((a, DList LogLine) -> m (a, DList LogLine))
-> (a, DList LogLine)
-> WriterLoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, DList LogLine) -> m (a, DList LogLine)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, DList LogLine) -> WriterLoggingT m a)
-> (a, DList LogLine) -> WriterLoggingT m a
forall a b. (a -> b) -> a -> b
$ (a
a, DList LogLine
forall a. DList a
emptyDList)
WriterLoggingT mf :: m (a -> b, DList LogLine)
mf <*> :: WriterLoggingT m (a -> b)
-> WriterLoggingT m a -> WriterLoggingT m b
<*> WriterLoggingT ma :: m (a, DList LogLine)
ma = m (b, DList LogLine) -> WriterLoggingT m b
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m (b, DList LogLine) -> WriterLoggingT m b)
-> m (b, DList LogLine) -> WriterLoggingT m b
forall a b. (a -> b) -> a -> b
$
(((a -> b, DList LogLine), (a, DList LogLine))
-> (b, DList LogLine))
-> m ((a -> b, DList LogLine), (a, DList LogLine))
-> m (b, DList LogLine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((f :: a -> b
f, msgs :: DList LogLine
msgs), (a :: a
a, msgs' :: DList LogLine
msgs')) -> (a -> b
f a
a, DList LogLine -> DList LogLine -> DList LogLine
forall a. DList a -> DList a -> DList a
appendDList DList LogLine
msgs DList LogLine
msgs')) ((,) ((a -> b, DList LogLine)
-> (a, DList LogLine)
-> ((a -> b, DList LogLine), (a, DList LogLine)))
-> m (a -> b, DList LogLine)
-> m ((a, DList LogLine)
-> ((a -> b, DList LogLine), (a, DList LogLine)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a -> b, DList LogLine)
mf m ((a, DList LogLine)
-> ((a -> b, DList LogLine), (a, DList LogLine)))
-> m (a, DList LogLine)
-> m ((a -> b, DList LogLine), (a, DList LogLine))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (a, DList LogLine)
ma)
instance Functor m => Functor (WriterLoggingT m) where
fmap :: (a -> b) -> WriterLoggingT m a -> WriterLoggingT m b
fmap f :: a -> b
f (WriterLoggingT ma :: m (a, DList LogLine)
ma) = m (b, DList LogLine) -> WriterLoggingT m b
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m (b, DList LogLine) -> WriterLoggingT m b)
-> m (b, DList LogLine) -> WriterLoggingT m b
forall a b. (a -> b) -> a -> b
$
((a, DList LogLine) -> (b, DList LogLine))
-> m (a, DList LogLine) -> m (b, DList LogLine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a :: a
a, msgs :: DList LogLine
msgs) -> (a -> b
f a
a, DList LogLine
msgs)) m (a, DList LogLine)
ma
instance Monad m => MonadLogger (WriterLoggingT m) where
monadLoggerLog :: Loc -> Text -> LogLevel -> msg -> WriterLoggingT m ()
monadLoggerLog loc :: Loc
loc source :: Text
source level :: LogLevel
level msg :: msg
msg = m ((), DList LogLine) -> WriterLoggingT m ()
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m ((), DList LogLine) -> WriterLoggingT m ())
-> (((), DList LogLine) -> m ((), DList LogLine))
-> ((), DList LogLine)
-> WriterLoggingT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), DList LogLine) -> m ((), DList LogLine)
forall (m :: * -> *) a. Monad m => a -> m a
return (((), DList LogLine) -> WriterLoggingT m ())
-> ((), DList LogLine) -> WriterLoggingT m ()
forall a b. (a -> b) -> a -> b
$ ((), LogLine -> DList LogLine
forall a. a -> DList a
singleton (Loc
loc, Text
source, LogLevel
level, msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
msg))
instance Trans.MonadTrans WriterLoggingT where
lift :: m a -> WriterLoggingT m a
lift ma :: m a
ma = m (a, DList LogLine) -> WriterLoggingT m a
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m (a, DList LogLine) -> WriterLoggingT m a)
-> m (a, DList LogLine) -> WriterLoggingT m a
forall a b. (a -> b) -> a -> b
$ (, DList LogLine
forall a. DList a
emptyDList) (a -> (a, DList LogLine)) -> m a -> m (a, DList LogLine)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m a
ma
instance MonadIO m => MonadIO (WriterLoggingT m) where
liftIO :: IO a -> WriterLoggingT m a
liftIO ioa :: IO a
ioa = m (a, DList LogLine) -> WriterLoggingT m a
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m (a, DList LogLine) -> WriterLoggingT m a)
-> m (a, DList LogLine) -> WriterLoggingT m a
forall a b. (a -> b) -> a -> b
$ (, DList LogLine
forall a. DList a
emptyDList) (a -> (a, DList LogLine)) -> m a -> m (a, DList LogLine)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
ioa
instance MonadBase b m => MonadBase b (WriterLoggingT m) where
liftBase :: b α -> WriterLoggingT m α
liftBase = b α -> WriterLoggingT m α
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) α.
(MonadTrans t, MonadBase b m) =>
b α -> t m α
liftBaseDefault
instance MonadTransControl WriterLoggingT where
type StT WriterLoggingT a = (a, DList LogLine)
liftWith :: (Run WriterLoggingT -> m a) -> WriterLoggingT m a
liftWith f :: Run WriterLoggingT -> m a
f = m (a, DList LogLine) -> WriterLoggingT m a
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m (a, DList LogLine) -> WriterLoggingT m a)
-> m (a, DList LogLine) -> WriterLoggingT m a
forall a b. (a -> b) -> a -> b
$ (a -> (a, DList LogLine)) -> m a -> m (a, DList LogLine)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\x :: a
x -> (a
x, DList LogLine
forall a. DList a
emptyDList))
(Run WriterLoggingT -> m a
f (Run WriterLoggingT -> m a) -> Run WriterLoggingT -> m a
forall a b. (a -> b) -> a -> b
$ Run WriterLoggingT
forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT)
restoreT :: m (StT WriterLoggingT a) -> WriterLoggingT m a
restoreT = m (StT WriterLoggingT a) -> WriterLoggingT m a
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT
instance MonadBaseControl b m => MonadBaseControl b (WriterLoggingT m) where
type StM (WriterLoggingT m) a = ComposeSt WriterLoggingT m a
liftBaseWith :: (RunInBase (WriterLoggingT m) b -> b a) -> WriterLoggingT m a
liftBaseWith = (RunInBase (WriterLoggingT m) b -> b a) -> WriterLoggingT m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
restoreM :: StM (WriterLoggingT m) a -> WriterLoggingT m a
restoreM = StM (WriterLoggingT m) a -> WriterLoggingT m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
instance MonadThrow m => MonadThrow (WriterLoggingT m) where
throwM :: e -> WriterLoggingT m a
throwM = m a -> WriterLoggingT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m a -> WriterLoggingT m a)
-> (e -> m a) -> e -> WriterLoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
instance MonadCatch m => MonadCatch (WriterLoggingT m) where
catch :: WriterLoggingT m a
-> (e -> WriterLoggingT m a) -> WriterLoggingT m a
catch (WriterLoggingT m :: m (a, DList LogLine)
m) c :: e -> WriterLoggingT m a
c =
m (a, DList LogLine) -> WriterLoggingT m a
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m (a, DList LogLine) -> WriterLoggingT m a)
-> m (a, DList LogLine) -> WriterLoggingT m a
forall a b. (a -> b) -> a -> b
$ m (a, DList LogLine)
m m (a, DList LogLine)
-> (e -> m (a, DList LogLine)) -> m (a, DList LogLine)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> WriterLoggingT m a -> m (a, DList LogLine)
forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT (e -> WriterLoggingT m a
c e
e)
instance MonadMask m => MonadMask (WriterLoggingT m) where
mask :: ((forall a. WriterLoggingT m a -> WriterLoggingT m a)
-> WriterLoggingT m b)
-> WriterLoggingT m b
mask a :: (forall a. WriterLoggingT m a -> WriterLoggingT m a)
-> WriterLoggingT m b
a = m (b, DList LogLine) -> WriterLoggingT m b
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m (b, DList LogLine) -> WriterLoggingT m b)
-> m (b, DList LogLine) -> WriterLoggingT m b
forall a b. (a -> b) -> a -> b
$ (((forall a. m a -> m a) -> m (b, DList LogLine))
-> m (b, DList LogLine)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (b, DList LogLine))
-> m (b, DList LogLine))
-> ((forall a. m a -> m a) -> m (b, DList LogLine))
-> m (b, DList LogLine)
forall a b. (a -> b) -> a -> b
$ \ u :: forall a. m a -> m a
u -> WriterLoggingT m b -> m (b, DList LogLine)
forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT ((forall a. WriterLoggingT m a -> WriterLoggingT m a)
-> WriterLoggingT m b
a ((forall a. WriterLoggingT m a -> WriterLoggingT m a)
-> WriterLoggingT m b)
-> (forall a. WriterLoggingT m a -> WriterLoggingT m a)
-> WriterLoggingT m b
forall a b. (a -> b) -> a -> b
$ (m (a, DList LogLine) -> m (a, DList LogLine))
-> WriterLoggingT m a -> WriterLoggingT m a
forall (m :: * -> *) a (m :: * -> *) a.
(m (a, DList LogLine) -> m (a, DList LogLine))
-> WriterLoggingT m a -> WriterLoggingT m a
q m (a, DList LogLine) -> m (a, DList LogLine)
forall a. m a -> m a
u))
where q :: (m (a, DList LogLine) -> m (a, DList LogLine))
-> WriterLoggingT m a -> WriterLoggingT m a
q u :: m (a, DList LogLine) -> m (a, DList LogLine)
u b :: WriterLoggingT m a
b = m (a, DList LogLine) -> WriterLoggingT m a
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m (a, DList LogLine) -> WriterLoggingT m a)
-> m (a, DList LogLine) -> WriterLoggingT m a
forall a b. (a -> b) -> a -> b
$ m (a, DList LogLine) -> m (a, DList LogLine)
u (WriterLoggingT m a -> m (a, DList LogLine)
forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT WriterLoggingT m a
b)
uninterruptibleMask :: ((forall a. WriterLoggingT m a -> WriterLoggingT m a)
-> WriterLoggingT m b)
-> WriterLoggingT m b
uninterruptibleMask a :: (forall a. WriterLoggingT m a -> WriterLoggingT m a)
-> WriterLoggingT m b
a = m (b, DList LogLine) -> WriterLoggingT m b
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m (b, DList LogLine) -> WriterLoggingT m b)
-> m (b, DList LogLine) -> WriterLoggingT m b
forall a b. (a -> b) -> a -> b
$ ((forall a. m a -> m a) -> m (b, DList LogLine))
-> m (b, DList LogLine)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall a. m a -> m a) -> m (b, DList LogLine))
-> m (b, DList LogLine))
-> ((forall a. m a -> m a) -> m (b, DList LogLine))
-> m (b, DList LogLine)
forall a b. (a -> b) -> a -> b
$ \u :: forall a. m a -> m a
u -> WriterLoggingT m b -> m (b, DList LogLine)
forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT ((forall a. WriterLoggingT m a -> WriterLoggingT m a)
-> WriterLoggingT m b
a ((forall a. WriterLoggingT m a -> WriterLoggingT m a)
-> WriterLoggingT m b)
-> (forall a. WriterLoggingT m a -> WriterLoggingT m a)
-> WriterLoggingT m b
forall a b. (a -> b) -> a -> b
$ (m (a, DList LogLine) -> m (a, DList LogLine))
-> WriterLoggingT m a -> WriterLoggingT m a
forall (m :: * -> *) a (m :: * -> *) a.
(m (a, DList LogLine) -> m (a, DList LogLine))
-> WriterLoggingT m a -> WriterLoggingT m a
q m (a, DList LogLine) -> m (a, DList LogLine)
forall a. m a -> m a
u)
where q :: (m (a, DList LogLine) -> m (a, DList LogLine))
-> WriterLoggingT m a -> WriterLoggingT m a
q u :: m (a, DList LogLine) -> m (a, DList LogLine)
u b :: WriterLoggingT m a
b = m (a, DList LogLine) -> WriterLoggingT m a
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m (a, DList LogLine) -> WriterLoggingT m a)
-> m (a, DList LogLine) -> WriterLoggingT m a
forall a b. (a -> b) -> a -> b
$ m (a, DList LogLine) -> m (a, DList LogLine)
u (WriterLoggingT m a -> m (a, DList LogLine)
forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT WriterLoggingT m a
b)
#if MIN_VERSION_exceptions(0, 10, 0)
generalBracket :: WriterLoggingT m a
-> (a -> ExitCase b -> WriterLoggingT m c)
-> (a -> WriterLoggingT m b)
-> WriterLoggingT m (b, c)
generalBracket acquire :: WriterLoggingT m a
acquire release :: a -> ExitCase b -> WriterLoggingT m c
release use :: a -> WriterLoggingT m b
use = m ((b, c), DList LogLine) -> WriterLoggingT m (b, c)
forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT (m ((b, c), DList LogLine) -> WriterLoggingT m (b, c))
-> m ((b, c), DList LogLine) -> WriterLoggingT m (b, c)
forall a b. (a -> b) -> a -> b
$ do
((b :: b
b, _w12 :: DList LogLine
_w12), (c :: c
c, w123 :: DList LogLine
w123)) <- m (a, DList LogLine)
-> ((a, DList LogLine)
-> ExitCase (b, DList LogLine) -> m (c, DList LogLine))
-> ((a, DList LogLine) -> m (b, DList LogLine))
-> m ((b, DList LogLine), (c, DList LogLine))
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
(WriterLoggingT m a -> m (a, DList LogLine)
forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT WriterLoggingT m a
acquire)
(\(resource :: a
resource, w1 :: DList LogLine
w1) exitCase :: ExitCase (b, DList LogLine)
exitCase -> case ExitCase (b, DList LogLine)
exitCase of
ExitCaseSuccess (b :: b
b, w12 :: DList LogLine
w12) -> do
(c :: c
c, w3 :: DList LogLine
w3) <- WriterLoggingT m c -> m (c, DList LogLine)
forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT (a -> ExitCase b -> WriterLoggingT m c
release a
resource (b -> ExitCase b
forall a. a -> ExitCase a
ExitCaseSuccess b
b))
(c, DList LogLine) -> m (c, DList LogLine)
forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, DList LogLine -> DList LogLine -> DList LogLine
forall a. DList a -> DList a -> DList a
appendDList DList LogLine
w12 DList LogLine
w3)
ExitCaseException e :: SomeException
e -> do
(c :: c
c, w3 :: DList LogLine
w3) <- WriterLoggingT m c -> m (c, DList LogLine)
forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT (a -> ExitCase b -> WriterLoggingT m c
release a
resource (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e))
(c, DList LogLine) -> m (c, DList LogLine)
forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, DList LogLine -> DList LogLine -> DList LogLine
forall a. DList a -> DList a -> DList a
appendDList DList LogLine
w1 DList LogLine
w3)
ExitCaseAbort -> do
(c :: c
c, w3 :: DList LogLine
w3) <- WriterLoggingT m c -> m (c, DList LogLine)
forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT (a -> ExitCase b -> WriterLoggingT m c
release a
resource ExitCase b
forall a. ExitCase a
ExitCaseAbort)
(c, DList LogLine) -> m (c, DList LogLine)
forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, DList LogLine -> DList LogLine -> DList LogLine
forall a. DList a -> DList a -> DList a
appendDList DList LogLine
w1 DList LogLine
w3))
(\(resource :: a
resource, w1 :: DList LogLine
w1) -> do
(a :: b
a, w2 :: DList LogLine
w2) <- WriterLoggingT m b -> m (b, DList LogLine)
forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT (a -> WriterLoggingT m b
use a
resource)
(b, DList LogLine) -> m (b, DList LogLine)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
a, DList LogLine -> DList LogLine -> DList LogLine
forall a. DList a -> DList a -> DList a
appendDList DList LogLine
w1 DList LogLine
w2))
((b, c), DList LogLine) -> m ((b, c), DList LogLine)
forall (m :: * -> *) a. Monad m => a -> m a
return ((b
b, c
c), DList LogLine
w123)
#elif MIN_VERSION_exceptions(0, 9, 0)
generalBracket acquire release releaseEx use =
WriterLoggingT $ generalBracket
(unWriterLoggingT acquire)
(\(x, w1) -> do
(y, w2) <- unWriterLoggingT (release x)
return (y, appendDList w1 w2))
(\(x, w1) ex -> do
(y, w2) <- unWriterLoggingT (releaseEx x ex)
return (y, appendDList w1 w2))
(\(x, w1) -> do
(y, w2) <- unWriterLoggingT (use x)
return (y, appendDList w1 w2))
#endif
newtype LoggingT m a = LoggingT { LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a }
#if __GLASGOW_HASKELL__ < 710
instance Monad m => Functor (LoggingT m) where
fmap = liftM
instance Monad m => Applicative (LoggingT m) where
pure = return
(<*>) = ap
#else
instance Functor m => Functor (LoggingT m) where
fmap :: (a -> b) -> LoggingT m a -> LoggingT m b
fmap f :: a -> b
f logger :: LoggingT m a
logger = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b
forall a b. (a -> b) -> a -> b
$ \loggerFn :: Loc -> Text -> LogLevel -> LogStr -> IO ()
loggerFn -> (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b) -> m a -> m b
forall a b. (a -> b) -> a -> b
$ (LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT LoggingT m a
logger) Loc -> Text -> LogLevel -> LogStr -> IO ()
loggerFn
{-# INLINE fmap #-}
instance Applicative m => Applicative (LoggingT m) where
pure :: a -> LoggingT m a
pure = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a)
-> (a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> a
-> LoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall a b. a -> b -> a
const (m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> (a -> m a)
-> a
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE pure #-}
loggerF :: LoggingT m (a -> b)
loggerF <*> :: LoggingT m (a -> b) -> LoggingT m a -> LoggingT m b
<*> loggerA :: LoggingT m a
loggerA = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b
forall a b. (a -> b) -> a -> b
$ \loggerFn :: Loc -> Text -> LogLevel -> LogStr -> IO ()
loggerFn ->
(LoggingT m (a -> b)
-> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m (a -> b)
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT LoggingT m (a -> b)
loggerF) Loc -> Text -> LogLevel -> LogStr -> IO ()
loggerFn
m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT LoggingT m a
loggerA) Loc -> Text -> LogLevel -> LogStr -> IO ()
loggerFn
{-# INLINE (<*>) #-}
#endif
#if MIN_VERSION_base(4, 9, 0)
instance (Fail.MonadFail m) => Fail.MonadFail (LoggingT m) where
fail :: String -> LoggingT m a
fail = m a -> LoggingT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m a -> LoggingT m a) -> (String -> m a) -> String -> LoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail
#endif
instance Monad m => Monad (LoggingT m) where
return :: a -> LoggingT m a
return = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a)
-> (a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> a
-> LoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall a b. a -> b -> a
const (m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> (a -> m a)
-> a
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
LoggingT ma :: (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
ma >>= :: LoggingT m a -> (a -> LoggingT m b) -> LoggingT m b
>>= f :: a -> LoggingT m b
f = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b
forall a b. (a -> b) -> a -> b
$ \r :: Loc -> Text -> LogLevel -> LogStr -> IO ()
r -> do
a
a <- (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
ma Loc -> Text -> LogLevel -> LogStr -> IO ()
r
let LoggingT f' :: (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b
f' = a -> LoggingT m b
f a
a
(Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b
f' Loc -> Text -> LogLevel -> LogStr -> IO ()
r
instance MonadIO m => MonadIO (LoggingT m) where
liftIO :: IO a -> LoggingT m a
liftIO = m a -> LoggingT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m a -> LoggingT m a) -> (IO a -> m a) -> IO a -> LoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance MonadThrow m => MonadThrow (LoggingT m) where
throwM :: e -> LoggingT m a
throwM = m a -> LoggingT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m a -> LoggingT m a) -> (e -> m a) -> e -> LoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
instance MonadCatch m => MonadCatch (LoggingT m) where
catch :: LoggingT m a -> (e -> LoggingT m a) -> LoggingT m a
catch (LoggingT m :: (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
m) c :: e -> LoggingT m a
c =
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall a b. (a -> b) -> a -> b
$ \r :: Loc -> Text -> LogLevel -> LogStr -> IO ()
r -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
m Loc -> Text -> LogLevel -> LogStr -> IO ()
r m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e :: e
e -> LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT (e -> LoggingT m a
c e
e) Loc -> Text -> LogLevel -> LogStr -> IO ()
r
instance MonadMask m => MonadMask (LoggingT m) where
mask :: ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b)
-> LoggingT m b
mask a :: (forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b
a = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b
forall a b. (a -> b) -> a -> b
$ \e :: Loc -> Text -> LogLevel -> LogStr -> IO ()
e -> ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \u :: forall a. m a -> m a
u -> LoggingT m b -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b
a ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b)
-> (forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> LoggingT m a -> LoggingT m a
forall (m :: * -> *) a (m :: * -> *) a.
(m a -> m a) -> LoggingT m a -> LoggingT m a
q m a -> m a
forall a. m a -> m a
u) Loc -> Text -> LogLevel -> LogStr -> IO ()
e
where q :: (m a -> m a) -> LoggingT m a -> LoggingT m a
q u :: m a -> m a
u (LoggingT b :: (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
b) = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (m a -> m a
u (m a -> m a)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
b)
uninterruptibleMask :: ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b)
-> LoggingT m b
uninterruptibleMask a :: (forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b
a =
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b
forall a b. (a -> b) -> a -> b
$ \e :: Loc -> Text -> LogLevel -> LogStr -> IO ()
e -> ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \u :: forall a. m a -> m a
u -> LoggingT m b -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b
a ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b)
-> (forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b
forall a b. (a -> b) -> a -> b
$ (m a -> m a) -> LoggingT m a -> LoggingT m a
forall (m :: * -> *) a (m :: * -> *) a.
(m a -> m a) -> LoggingT m a -> LoggingT m a
q m a -> m a
forall a. m a -> m a
u) Loc -> Text -> LogLevel -> LogStr -> IO ()
e
where q :: (m a -> m a) -> LoggingT m a -> LoggingT m a
q u :: m a -> m a
u (LoggingT b :: (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
b) = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (m a -> m a
u (m a -> m a)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
b)
#if MIN_VERSION_exceptions(0, 10, 0)
generalBracket :: LoggingT m a
-> (a -> ExitCase b -> LoggingT m c)
-> (a -> LoggingT m b)
-> LoggingT m (b, c)
generalBracket acquire :: LoggingT m a
acquire release :: a -> ExitCase b -> LoggingT m c
release use :: a -> LoggingT m b
use =
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m (b, c))
-> LoggingT m (b, c)
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m (b, c))
-> LoggingT m (b, c))
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m (b, c))
-> LoggingT m (b, c)
forall a b. (a -> b) -> a -> b
$ \e :: Loc -> Text -> LogLevel -> LogStr -> IO ()
e -> m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
(LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT LoggingT m a
acquire Loc -> Text -> LogLevel -> LogStr -> IO ()
e)
(\x :: a
x ec :: ExitCase b
ec -> LoggingT m c -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m c
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT (a -> ExitCase b -> LoggingT m c
release a
x ExitCase b
ec) Loc -> Text -> LogLevel -> LogStr -> IO ()
e)
(\x :: a
x -> LoggingT m b -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT (a -> LoggingT m b
use a
x) Loc -> Text -> LogLevel -> LogStr -> IO ()
e)
#elif MIN_VERSION_exceptions(0, 9, 0)
generalBracket acquire release releaseEx use =
LoggingT $ \e -> generalBracket
(runLoggingT acquire e)
(\x -> runLoggingT (release x) e)
(\x y -> runLoggingT (releaseEx x y) e)
(\x -> runLoggingT (use x) e)
#endif
instance MonadResource m => MonadResource (LoggingT m) where
liftResourceT :: ResourceT IO a -> LoggingT m a
liftResourceT = m a -> LoggingT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m a -> LoggingT m a)
-> (ResourceT IO a -> m a) -> ResourceT IO a -> LoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT IO a -> m a
forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT
instance MonadBase b m => MonadBase b (LoggingT m) where
liftBase :: b α -> LoggingT m α
liftBase = m α -> LoggingT m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m α -> LoggingT m α) -> (b α -> m α) -> b α -> LoggingT m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> m α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase
instance Trans.MonadTrans LoggingT where
lift :: m a -> LoggingT m a
lift = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a)
-> (m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> m a
-> LoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall a b. a -> b -> a
const
instance MonadTransControl LoggingT where
type StT LoggingT a = a
liftWith :: (Run LoggingT -> m a) -> LoggingT m a
liftWith f :: Run LoggingT -> m a
f = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall a b. (a -> b) -> a -> b
$ \r :: Loc -> Text -> LogLevel -> LogStr -> IO ()
r -> Run LoggingT -> m a
f (Run LoggingT -> m a) -> Run LoggingT -> m a
forall a b. (a -> b) -> a -> b
$ \(LoggingT t :: (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> n b
t) -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> n b
t Loc -> Text -> LogLevel -> LogStr -> IO ()
r
restoreT :: m (StT LoggingT a) -> LoggingT m a
restoreT = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a)
-> (m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> m a
-> LoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall a b. a -> b -> a
const
{-# INLINE liftWith #-}
{-# INLINE restoreT #-}
instance MonadBaseControl b m => MonadBaseControl b (LoggingT m) where
type StM (LoggingT m) a = StM m a
liftBaseWith :: (RunInBase (LoggingT m) b -> b a) -> LoggingT m a
liftBaseWith f :: RunInBase (LoggingT m) b -> b a
f = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall a b. (a -> b) -> a -> b
$ \reader' :: Loc -> Text -> LogLevel -> LogStr -> IO ()
reader' ->
(RunInBase m b -> b a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase m b -> b a) -> m a) -> (RunInBase m b -> b a) -> m a
forall a b. (a -> b) -> a -> b
$ \runInBase :: RunInBase m b
runInBase ->
RunInBase (LoggingT m) b -> b a
f (RunInBase (LoggingT m) b -> b a)
-> RunInBase (LoggingT m) b -> b a
forall a b. (a -> b) -> a -> b
$ m a -> b (StM m a)
RunInBase m b
runInBase (m a -> b (StM m a))
-> (LoggingT m a -> m a) -> LoggingT m a -> b (StM m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(LoggingT r :: (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
r) -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
r Loc -> Text -> LogLevel -> LogStr -> IO ()
reader')
restoreM :: StM (LoggingT m) a -> LoggingT m a
restoreM = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a)
-> (StM m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> StM m a
-> LoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall a b. a -> b -> a
const (m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> (StM m a -> m a)
-> StM m a
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM
instance MonadIO m => MonadLogger (LoggingT m) where
monadLoggerLog :: Loc -> Text -> LogLevel -> msg -> LoggingT m ()
monadLoggerLog a :: Loc
a b :: Text
b c :: LogLevel
c d :: msg
d = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m ())
-> LoggingT m ()
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m ())
-> LoggingT m ())
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m ())
-> LoggingT m ()
forall a b. (a -> b) -> a -> b
$ \f :: Loc -> Text -> LogLevel -> LogStr -> IO ()
f -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Loc -> Text -> LogLevel -> LogStr -> IO ()
f Loc
a Text
b LogLevel
c (msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
d)
instance MonadIO m => MonadLoggerIO (LoggingT m) where
askLoggerIO :: LoggingT m (Loc -> Text -> LogLevel -> LogStr -> IO ())
askLoggerIO = ((Loc -> Text -> LogLevel -> LogStr -> IO ())
-> m (Loc -> Text -> LogLevel -> LogStr -> IO ()))
-> LoggingT m (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> m (Loc -> Text -> LogLevel -> LogStr -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return
instance MonadUnliftIO m => MonadUnliftIO (LoggingT m) where
#if MIN_VERSION_unliftio_core(0, 1, 1)
{-# INLINE withRunInIO #-}
withRunInIO :: ((forall a. LoggingT m a -> IO a) -> IO b) -> LoggingT m b
withRunInIO inner :: (forall a. LoggingT m a -> IO a) -> IO b
inner =
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b
forall a b. (a -> b) -> a -> b
$ \r :: Loc -> Text -> LogLevel -> LogStr -> IO ()
r ->
((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO b) -> m b)
-> ((forall a. m a -> IO a) -> IO b) -> m b
forall a b. (a -> b) -> a -> b
$ \run :: forall a. m a -> IO a
run ->
(forall a. LoggingT m a -> IO a) -> IO b
inner (m a -> IO a
forall a. m a -> IO a
run (m a -> IO a) -> (LoggingT m a -> m a) -> LoggingT m a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LoggingT m a
-> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> LoggingT m a
-> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT Loc -> Text -> LogLevel -> LogStr -> IO ()
r)
#else
askUnliftIO =
LoggingT $ \f ->
withUnliftIO $ \u ->
return (UnliftIO (unliftIO u . flip runLoggingT f))
#endif
defaultOutput :: Handle
-> Loc
-> LogSource
-> LogLevel
-> LogStr
-> IO ()
defaultOutput :: Handle -> Loc -> Text -> LogLevel -> LogStr -> IO ()
defaultOutput h :: Handle
h loc :: Loc
loc src :: Text
src level :: LogLevel
level msg :: LogStr
msg =
Handle -> ByteString -> IO ()
S8.hPutStr Handle
h ByteString
ls
where
ls :: ByteString
ls = Loc -> Text -> LogLevel -> LogStr -> ByteString
defaultLogStrBS Loc
loc Text
src LogLevel
level LogStr
msg
defaultLogStrBS :: Loc
-> LogSource
-> LogLevel
-> LogStr
-> S8.ByteString
defaultLogStrBS :: Loc -> Text -> LogLevel -> LogStr -> ByteString
defaultLogStrBS a :: Loc
a b :: Text
b c :: LogLevel
c d :: LogStr
d =
LogStr -> ByteString
toBS (LogStr -> ByteString) -> LogStr -> ByteString
forall a b. (a -> b) -> a -> b
$ Loc -> Text -> LogLevel -> LogStr -> LogStr
defaultLogStr Loc
a Text
b LogLevel
c LogStr
d
where
toBS :: LogStr -> ByteString
toBS = LogStr -> ByteString
fromLogStr
defaultLogLevelStr :: LogLevel -> LogStr
defaultLogLevelStr :: LogLevel -> LogStr
defaultLogLevelStr level :: LogLevel
level = case LogLevel
level of
LevelOther t :: Text
t -> Text -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr Text
t
_ -> ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ByteString -> LogStr) -> ByteString -> LogStr
forall a b. (a -> b) -> a -> b
$ String -> ByteString
S8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop 5 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ LogLevel -> String
forall a. Show a => a -> String
show LogLevel
level
defaultLogStr :: Loc
-> LogSource
-> LogLevel
-> LogStr
-> LogStr
defaultLogStr :: Loc -> Text -> LogLevel -> LogStr -> LogStr
defaultLogStr loc :: Loc
loc src :: Text
src level :: LogLevel
level msg :: LogStr
msg =
"[" LogStr -> LogStr -> LogStr
forall a. Monoid a => a -> a -> a
`mappend` LogLevel -> LogStr
defaultLogLevelStr LogLevel
level LogStr -> LogStr -> LogStr
forall a. Monoid a => a -> a -> a
`mappend`
(if Text -> Bool
T.null Text
src
then LogStr
forall a. Monoid a => a
mempty
else "#" LogStr -> LogStr -> LogStr
forall a. Monoid a => a -> a -> a
`mappend` Text -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr Text
src) LogStr -> LogStr -> LogStr
forall a. Monoid a => a -> a -> a
`mappend`
"] " LogStr -> LogStr -> LogStr
forall a. Monoid a => a -> a -> a
`mappend`
LogStr
msg LogStr -> LogStr -> LogStr
forall a. Monoid a => a -> a -> a
`mappend`
(if Loc -> Bool
isDefaultLoc Loc
loc
then "\n"
else
" @(" LogStr -> LogStr -> LogStr
forall a. Monoid a => a -> a -> a
`mappend`
ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (String -> ByteString
S8.pack String
fileLocStr) LogStr -> LogStr -> LogStr
forall a. Monoid a => a -> a -> a
`mappend`
")\n")
where
fileLocStr :: String
fileLocStr = (Loc -> String
loc_package Loc
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ':' Char -> ShowS
forall a. a -> [a] -> [a]
: (Loc -> String
loc_module Loc
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: (Loc -> String
loc_filename Loc
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ':' Char -> ShowS
forall a. a -> [a] -> [a]
: (Loc -> String
line Loc
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ':' Char -> ShowS
forall a. a -> [a] -> [a]
: (Loc -> String
char Loc
loc)
where
line :: Loc -> String
line = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Loc -> Int) -> Loc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Loc -> (Int, Int)) -> Loc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> (Int, Int)
loc_start
char :: Loc -> String
char = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Loc -> Int) -> Loc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Loc -> (Int, Int)) -> Loc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> (Int, Int)
loc_start
runFileLoggingT :: MonadBaseControl IO m => FilePath -> LoggingT m a -> m a
runFileLoggingT :: String -> LoggingT m a -> m a
runFileLoggingT fp :: String
fp logt :: LoggingT m a
logt = m Handle -> (Handle -> m ()) -> (Handle -> m a) -> m a
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
(IO Handle -> m Handle
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> IO Handle
openFile String
fp IOMode
AppendMode)
(IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> (Handle -> IO ()) -> Handle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
hClose)
((Handle -> m a) -> m a) -> (Handle -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \h :: Handle
h -> IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering) m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT LoggingT m a
logt) (Handle -> Loc -> Text -> LogLevel -> LogStr -> IO ()
defaultOutput Handle
h)
runStderrLoggingT :: MonadIO m => LoggingT m a -> m a
runStderrLoggingT :: LoggingT m a -> m a
runStderrLoggingT = (LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
`runLoggingT` Handle -> Loc -> Text -> LogLevel -> LogStr -> IO ()
defaultOutput Handle
stderr)
runStdoutLoggingT :: MonadIO m => LoggingT m a -> m a
runStdoutLoggingT :: LoggingT m a -> m a
runStdoutLoggingT = (LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
`runLoggingT` Handle -> Loc -> Text -> LogLevel -> LogStr -> IO ()
defaultOutput Handle
stdout)
runChanLoggingT :: MonadIO m => Chan LogLine -> LoggingT m a -> m a
runChanLoggingT :: Chan LogLine -> LoggingT m a -> m a
runChanLoggingT chan :: Chan LogLine
chan = (LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
`runLoggingT` Chan LogLine -> Loc -> Text -> LogLevel -> LogStr -> IO ()
forall a b c d. Chan (a, b, c, d) -> a -> b -> c -> d -> IO ()
sink Chan LogLine
chan)
where
sink :: Chan (a, b, c, d) -> a -> b -> c -> d -> IO ()
sink chan' :: Chan (a, b, c, d)
chan' loc :: a
loc src :: b
src lvl :: c
lvl msg :: d
msg = Chan (a, b, c, d) -> (a, b, c, d) -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan (a, b, c, d)
chan' (a
loc,b
src,c
lvl,d
msg)
unChanLoggingT :: (MonadLogger m, MonadIO m) => Chan LogLine -> m void
unChanLoggingT :: Chan LogLine -> m void
unChanLoggingT chan :: Chan LogLine
chan = m () -> m void
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m void) -> m () -> m void
forall a b. (a -> b) -> a -> b
$ do
(loc :: Loc
loc,src :: Text
src,lvl :: LogLevel
lvl,msg :: LogStr
msg) <- IO LogLine -> m LogLine
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LogLine -> m LogLine) -> IO LogLine -> m LogLine
forall a b. (a -> b) -> a -> b
$ Chan LogLine -> IO LogLine
forall a. Chan a -> IO a
readChan Chan LogLine
chan
Loc -> Text -> LogLevel -> LogStr -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog Loc
loc Text
src LogLevel
lvl LogStr
msg
withChannelLogger :: (MonadBaseControl IO m, MonadIO m)
=> Int
-> LoggingT m a
-> LoggingT m a
withChannelLogger :: Int -> LoggingT m a -> LoggingT m a
withChannelLogger size :: Int
size action :: LoggingT m a
action = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall a b. (a -> b) -> a -> b
$ \logger :: Loc -> Text -> LogLevel -> LogStr -> IO ()
logger -> do
TBChan (IO ())
chan <- IO (TBChan (IO ())) -> m (TBChan (IO ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TBChan (IO ())) -> m (TBChan (IO ())))
-> IO (TBChan (IO ())) -> m (TBChan (IO ()))
forall a b. (a -> b) -> a -> b
$ Int -> IO (TBChan (IO ()))
forall a. Int -> IO (TBChan a)
newTBChanIO Int
size
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT LoggingT m a
action (TBChan (IO ())
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> Loc
-> Text
-> LogLevel
-> LogStr
-> IO ()
forall a t t t t.
TBChan a -> (t -> t -> t -> t -> a) -> t -> t -> t -> t -> IO ()
channelLogger TBChan (IO ())
chan Loc -> Text -> LogLevel -> LogStr -> IO ()
logger) m a -> m () -> m a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`onException` TBChan (IO ()) -> m ()
forall (m :: * -> *) a. MonadIO m => TBChan (IO a) -> m ()
dumpLogs TBChan (IO ())
chan
where
channelLogger :: TBChan a -> (t -> t -> t -> t -> a) -> t -> t -> t -> t -> IO ()
channelLogger chan :: TBChan a
chan logger :: t -> t -> t -> t -> a
logger loc :: t
loc src :: t
src lvl :: t
lvl str :: t
str = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool
full <- TBChan a -> STM Bool
forall a. TBChan a -> STM Bool
isFullTBChan TBChan a
chan
Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
full (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ STM a -> STM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (STM a -> STM ()) -> STM a -> STM ()
forall a b. (a -> b) -> a -> b
$ TBChan a -> STM a
forall a. TBChan a -> STM a
readTBChan TBChan a
chan
TBChan a -> a -> STM ()
forall a. TBChan a -> a -> STM ()
writeTBChan TBChan a
chan (a -> STM ()) -> a -> STM ()
forall a b. (a -> b) -> a -> b
$ t -> t -> t -> t -> a
logger t
loc t
src t
lvl t
str
dumpLogs :: TBChan (IO a) -> m ()
dumpLogs chan :: TBChan (IO a)
chan = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
[IO a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO a] -> IO ()) -> IO [IO a] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STM [IO a] -> IO [IO a]
forall a. STM a -> IO a
atomically (STM (IO a) -> STM Bool -> STM [IO a]
forall (m :: * -> *) a. Monad m => m a -> m Bool -> m [a]
untilM (TBChan (IO a) -> STM (IO a)
forall a. TBChan a -> STM a
readTBChan TBChan (IO a)
chan) (TBChan (IO a) -> STM Bool
forall a. TBChan a -> STM Bool
isEmptyTBChan TBChan (IO a)
chan))
filterLogger :: (LogSource -> LogLevel -> Bool)
-> LoggingT m a
-> LoggingT m a
filterLogger :: (Text -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
filterLogger p :: Text -> LogLevel -> Bool
p (LoggingT f :: (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
f) = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall a b. (a -> b) -> a -> b
$ \logger :: Loc -> Text -> LogLevel -> LogStr -> IO ()
logger ->
(Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
f ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall a b. (a -> b) -> a -> b
$ \loc :: Loc
loc src :: Text
src level :: LogLevel
level msg :: LogStr
msg ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> LogLevel -> Bool
p Text
src LogLevel
level) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Loc -> Text -> LogLevel -> LogStr -> IO ()
logger Loc
loc Text
src LogLevel
level LogStr
msg
instance MonadCont m => MonadCont (LoggingT m) where
callCC :: ((a -> LoggingT m b) -> LoggingT m a) -> LoggingT m a
callCC f :: (a -> LoggingT m b) -> LoggingT m a
f = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall a b. (a -> b) -> a -> b
$ \i :: Loc -> Text -> LogLevel -> LogStr -> IO ()
i -> ((a -> m b) -> m a) -> m a
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (((a -> m b) -> m a) -> m a) -> ((a -> m b) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \c :: a -> m b
c -> LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT ((a -> LoggingT m b) -> LoggingT m a
f (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> LoggingT m b)
-> (a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> a
-> LoggingT m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b
forall a b. a -> b -> a
const (m b -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m b)
-> (a -> m b)
-> a
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
c)) Loc -> Text -> LogLevel -> LogStr -> IO ()
i
instance MonadError e m => MonadError e (LoggingT m) where
throwError :: e -> LoggingT m a
throwError = m a -> LoggingT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m a -> LoggingT m a) -> (e -> m a) -> e -> LoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: LoggingT m a -> (e -> LoggingT m a) -> LoggingT m a
catchError r :: LoggingT m a
r h :: e -> LoggingT m a
h = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
forall a b. (a -> b) -> a -> b
$ \i :: Loc -> Text -> LogLevel -> LogStr -> IO ()
i -> LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT LoggingT m a
r Loc -> Text -> LogLevel -> LogStr -> IO ()
i m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \e :: e
e -> LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT (e -> LoggingT m a
h e
e) Loc -> Text -> LogLevel -> LogStr -> IO ()
i
instance MonadError e m => MonadError e (NoLoggingT m) where
throwError :: e -> NoLoggingT m a
throwError = m a -> NoLoggingT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m a -> NoLoggingT m a) -> (e -> m a) -> e -> NoLoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
catchError r :: NoLoggingT m a
r h :: e -> NoLoggingT m a
h = m a -> NoLoggingT m a
forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT (m a -> NoLoggingT m a) -> m a -> NoLoggingT m a
forall a b. (a -> b) -> a -> b
$ NoLoggingT m a -> m a
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT NoLoggingT m a
r m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \e :: e
e -> NoLoggingT m a -> m a
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT (e -> NoLoggingT m a
h e
e)
instance MonadRWS r w s m => MonadRWS r w s (LoggingT m)
instance MonadReader r m => MonadReader r (LoggingT m) where
ask :: LoggingT m r
ask = m r -> LoggingT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: (r -> r) -> LoggingT m a -> LoggingT m a
local = (m a -> m a) -> LoggingT m a -> LoggingT m a
forall (m :: * -> *) a (m :: * -> *) a.
(m a -> m a) -> LoggingT m a -> LoggingT m a
mapLoggingT ((m a -> m a) -> LoggingT m a -> LoggingT m a)
-> ((r -> r) -> m a -> m a)
-> (r -> r)
-> LoggingT m a
-> LoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
instance MonadReader r m => MonadReader r (NoLoggingT m) where
ask :: NoLoggingT m r
ask = m r -> NoLoggingT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: (r -> r) -> NoLoggingT m a -> NoLoggingT m a
local = (m a -> m a) -> NoLoggingT m a -> NoLoggingT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> NoLoggingT m a -> NoLoggingT n b
mapNoLoggingT ((m a -> m a) -> NoLoggingT m a -> NoLoggingT m a)
-> ((r -> r) -> m a -> m a)
-> (r -> r)
-> NoLoggingT m a
-> NoLoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
mapLoggingT :: (m a -> n b) -> LoggingT m a -> LoggingT n b
mapLoggingT :: (m a -> n b) -> LoggingT m a -> LoggingT n b
mapLoggingT f :: m a -> n b
f = ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> n b)
-> LoggingT n b
forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> n b)
-> LoggingT n b)
-> (LoggingT m a
-> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> n b)
-> LoggingT m a
-> LoggingT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m a -> n b
f (m a -> n b)
-> ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> n b)
-> (LoggingT m a
-> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT
instance MonadState s m => MonadState s (LoggingT m) where
get :: LoggingT m s
get = m s -> LoggingT m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift m s
forall s (m :: * -> *). MonadState s m => m s
get
put :: s -> LoggingT m ()
put = m () -> LoggingT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m () -> LoggingT m ()) -> (s -> m ()) -> s -> LoggingT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
instance MonadWriter w m => MonadWriter w (LoggingT m) where
tell :: w -> LoggingT m ()
tell = m () -> LoggingT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m () -> LoggingT m ()) -> (w -> m ()) -> w -> LoggingT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
listen :: LoggingT m a -> LoggingT m (a, w)
listen = (m a -> m (a, w)) -> LoggingT m a -> LoggingT m (a, w)
forall (m :: * -> *) a (m :: * -> *) a.
(m a -> m a) -> LoggingT m a -> LoggingT m a
mapLoggingT m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
pass :: LoggingT m (a, w -> w) -> LoggingT m a
pass = (m (a, w -> w) -> m a) -> LoggingT m (a, w -> w) -> LoggingT m a
forall (m :: * -> *) a (m :: * -> *) a.
(m a -> m a) -> LoggingT m a -> LoggingT m a
mapLoggingT m (a, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass
mapNoLoggingT :: (m a -> n b) -> NoLoggingT m a -> NoLoggingT n b
mapNoLoggingT :: (m a -> n b) -> NoLoggingT m a -> NoLoggingT n b
mapNoLoggingT f :: m a -> n b
f = n b -> NoLoggingT n b
forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT (n b -> NoLoggingT n b)
-> (NoLoggingT m a -> n b) -> NoLoggingT m a -> NoLoggingT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> n b
f (m a -> n b) -> (NoLoggingT m a -> m a) -> NoLoggingT m a -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoLoggingT m a -> m a
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT
instance MonadState s m => MonadState s (NoLoggingT m) where
get :: NoLoggingT m s
get = m s -> NoLoggingT m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift m s
forall s (m :: * -> *). MonadState s m => m s
get
put :: s -> NoLoggingT m ()
put = m () -> NoLoggingT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m () -> NoLoggingT m ()) -> (s -> m ()) -> s -> NoLoggingT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
instance MonadWriter w m => MonadWriter w (NoLoggingT m) where
tell :: w -> NoLoggingT m ()
tell = m () -> NoLoggingT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m () -> NoLoggingT m ()) -> (w -> m ()) -> w -> NoLoggingT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
listen :: NoLoggingT m a -> NoLoggingT m (a, w)
listen = (m a -> m (a, w)) -> NoLoggingT m a -> NoLoggingT m (a, w)
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> NoLoggingT m a -> NoLoggingT n b
mapNoLoggingT m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
pass :: NoLoggingT m (a, w -> w) -> NoLoggingT m a
pass = (m (a, w -> w) -> m a)
-> NoLoggingT m (a, w -> w) -> NoLoggingT m a
forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> NoLoggingT m a -> NoLoggingT n b
mapNoLoggingT m (a, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass
defaultLoc :: Loc
defaultLoc :: Loc
defaultLoc = String -> String -> String -> (Int, Int) -> (Int, Int) -> Loc
Loc "<unknown>" "<unknown>" "<unknown>" (0,0) (0,0)
isDefaultLoc :: Loc -> Bool
isDefaultLoc :: Loc -> Bool
isDefaultLoc (Loc "<unknown>" "<unknown>" "<unknown>" (0,0) (0,0)) = Bool
True
isDefaultLoc _ = Bool
False
logWithoutLoc :: (MonadLogger m, ToLogStr msg) => LogSource -> LogLevel -> msg -> m ()
logWithoutLoc :: Text -> LogLevel -> msg -> m ()
logWithoutLoc = Loc -> Text -> LogLevel -> msg -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog Loc
defaultLoc
logDebugN :: MonadLogger m => Text -> m ()
logDebugN :: Text -> m ()
logDebugN = Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Text -> LogLevel -> msg -> m ()
logWithoutLoc "" LogLevel
LevelDebug
logInfoN :: MonadLogger m => Text -> m ()
logInfoN :: Text -> m ()
logInfoN = Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Text -> LogLevel -> msg -> m ()
logWithoutLoc "" LogLevel
LevelInfo
logWarnN :: MonadLogger m => Text -> m ()
logWarnN :: Text -> m ()
logWarnN = Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Text -> LogLevel -> msg -> m ()
logWithoutLoc "" LogLevel
LevelWarn
logErrorN :: MonadLogger m => Text -> m ()
logErrorN :: Text -> m ()
logErrorN = Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Text -> LogLevel -> msg -> m ()
logWithoutLoc "" LogLevel
LevelError
logOtherN :: MonadLogger m => LogLevel -> Text -> m ()
logOtherN :: LogLevel -> Text -> m ()
logOtherN = Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Text -> LogLevel -> msg -> m ()
logWithoutLoc ""
logDebugNS :: MonadLogger m => Text -> Text -> m ()
logDebugNS :: Text -> Text -> m ()
logDebugNS src :: Text
src = Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Text -> LogLevel -> msg -> m ()
logWithoutLoc Text
src LogLevel
LevelDebug
logInfoNS :: MonadLogger m => Text -> Text -> m ()
logInfoNS :: Text -> Text -> m ()
logInfoNS src :: Text
src = Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Text -> LogLevel -> msg -> m ()
logWithoutLoc Text
src LogLevel
LevelInfo
logWarnNS :: MonadLogger m => Text -> Text -> m ()
logWarnNS :: Text -> Text -> m ()
logWarnNS src :: Text
src = Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Text -> LogLevel -> msg -> m ()
logWithoutLoc Text
src LogLevel
LevelWarn
logErrorNS :: MonadLogger m => Text -> Text -> m ()
logErrorNS :: Text -> Text -> m ()
logErrorNS src :: Text
src = Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Text -> LogLevel -> msg -> m ()
logWithoutLoc Text
src LogLevel
LevelError
logOtherNS :: MonadLogger m => Text -> LogLevel -> Text -> m ()
logOtherNS :: Text -> LogLevel -> Text -> m ()
logOtherNS = Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Text -> LogLevel -> msg -> m ()
logWithoutLoc
#if WITH_CALLSTACK
mkLoggerLoc :: GHC.SrcLoc -> Loc
mkLoggerLoc :: SrcLoc -> Loc
mkLoggerLoc loc :: SrcLoc
loc =
Loc :: String -> String -> String -> (Int, Int) -> (Int, Int) -> Loc
Loc { loc_filename :: String
loc_filename = SrcLoc -> String
GHC.srcLocFile SrcLoc
loc
, loc_package :: String
loc_package = SrcLoc -> String
GHC.srcLocPackage SrcLoc
loc
, loc_module :: String
loc_module = SrcLoc -> String
GHC.srcLocModule SrcLoc
loc
, loc_start :: (Int, Int)
loc_start = ( SrcLoc -> Int
GHC.srcLocStartLine SrcLoc
loc
, SrcLoc -> Int
GHC.srcLocStartCol SrcLoc
loc)
, loc_end :: (Int, Int)
loc_end = ( SrcLoc -> Int
GHC.srcLocEndLine SrcLoc
loc
, SrcLoc -> Int
GHC.srcLocEndCol SrcLoc
loc)
}
locFromCS :: GHC.CallStack -> Loc
locFromCS :: CallStack -> Loc
locFromCS cs :: CallStack
cs = case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
((_, loc :: SrcLoc
loc):_) -> SrcLoc -> Loc
mkLoggerLoc SrcLoc
loc
_ -> Loc
defaultLoc
logCS :: (MonadLogger m, ToLogStr msg)
=> GHC.CallStack
-> LogSource
-> LogLevel
-> msg
-> m ()
logCS :: CallStack -> Text -> LogLevel -> msg -> m ()
logCS cs :: CallStack
cs src :: Text
src lvl :: LogLevel
lvl msg :: msg
msg =
Loc -> Text -> LogLevel -> msg -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog (CallStack -> Loc
locFromCS CallStack
cs) Text
src LogLevel
lvl msg
msg
logDebugCS :: MonadLogger m => GHC.CallStack -> Text -> m ()
logDebugCS :: CallStack -> Text -> m ()
logDebugCS cs :: CallStack
cs msg :: Text
msg = CallStack -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> m ()
logCS CallStack
cs "" LogLevel
LevelDebug Text
msg
logInfoCS :: MonadLogger m => GHC.CallStack -> Text -> m ()
logInfoCS :: CallStack -> Text -> m ()
logInfoCS cs :: CallStack
cs msg :: Text
msg = CallStack -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> m ()
logCS CallStack
cs "" LogLevel
LevelInfo Text
msg
logWarnCS :: MonadLogger m => GHC.CallStack -> Text -> m ()
logWarnCS :: CallStack -> Text -> m ()
logWarnCS cs :: CallStack
cs msg :: Text
msg = CallStack -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> m ()
logCS CallStack
cs "" LogLevel
LevelWarn Text
msg
logErrorCS :: MonadLogger m => GHC.CallStack -> Text -> m ()
logErrorCS :: CallStack -> Text -> m ()
logErrorCS cs :: CallStack
cs msg :: Text
msg = CallStack -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> m ()
logCS CallStack
cs "" LogLevel
LevelError Text
msg
logOtherCS :: MonadLogger m => GHC.CallStack -> LogLevel -> Text -> m ()
logOtherCS :: CallStack -> LogLevel -> Text -> m ()
logOtherCS cs :: CallStack
cs lvl :: LogLevel
lvl msg :: Text
msg = CallStack -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> m ()
logCS CallStack
cs "" LogLevel
lvl Text
msg
#endif