{-# 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 #-}
-- |  This module provides the facilities needed for a decoupled logging system.
--
-- The 'MonadLogger' class is implemented by monads that give access to a
-- logging facility.  If you're defining a custom monad, then you may define an
-- instance of 'MonadLogger' that routes the log messages to the appropriate
-- place (e.g., that's what @yesod-core@'s @HandlerT@ does).  Otherwise, you
-- may use the 'LoggingT' monad included in this module (see
-- 'runStderrLoggingT'). To simply discard log message, use 'NoLoggingT'.
--
-- As a user of the logging facility, we provide you some convenient Template
-- Haskell splices that use the 'MonadLogger' class.  They will record their
-- source file and position, which is very helpful when debugging.  See
-- 'logDebug' for more information.
module Control.Monad.Logger
    ( -- * MonadLogger
      MonadLogger(..)
    , MonadLoggerIO (..)
    , LogLevel(..)
    , LogLine
    , LogSource
    -- * Re-export from fast-logger
    , LogStr
    , ToLogStr(..)
    , fromLogStr
    -- * Helper transformers
    , LoggingT (..)
    , runStderrLoggingT
    , runStdoutLoggingT
    , runChanLoggingT
    , runFileLoggingT
    , unChanLoggingT
    , withChannelLogger
    , filterLogger
    , NoLoggingT (..)
    , mapNoLoggingT
    , WriterLoggingT (..)
    , execWriterLoggingT
    , runWriterLoggingT
    , mapLoggingT
#if WITH_TEMPLATE_HASKELL
    -- * TH logging
    , logDebug
    , logInfo
    , logWarn
    , logError
    , logOther
    -- * TH logging of showable values
    , logDebugSH
    , logInfoSH
    , logWarnSH
    , logErrorSH
    , logOtherSH
    -- * TH logging with source
    , logDebugS
    , logInfoS
    , logWarnS
    , logErrorS
    , logOtherS
    -- * TH util
    , liftLoc
#endif
    -- * Non-TH logging
    , logDebugN
    , logInfoN
    , logWarnN
    , logErrorN
    , logOtherN
    -- * Non-TH logging with source
    , logWithoutLoc
    , logDebugNS
    , logInfoNS
    , logWarnNS
    , logErrorNS
    , logOtherNS
#if WITH_CALLSTACK
    -- * Callstack logging
    , logDebugCS
    , logInfoCS
    , logWarnCS
    , logErrorCS
    , logOtherCS
#endif
    -- * utilities for defining your own loggers
    , defaultLogStr
    -- $locDocs
    , 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 (Alternative (..), 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
$c== :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
/= :: 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
$cshowsPrec :: Int -> LogLevel -> ShowS
showsPrec :: Int -> LogLevel -> ShowS
$cshow :: LogLevel -> String
show :: LogLevel -> String
$cshowList :: [LogLevel] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS LogLevel
readsPrec :: Int -> ReadS LogLevel
$creadList :: ReadS [LogLevel]
readList :: ReadS [LogLevel]
$creadPrec :: ReadPrec LogLevel
readPrec :: ReadPrec LogLevel
$creadListPrec :: ReadPrec [LogLevel]
readListPrec :: ReadPrec [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
$ccompare :: LogLevel -> LogLevel -> Ordering
compare :: LogLevel -> LogLevel -> Ordering
$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
>= :: LogLevel -> LogLevel -> Bool
$cmax :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
min :: LogLevel -> LogLevel -> LogLevel
Ord)

type LogSource = Text

-- $locDocs
--
-- === Loc
--
-- When @monad-logger@ is compiled with the @template_haskell@ flag set to true (the default), the 'Loc' below is a re-export from the @template-haskell@ package.
-- When the flag is false, the 'Loc' below is a copy of that data structure defined in @monad-logger@ itself.
--
-- If you are making a library that:
--
-- * Uses @monad-logger@
-- * Uses 'Loc' in a type signature
-- * But doesn't need to depend on @template-haskell@ for other reasons
--
-- You can import 'Loc' directly from this package, instead of adding an dependency on @template-haskell@ and importing from there.
-- This allows users to compile your package in environments that don't support @template-haskell@.

#if WITH_TEMPLATE_HASKELL

instance Lift LogLevel where
    lift :: forall (m :: * -> *). Quote m => LogLevel -> m Exp
lift LogLevel
LevelDebug = [|LevelDebug|]
    lift LogLevel
LevelInfo  = [|LevelInfo|]
    lift LogLevel
LevelWarn  = [|LevelWarn|]
    lift LogLevel
LevelError = [|LevelError|]
    lift (LevelOther Text
x) = [|LevelOther $ pack $(String -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
lift (String -> m Exp) -> String -> m Exp
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
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

-- | A @Monad@ which has the ability to log messages in some manner.
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 (m :: * -> *) a. Monad m => m a -> t m a
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 msg. ToLogStr msg => 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

-- | An extension of @MonadLogger@ for the common case where the logging action
-- is a simple @IO@ action. The advantage of using this typeclass is that the
-- logging function itself can be extracted as a first-class value, which can
-- make it easier to manipulate monad transformer stacks, as an example.
--
-- @since 0.3.10
class (MonadLogger m, MonadIO m) => MonadLoggerIO m where
    -- | Request the logging function itself.
    --
    -- @since 0.3.10
    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 (m :: * -> *) a. Monad m => m a -> t m a
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


{-
instance MonadLogger IO          where monadLoggerLog _ _ _ = return ()
instance MonadLogger Identity    where monadLoggerLog _ _ _ = return ()
instance MonadLogger (ST s)      where monadLoggerLog _ _ _ = return ()
instance MonadLogger (Lazy.ST s) where monadLoggerLog _ _ _ = return ()
-}

#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 $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) (pack "") $(LogLevel -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => LogLevel -> m Exp
lift LogLevel
level)
     . (id :: Text -> Text)|]

-- | Generates a function that takes a 'LogLevel' and a 'Show a => a'.
--
-- @since 0.3.18
logTHShow :: LogLevel -> Q Exp
logTHShow :: LogLevel -> Q Exp
logTHShow LogLevel
level =
    [|monadLoggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) (pack "") $(LogLevel -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => LogLevel -> m Exp
lift LogLevel
level)
      . ((pack . show) :: Show a => a -> Text)|]

-- | Generates a function that takes a 'Text' and logs a 'LevelDebug' message. Usage:
--
-- > $(logDebug) "This is a debug log message"
logDebug :: Q Exp
logDebug :: Q Exp
logDebug = LogLevel -> Q Exp
logTH LogLevel
LevelDebug

-- | See 'logDebug'
logInfo :: Q Exp
logInfo :: Q Exp
logInfo = LogLevel -> Q Exp
logTH LogLevel
LevelInfo
-- | See 'logDebug'
logWarn :: Q Exp
logWarn :: Q Exp
logWarn = LogLevel -> Q Exp
logTH LogLevel
LevelWarn
-- | See 'logDebug'
logError :: Q Exp
logError :: Q Exp
logError = LogLevel -> Q Exp
logTH LogLevel
LevelError

-- | Generates a function that takes a 'Text' and logs a 'LevelOther' message. Usage:
--
-- > $(logOther "My new level") "This is a log message"
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


-- | Generates a function that takes a 'Show a => a' and logs a 'LevelDebug' message. Usage:
--
-- > $(logDebugSH) (Just "This is a debug log message")
--
-- @since 0.3.18
logDebugSH :: Q Exp
logDebugSH :: Q Exp
logDebugSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelDebug

-- | See 'logDebugSH'
logInfoSH :: Q Exp
logInfoSH :: Q Exp
logInfoSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelInfo
-- | See 'logDebugSH'
logWarnSH :: Q Exp
logWarnSH :: Q Exp
logWarnSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelWarn
-- | See 'logDebugSH'
logErrorSH :: Q Exp
logErrorSH :: Q Exp
logErrorSH = LogLevel -> Q Exp
logTHShow LogLevel
LevelError

-- | Generates a function that takes a 'Show a => a' and logs a 'LevelOther' message. Usage:
--
-- > $(logOtherSH "My new level") "This is a log message"
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

-- | Lift a location into an Exp.
--
-- @since 0.3.1
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
    $(String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
lift String
a)
    $(String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
lift String
b)
    $(String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
lift String
c)
    ($(Int -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
d1), $(Int -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
d2))
    ($(Int -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
e1), $(Int -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Int -> m Exp
lift Int
e2))
    |]

-- | Generates a function that takes a 'LogSource' and 'Text' and logs a 'LevelDebug' message. Usage:
--
-- > $logDebugS "SomeSource" "This is a debug log message"
logDebugS :: Q Exp
logDebugS :: Q Exp
logDebugS = [|\a b -> monadLoggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) a LevelDebug (b :: Text)|]

-- | See 'logDebugS'
logInfoS :: Q Exp
logInfoS :: Q Exp
logInfoS = [|\a b -> monadLoggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) a LevelInfo (b :: Text)|]
-- | See 'logDebugS'
logWarnS :: Q Exp
logWarnS :: Q Exp
logWarnS = [|\a b -> monadLoggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) a LevelWarn (b :: Text)|]
-- | See 'logDebugS'
logErrorS :: Q Exp
logErrorS :: Q Exp
logErrorS = [|\a b -> monadLoggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) a LevelError (b :: Text)|]

-- | Generates a function that takes a 'LogSource', a level name and a 'Text' and logs a 'LevelOther' message. Usage:
--
-- > $logOtherS "SomeSource" "My new level" "This is a log message"
logOtherS :: Q Exp
logOtherS :: Q Exp
logOtherS = [|\src level msg -> monadLoggerLog $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) src (LevelOther level) (msg :: Text)|]
#endif

-- | Monad transformer that disables logging.
--
-- @since 0.2.4
newtype NoLoggingT m a = NoLoggingT { forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT :: m a }
  deriving (
    (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
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> NoLoggingT m a -> NoLoggingT m b
fmap :: forall a b. (a -> b) -> NoLoggingT m a -> NoLoggingT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> NoLoggingT m b -> NoLoggingT m a
<$ :: forall a b. a -> NoLoggingT m b -> NoLoggingT m a
Functor, Functor (NoLoggingT m)
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)
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
$cpure :: forall (m :: * -> *) a. Applicative m => a -> NoLoggingT m a
pure :: forall a. a -> NoLoggingT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
NoLoggingT m (a -> b) -> NoLoggingT m a -> NoLoggingT m b
<*> :: forall a b.
NoLoggingT m (a -> b) -> NoLoggingT m a -> NoLoggingT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m c
liftA2 :: forall a b c.
(a -> b -> c) -> NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
*> :: forall a b. NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m a
<* :: forall a b. NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m a
Applicative, Applicative (NoLoggingT m)
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)
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
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
NoLoggingT m a -> (a -> NoLoggingT m b) -> NoLoggingT m b
>>= :: forall a b.
NoLoggingT m a -> (a -> NoLoggingT m b) -> NoLoggingT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
>> :: forall a b. NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> NoLoggingT m a
return :: forall a. a -> NoLoggingT m a
Monad, Monad (NoLoggingT m)
Monad (NoLoggingT m) =>
(forall a. IO a -> NoLoggingT m a) -> MonadIO (NoLoggingT m)
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
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> NoLoggingT m a
liftIO :: forall a. IO a -> NoLoggingT m a
MonadIO, Monad (NoLoggingT m)
Monad (NoLoggingT m) =>
(forall e a. (HasCallStack, Exception e) => e -> NoLoggingT m a)
-> MonadThrow (NoLoggingT m)
forall e a. (HasCallStack, Exception e) => e -> NoLoggingT m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (NoLoggingT m)
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> NoLoggingT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> NoLoggingT m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> NoLoggingT m a
MonadThrow, MonadThrow (NoLoggingT m)
MonadThrow (NoLoggingT m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a)
-> MonadCatch (NoLoggingT m)
forall e a.
(HasCallStack, Exception e) =>
NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (NoLoggingT m)
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
catch :: forall e a.
(HasCallStack, Exception e) =>
NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
MonadCatch, MonadCatch (NoLoggingT m)
MonadCatch (NoLoggingT m) =>
(forall b.
 HasCallStack =>
 ((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
 -> NoLoggingT m b)
-> (forall b.
    HasCallStack =>
    ((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
    -> NoLoggingT m b)
-> (forall a b c.
    HasCallStack =>
    NoLoggingT m a
    -> (a -> ExitCase b -> NoLoggingT m c)
    -> (a -> NoLoggingT m b)
    -> NoLoggingT m (b, c))
-> MonadMask (NoLoggingT m)
forall b.
HasCallStack =>
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
forall a b c.
HasCallStack =>
NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c)
forall (m :: * -> *). MonadMask m => MonadCatch (NoLoggingT m)
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
mask :: forall b.
HasCallStack =>
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
$cgeneralBracket :: forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c)
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
$cmonadActive :: forall (m :: * -> *). MonadActive m => NoLoggingT m Bool
monadActive :: NoLoggingT m Bool
MonadActive, MonadBase b
    , Applicative (NoLoggingT m)
Applicative (NoLoggingT m) =>
(forall a. NoLoggingT m a)
-> (forall a. NoLoggingT m a -> NoLoggingT m a -> NoLoggingT m a)
-> (forall a. NoLoggingT m a -> NoLoggingT m [a])
-> (forall a. NoLoggingT m a -> NoLoggingT m [a])
-> Alternative (NoLoggingT m)
forall a. NoLoggingT m a
forall a. NoLoggingT m a -> NoLoggingT m [a]
forall a. NoLoggingT m a -> NoLoggingT m a -> NoLoggingT m a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (m :: * -> *). Alternative m => Applicative (NoLoggingT m)
forall (m :: * -> *) a. Alternative m => NoLoggingT m a
forall (m :: * -> *) a.
Alternative m =>
NoLoggingT m a -> NoLoggingT m [a]
forall (m :: * -> *) a.
Alternative m =>
NoLoggingT m a -> NoLoggingT m a -> NoLoggingT m a
$cempty :: forall (m :: * -> *) a. Alternative m => NoLoggingT m a
empty :: forall a. NoLoggingT m a
$c<|> :: forall (m :: * -> *) a.
Alternative m =>
NoLoggingT m a -> NoLoggingT m a -> NoLoggingT m a
<|> :: forall a. NoLoggingT m a -> NoLoggingT m a -> NoLoggingT m a
$csome :: forall (m :: * -> *) a.
Alternative m =>
NoLoggingT m a -> NoLoggingT m [a]
some :: forall a. NoLoggingT m a -> NoLoggingT m [a]
$cmany :: forall (m :: * -> *) a.
Alternative m =>
NoLoggingT m a -> NoLoggingT m [a]
many :: forall a. NoLoggingT m a -> NoLoggingT m [a]
Alternative -- ^ @since 0.3.40
    )

-- For some reason GND is a fool on GHC 7.10 and older, we have to help it by providing the context explicitly.
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 (m :: * -> *) a. Monad m => m a -> LoggingT m a
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 :: forall (m :: * -> *) a. Monad m => 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 :: forall (m :: * -> *) a.
Monad m =>
(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 NoLoggingT n b -> n b
NoLoggingT n b -> n (StT NoLoggingT b)
Run NoLoggingT
forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT
    restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT NoLoggingT a) -> NoLoggingT m a
restoreT = m a -> NoLoggingT m a
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)
-- | @since 0.3.30
instance (Fail.MonadFail m) => Fail.MonadFail (NoLoggingT m) where
  fail :: forall a. String -> NoLoggingT m a
fail = m a -> NoLoggingT m a
forall (m :: * -> *) a. Monad m => 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 a. 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 :: forall a. (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 a. (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 :: forall a. 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 a. 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 :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> NoLoggingT m ()
monadLoggerLog Loc
_ Text
_ LogLevel
_ msg
_ = () -> NoLoggingT m ()
forall a. a -> NoLoggingT m a
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 a. a -> NoLoggingT m a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | @since 0.3.26
instance MonadUnliftIO m => MonadUnliftIO (NoLoggingT m) where
#if MIN_VERSION_unliftio_core(0, 1, 1)
  {-# INLINE withRunInIO #-}
  withRunInIO :: forall b.
((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 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 a b c.
(a -> b -> c) -> NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m c
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 a. a -> NoLoggingT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

-- | @since 0.3.32
type LogLine = (Loc, LogSource, LogLevel, LogStr)

-- | @since 0.3.28
newtype WriterLoggingT m a = WriterLoggingT { forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT :: m (a, DList LogLine) }

-- | Simple implementation of a difference list to support WriterLoggingT
newtype DList a = DList { forall a. DList a -> [a] -> [a]
unDList :: [a] -> [a] }

emptyDList :: DList a
emptyDList :: forall a. 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 :: forall a. 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 :: forall a. DList a -> [a]
dListToList (DList [a] -> [a]
dl) = [a] -> [a]
dl []

appendDList :: DList a -> DList a -> DList a
appendDList :: forall a. 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)

-- | Run a block using a @MonadLogger@ instance. Return a value and logs in a list
-- | @since 0.3.28
runWriterLoggingT :: Functor m => WriterLoggingT m a -> m (a, [LogLine])
runWriterLoggingT :: forall (m :: * -> *) a.
Functor m =>
WriterLoggingT m a -> m (a, [LogLine])
runWriterLoggingT (WriterLoggingT m (a, DList LogLine)
ma) = (DList LogLine -> [LogLine])
-> (a, DList LogLine) -> (a, [LogLine])
forall a b. (a -> b) -> (a, a) -> (a, b)
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

-- | Run a block using a @MonadLogger@ instance. Return logs in a list
-- | @since 0.3.28
execWriterLoggingT :: Functor m => WriterLoggingT m a -> m [LogLine]
execWriterLoggingT :: forall (m :: * -> *) a.
Functor m =>
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 :: forall a. 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 a. a -> WrappedMonad (WriterLoggingT m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  (WriterLoggingT m (a, DList LogLine)
ma) >>= :: forall a b.
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 a. a -> m a
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 :: forall a. 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 a. a -> m a
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 <*> :: forall a b.
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 a b. (a -> b) -> m a -> m b
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 a b. m (a -> b) -> m a -> m b
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 :: forall a b. (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 a b. (a -> b) -> m a -> m b
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 :: forall msg.
ToLogStr msg =>
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 a. a -> m a
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 :: forall (m :: * -> *) a. Monad m => 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 :: forall a. 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 a. 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 :: forall α. 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 :: forall (m :: * -> *) a.
Monad m =>
(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
$ WriterLoggingT n b -> n (b, DList LogLine)
WriterLoggingT n b -> n (StT WriterLoggingT b)
Run WriterLoggingT
forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT)
  restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT WriterLoggingT a) -> WriterLoggingT m a
restoreT = m (a, DList LogLine) -> WriterLoggingT m a
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 :: forall a.
(RunInBase (WriterLoggingT m) b -> b a) -> WriterLoggingT m a
liftBaseWith = (RunInBaseDefault WriterLoggingT m b -> b a) -> WriterLoggingT m a
(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 :: forall a. StM (WriterLoggingT m) a -> WriterLoggingT m a
restoreM = ComposeSt WriterLoggingT m a -> WriterLoggingT m a
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 :: forall e a. (HasCallStack, Exception e) => e -> WriterLoggingT m a
throwM = m a -> WriterLoggingT m a
forall (m :: * -> *) a. Monad m => 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 e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM

instance MonadCatch m => MonadCatch (WriterLoggingT m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
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 e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, 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 b.
HasCallStack =>
((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 b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((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 b.
HasCallStack =>
((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 b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((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 :: forall a b c.
HasCallStack =>
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 a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
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 a. a -> m a
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)
        -- In the two other cases, the base monad overrides @use@'s state
        -- changes and the state reverts to @w1@.
        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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 a. a -> m a
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 a b c.
(a -> b -> c)
-> WriterLoggingT m a -> WriterLoggingT m b -> WriterLoggingT m c
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 a. a -> WriterLoggingT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

-- | Monad transformer that adds a new logging function.
--
-- @since 0.2.2
newtype LoggingT m a = LoggingT { forall (m :: * -> *) a.
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 :: forall a b. (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 a b. (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 :: forall a. 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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE pure #-}
    LoggingT m (a -> b)
loggerF <*> :: forall a b. 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 a b. 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

-- | @since 0.3.40
instance (Alternative m) => Alternative (LoggingT m) where
  empty :: forall a. LoggingT m a
empty = ((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 -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
forall a b. a -> b -> a
const m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty)
  LoggingT (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
x <|> :: forall a. LoggingT m a -> LoggingT m a -> LoggingT m a
<|> LoggingT (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
y = ((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 ()
f -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
x Loc -> Text -> LogLevel -> LogStr -> IO ()
f m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
y Loc -> Text -> LogLevel -> LogStr -> IO ()
f)

#if MIN_VERSION_base(4, 9, 0)
-- | @since 0.3.30
instance (Fail.MonadFail m) => Fail.MonadFail (LoggingT m) where
  fail :: forall a. String -> LoggingT m a
fail = m a -> LoggingT m a
forall (m :: * -> *) a. Monad m => 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 a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail
#endif

instance Monad m => Monad (LoggingT m) where
    return :: forall a. 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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    LoggingT (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
ma >>= :: forall a b. 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 :: forall a. IO a -> LoggingT m a
liftIO = m a -> LoggingT m a
forall (m :: * -> *) a. Monad m => 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 a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadThrow m => MonadThrow (LoggingT m) where
    throwM :: forall e a. (HasCallStack, Exception e) => e -> LoggingT m a
throwM = m a -> LoggingT m a
forall (m :: * -> *) a. Monad m => 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 a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM
instance MonadCatch m => MonadCatch (LoggingT m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
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 e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, 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 b.
HasCallStack =>
((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 b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((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 b.
HasCallStack =>
((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 b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((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 :: forall a b c.
HasCallStack =>
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 a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
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 :: forall a. ResourceT IO a -> LoggingT m a
liftResourceT = m a -> LoggingT m a
forall (m :: * -> *) a. Monad m => 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 a. 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 :: forall α. b α -> LoggingT m α
liftBase = m α -> LoggingT m α
forall (m :: * -> *) a. Monad m => m a -> LoggingT m a
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 α
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance Trans.MonadTrans LoggingT where
    lift :: forall (m :: * -> *) a. Monad m => 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 :: forall (m :: * -> *) a.
Monad m =>
(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 :: forall (m :: * -> *) a.
Monad m =>
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 :: forall a. (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 a. (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 :: forall a. 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 a. 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 :: forall msg.
ToLogStr msg =>
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 a. IO a -> m a
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | @since 0.3.26
instance MonadUnliftIO m => MonadUnliftIO (LoggingT m) where
#if MIN_VERSION_unliftio_core(0, 1, 1)
  {-# INLINE withRunInIO #-}
  withRunInIO :: forall b.
((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 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. 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 a b c.
(a -> b -> c) -> LoggingT m a -> LoggingT m b -> LoggingT m c
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 a. a -> LoggingT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

-- | A default implementation of 'monadLoggerLog' that accepts a file
-- handle as the first argument.
--
-- This is used in the definition of 'runStdoutLoggingT':
--
-- @
-- 'runStdoutLoggingT' :: 'MonadIO' m => 'LoggingT' m a -> m a
-- 'runStdoutLoggingT' action =
--     'runLoggingT' action ('defaultOutput' 'stdout')
-- @
--
-- @since 0.3.36
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
    -- taken from file-location package
    -- turn the TH Loc loaction information into a human readable string
    -- leaving out the loc_end parameter
    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
{-
defaultLogStrWithoutLoc ::
    LogSource -> LogLevel -> LogStr -> LogStr
defaultLogStrWithoutLoc loc src level msg =
    "[" `mappend` defaultLogLevelStr level `mappend`
    (if T.null src
        then mempty
        else "#" `mappend` toLogStr src) `mappend`
    "] " `mappend`
    msg `mappend` "\n"
-}


-- | Run a block using a @MonadLogger@ instance which appends to the specified file.
--
-- @since 0.3.22
runFileLoggingT :: MonadBaseControl IO m => FilePath -> LoggingT m a -> m a
runFileLoggingT :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
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 α. IO α -> m α
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 α. 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 α. 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 a b. m a -> m b -> m b
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)

-- | Run a block using a @MonadLogger@ instance which prints to stderr.
--
-- @since 0.2.2
runStderrLoggingT :: MonadIO m => LoggingT m a -> m a
runStderrLoggingT :: forall (m :: * -> *) a. MonadIO m => 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)

-- | Run a block using a @MonadLogger@ instance which prints to stdout.
--
-- @since 0.2.2
runStdoutLoggingT :: MonadIO m => LoggingT m a -> m a
runStdoutLoggingT :: forall (m :: * -> *) a. MonadIO m => 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)

-- | Run a block using a @MonadLogger@ instance which writes tuples to an
--   unbounded channel.
--
--   The tuples can be extracted (ie. in another thread) with `unChanLoggingT`
--   or a custom extraction funtion, and written to a destination.
--
-- @since 0.3.17
runChanLoggingT :: MonadIO m => Chan LogLine -> LoggingT m a -> m a
runChanLoggingT :: forall (m :: * -> *) a.
MonadIO m =>
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)

-- | Read logging tuples from an unbounded channel and log them into a
--   `MonadLoggerIO` monad, forever.
--
--   For use in a dedicated thread with a channel fed by `runChanLoggingT`.
--
-- @since 0.3.17
unChanLoggingT :: (MonadLogger m, MonadIO m) => Chan LogLine -> m void
unChanLoggingT :: forall (m :: * -> *) void.
(MonadLogger m, MonadIO m) =>
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 a. IO a -> m a
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 msg. ToLogStr msg => Loc -> Text -> LogLevel -> msg -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog Loc
loc Text
src LogLevel
lvl LogStr
msg

-- | Within the 'LoggingT' monad, capture all log messages to a bounded
--   channel of the indicated size, and only actually log them if there is an
--   exception.
--
-- @since 0.3.2
withChannelLogger :: (MonadBaseControl IO m, MonadIO m)
                  => Int         -- ^ Number of messages to keep
                  -> LoggingT m a
                  -> LoggingT m a
withChannelLogger :: forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadIO m) =>
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 a. IO a -> m a
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 a. IO a -> m a
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))

-- | Only log messages passing the given predicate function.
--
-- This can be a convenient way, for example, to ignore debug level messages.
--
-- @since 0.3.13
filterLogger :: (LogSource -> LogLevel -> Bool)
             -> LoggingT m a
             -> LoggingT m a
filterLogger :: forall (m :: * -> *) a.
(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 :: forall a b. ((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 a b. ((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 :: forall a. e -> LoggingT m a
throwError = m a -> LoggingT m a
forall (m :: * -> *) a. Monad m => 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 a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a. 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 a. 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 :: forall a. e -> NoLoggingT m a
throwError = m a -> NoLoggingT m a
forall (m :: * -> *) a. Monad m => 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 a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a. 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 a. 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 (m :: * -> *) a. Monad m => m a -> LoggingT m a
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 :: forall a. (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 a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local

-- | @since 0.3.24
instance MonadReader r m => MonadReader r (NoLoggingT m) where
  ask :: NoLoggingT m r
ask = m r -> NoLoggingT m r
forall (m :: * -> *) a. Monad m => m a -> NoLoggingT m a
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 :: forall a. (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 a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local

-- | Map the unwrapped computation using the given function.
--
-- @since 0.3.29
mapLoggingT :: (m a -> n b) -> LoggingT m a -> LoggingT n b
mapLoggingT :: forall {m :: * -> *} {a} {m :: * -> *} {a}.
(m a -> m a) -> LoggingT m a -> LoggingT m a
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 (m :: * -> *) a. Monad m => m a -> LoggingT m a
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 (m :: * -> *) a. Monad m => m a -> LoggingT m a
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 (m :: * -> *) a. Monad m => m a -> LoggingT m a
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 :: forall a. 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 a. m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
  pass :: forall a. 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 a. m (a, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass

-- | Map the unwrapped computation using the given function.
--
-- @since 0.3.29
mapNoLoggingT :: (m a -> n b) -> NoLoggingT m a -> NoLoggingT n b
mapNoLoggingT :: forall (m :: * -> *) a (n :: * -> *) b.
(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 (m :: * -> *) a. Monad m => m a -> NoLoggingT m a
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 (m :: * -> *) a. Monad m => m a -> NoLoggingT m a
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 (m :: * -> *) a. Monad m => m a -> NoLoggingT m a
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 :: forall a. 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 a. m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
    pass :: forall a. 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 a. m (a, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass

-- | dummy location, used with 'logWithoutLoc'
--
-- @since 0.3.23
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

-- |
--
-- @since 0.3.23
logWithoutLoc :: (MonadLogger m, ToLogStr msg) => LogSource -> LogLevel -> msg -> m ()
logWithoutLoc :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Text -> LogLevel -> msg -> m ()
logWithoutLoc = Loc -> Text -> LogLevel -> msg -> m ()
forall msg. ToLogStr msg => 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 :: forall (m :: * -> *). MonadLogger m => 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 :: forall (m :: * -> *). MonadLogger m => 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 :: forall (m :: * -> *). MonadLogger m => 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 :: forall (m :: * -> *). MonadLogger m => 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 :: forall (m :: * -> *). MonadLogger m => 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 :: forall (m :: * -> *). MonadLogger m => 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 :: forall (m :: * -> *). MonadLogger m => 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 :: forall (m :: * -> *). MonadLogger m => 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 :: forall (m :: * -> *). MonadLogger m => 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 :: forall (m :: * -> *).
MonadLogger m =>
Text -> LogLevel -> Text -> m ()
logOtherNS = Text -> LogLevel -> Text -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Text -> LogLevel -> msg -> m ()
logWithoutLoc

#if WITH_CALLSTACK
-- Callstack based logging

mkLoggerLoc :: GHC.SrcLoc -> Loc
mkLoggerLoc :: SrcLoc -> Loc
mkLoggerLoc SrcLoc
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 :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> m ()
logCS CallStack
cs Text
src LogLevel
lvl msg
msg =
  Loc -> Text -> LogLevel -> msg -> m ()
forall msg. ToLogStr 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

-- | Logs a message with location given by 'CallStack'.
-- See 'Control.Monad.Logger.CallStack' for more convenient
-- functions for 'CallStack' based logging.
--
-- @since 0.3.19
logDebugCS :: MonadLogger m => GHC.CallStack -> Text -> m ()
logDebugCS :: forall (m :: * -> *). MonadLogger m => 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

-- | See 'logDebugCS'
--
-- @since 0.3.19
logInfoCS :: MonadLogger m => GHC.CallStack -> Text -> m ()
logInfoCS :: forall (m :: * -> *). MonadLogger m => 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

-- | See 'logDebugCS'
--
-- @since 0.3.19
logWarnCS :: MonadLogger m => GHC.CallStack -> Text -> m ()
logWarnCS :: forall (m :: * -> *). MonadLogger m => 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

-- | See 'logDebugCS'
--
-- @since 0.3.19
logErrorCS :: MonadLogger m => GHC.CallStack -> Text -> m ()
logErrorCS :: forall (m :: * -> *). MonadLogger m => 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

-- | See 'logDebugCS'
--
-- @since 0.3.19
logOtherCS :: MonadLogger m => GHC.CallStack -> LogLevel -> Text -> m ()
logOtherCS :: forall (m :: * -> *).
MonadLogger m =>
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