{-# 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
, defaultOutput
) 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.Maybe ( MaybeT )
#if !MIN_VERSION_transformers(0, 6, 0)
import Control.Monad.Trans.List ( ListT )
import Control.Monad.Trans.Error ( ErrorT, Error)
#endif
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 LogLevel
LevelDebug = [|LevelDebug|]
lift LogLevel
LevelInfo = [|LevelInfo|]
lift LogLevel
LevelWarn = [|LevelWarn|]
lift LogLevel
LevelError = [|LevelError|]
lift (LevelOther 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 Text
src LogLevel
lvl msg
msg = m' () -> t m' ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift (m' () -> t m' ()) -> m' () -> t 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
#if !MIN_VERSION_transformers(0, 6, 0)
instance MonadLogger m => MonadLogger (ListT m) where DEF
instance (MonadLogger m, Error e) => MonadLogger (ErrorT e m) where DEF
#endif
instance MonadLogger m => MonadLogger (MaybeT 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)
#if !MIN_VERSION_transformers(0, 6, 0)
instance MonadLoggerIO m => MonadLoggerIO (ListT m)
instance (MonadLoggerIO m, Error e) => MonadLoggerIO (ErrorT e m)
#endif
instance MonadLoggerIO m => MonadLoggerIO (MaybeT 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 LogLevel
level =
[|monadLoggerLog $(qLocation >>= liftLoc) (pack "") $(lift level)
. (id :: Text -> Text)|]
logTHShow :: LogLevel -> Q Exp
logTHShow :: LogLevel -> Q Exp
logTHShow 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 String
a String
b String
c (Int
d1, Int
d2) (Int
e1, 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 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 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 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 Loc
_ Text
_ LogLevel
_ msg
_ = () -> 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
$ \Loc
_ Text
_ LogLevel
_ LogStr
_ -> () -> 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 (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
$ \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
instance (Applicative m, Semigroup a) => Semigroup (NoLoggingT m a) where
<> :: NoLoggingT m a -> NoLoggingT m a -> NoLoggingT m a
(<>) = (a -> a -> a) -> NoLoggingT m a -> NoLoggingT m a -> NoLoggingT m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance (Applicative m, Monoid a) => Monoid (NoLoggingT m a) where
mempty :: NoLoggingT m a
mempty = a -> NoLoggingT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
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 [a] -> [a]
dl) = [a] -> [a]
dl []
appendDList :: DList a -> DList a -> DList a
appendDList :: DList a -> DList a -> DList a
appendDList DList a
dl1 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 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 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 m (a, DList LogLine)
ma) >>= :: WriterLoggingT m a
-> (a -> WriterLoggingT m b) -> WriterLoggingT m b
>>= 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, DList LogLine
msgs) <- m (a, DList LogLine)
ma
(b
a', 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 = 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 m (a -> b, DList LogLine)
mf <*> :: WriterLoggingT m (a -> b)
-> WriterLoggingT m a -> WriterLoggingT m b
<*> WriterLoggingT 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 (\((a -> b
f, DList LogLine
msgs), (a
a, 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 a -> b
f (WriterLoggingT 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, 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 Text
source LogLevel
level 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 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 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 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 (\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 (a, DList LogLine)
m) 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 -> 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 (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
$ \ 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 m (a, DList LogLine) -> m (a, DList LogLine)
u 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 (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
$ \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 m (a, DList LogLine) -> m (a, DList LogLine)
u 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 WriterLoggingT m a
acquire a -> ExitCase b -> WriterLoggingT m c
release 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, DList LogLine
_w12), (c
c, 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)
(\(a
resource, DList LogLine
w1) ExitCase (b, DList LogLine)
exitCase -> case ExitCase (b, DList LogLine)
exitCase of
ExitCaseSuccess (b
b, DList LogLine
w12) -> do
(c
c, 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 SomeException
e -> do
(c
c, 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)
ExitCase (b, DList LogLine)
ExitCaseAbort -> do
(c
c, 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))
(\(a
resource, DList LogLine
w1) -> do
(b
a, 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
instance (Applicative m, Semigroup a) => Semigroup (WriterLoggingT m a) where
<> :: WriterLoggingT m a -> WriterLoggingT m a -> WriterLoggingT m a
(<>) = (a -> a -> a)
-> WriterLoggingT m a -> WriterLoggingT m a -> WriterLoggingT m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance (Applicative m, Monoid a) => Monoid (WriterLoggingT m a) where
mempty :: WriterLoggingT m a
mempty = a -> WriterLoggingT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
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 a -> b
f 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
$ \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 #-}
LoggingT m (a -> b)
loggerF <*> :: LoggingT m (a -> b) -> LoggingT m a -> LoggingT m b
<*> 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
$ \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 (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
ma >>= :: LoggingT m a -> (a -> LoggingT m b) -> LoggingT m b
>>= 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
$ \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 (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 (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
m) 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
$ \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 -> 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 (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
$ \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
$ \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 m a -> m a
u (LoggingT (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 (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
$ \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
$ \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 m a -> m a
u (LoggingT (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 LoggingT m a
acquire a -> ExitCase b -> LoggingT m c
release 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
$ \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)
(\a
x 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)
(\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 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
$ \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 (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 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
$ \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 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 (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 Loc
a Text
b LogLevel
c 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
$ \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 (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
$ \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
$ \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
instance (Applicative m, Semigroup a) => Semigroup (LoggingT m a) where
<> :: LoggingT m a -> LoggingT m a -> LoggingT m a
(<>) = (a -> a -> a) -> LoggingT m a -> LoggingT m a -> LoggingT m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance (Applicative m, Monoid a) => Monoid (LoggingT m a) where
mempty :: LoggingT m a
mempty = a -> LoggingT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
defaultOutput :: Handle
-> Loc
-> LogSource
-> LogLevel
-> LogStr
-> IO ()
defaultOutput :: Handle -> Loc -> Text -> LogLevel -> LogStr -> IO ()
defaultOutput Handle
h Loc
loc Text
src LogLevel
level 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 Loc
a Text
b LogLevel
c LogStr
d =
LogStr -> ByteString
fromLogStr (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 LogLevel
level = case LogLevel
level of
LevelOther Text
t -> Text -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr Text
t
LogLevel
_ -> 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 Int
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 Text
src LogLevel
level LogStr
msg =
LogStr
"[" 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 -> 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 -> 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 LogStr
"\n"
else
LogStr
" @(" 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`
LogStr
")\n")
where
fileLocStr :: String
fileLocStr = (Loc -> String
loc_package Loc
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: (Loc -> String
loc_module Loc
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++
Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: (Loc -> String
loc_filename Loc
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: (Loc -> String
line Loc
loc) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
':' 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 String
fp 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
$ \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 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 (a, b, c, d)
chan' a
loc b
src c
lvl 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 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,Text
src,LogLevel
lvl,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 Int
size 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
$ \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 TBChan a
chan t -> t -> t -> t -> a
logger t
loc t
src t
lvl 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 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 Text -> LogLevel -> Bool
p (LoggingT (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
$ \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 Text
src LogLevel
level 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 (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
$ \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
$ \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 LoggingT m a
r 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
$ \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 -> 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 NoLoggingT m a
r 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 -> 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 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 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 String
"<unknown>" String
"<unknown>" String
"<unknown>" (Int
0,Int
0) (Int
0,Int
0)
isDefaultLoc :: Loc -> Bool
isDefaultLoc :: Loc -> Bool
isDefaultLoc (Loc String
"<unknown>" String
"<unknown>" String
"<unknown>" (Int
0,Int
0) (Int
0,Int
0)) = Bool
True
isDefaultLoc Loc
_ = 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 Text
"" 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 Text
"" 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 Text
"" 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 Text
"" 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 Text
""
logDebugNS :: MonadLogger m => LogSource -> Text -> m ()
logDebugNS :: Text -> Text -> m ()
logDebugNS 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 => LogSource -> Text -> m ()
logInfoNS :: Text -> Text -> m ()
logInfoNS 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 => LogSource -> Text -> m ()
logWarnNS :: Text -> Text -> m ()
logWarnNS 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 => LogSource -> Text -> m ()
logErrorNS :: Text -> Text -> m ()
logErrorNS 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 => LogSource -> 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 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 CallStack
cs = case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
((String
_, SrcLoc
loc):[(String, SrcLoc)]
_) -> SrcLoc -> Loc
mkLoggerLoc SrcLoc
loc
[(String, SrcLoc)]
_ -> Loc
defaultLoc
logCS :: (MonadLogger m, ToLogStr msg)
=> GHC.CallStack
-> LogSource
-> LogLevel
-> msg
-> m ()
logCS :: CallStack -> Text -> LogLevel -> msg -> m ()
logCS CallStack
cs Text
src LogLevel
lvl 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 CallStack
cs Text
msg = CallStack -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> m ()
logCS CallStack
cs Text
"" LogLevel
LevelDebug Text
msg
logInfoCS :: MonadLogger m => GHC.CallStack -> Text -> m ()
logInfoCS :: CallStack -> Text -> m ()
logInfoCS CallStack
cs Text
msg = CallStack -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> m ()
logCS CallStack
cs Text
"" LogLevel
LevelInfo Text
msg
logWarnCS :: MonadLogger m => GHC.CallStack -> Text -> m ()
logWarnCS :: CallStack -> Text -> m ()
logWarnCS CallStack
cs Text
msg = CallStack -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> m ()
logCS CallStack
cs Text
"" LogLevel
LevelWarn Text
msg
logErrorCS :: MonadLogger m => GHC.CallStack -> Text -> m ()
logErrorCS :: CallStack -> Text -> m ()
logErrorCS CallStack
cs Text
msg = CallStack -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> m ()
logCS CallStack
cs Text
"" LogLevel
LevelError Text
msg
logOtherCS :: MonadLogger m => GHC.CallStack -> LogLevel -> Text -> m ()
logOtherCS :: CallStack -> LogLevel -> Text -> m ()
logOtherCS CallStack
cs LogLevel
lvl Text
msg = CallStack -> Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> m ()
logCS CallStack
cs Text
"" LogLevel
lvl Text
msg
#endif