{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Prelude.Show, ReadPrec [LogLevel]
ReadPrec LogLevel
Int -> ReadS LogLevel
ReadS [LogLevel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogLevel]
$creadListPrec :: ReadPrec [LogLevel]
readPrec :: ReadPrec LogLevel
$creadPrec :: ReadPrec LogLevel
readList :: ReadS [LogLevel]
$creadList :: ReadS [LogLevel]
readsPrec :: Int -> ReadS LogLevel
$creadsPrec :: Int -> ReadS LogLevel
Prelude.Read, Eq LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c< :: LogLevel -> LogLevel -> Bool
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
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 $(lift $ unpack x)|]

#else

data Loc
  = Loc { loc_filename :: String
    , loc_package  :: String
    , loc_module   :: String
    , loc_start    :: CharPos
    , loc_end      :: CharPos }
type CharPos = (Int, Int)

#endif

-- | 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall a b. (a -> b) -> a -> b
$ 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift 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 $(qLocation >>= liftLoc) (pack "") $(lift 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 $(qLocation >>= liftLoc) (pack "") $(lift 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 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 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
    $(lift a)
    $(lift b)
    $(lift c)
    ($(lift d1), $(lift d2))
    ($(lift e1), $(lift 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 $(qLocation >>= liftLoc) a LevelDebug (b :: Text)|]

-- | See 'logDebugS'
logInfoS :: Q Exp
logInfoS :: Q Exp
logInfoS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelInfo (b :: Text)|]
-- | See 'logDebugS'
logWarnS :: Q Exp
logWarnS :: Q Exp
logWarnS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelWarn (b :: Text)|]
-- | See 'logDebugS'
logErrorS :: Q Exp
logErrorS :: Q Exp
logErrorS = [|\a b -> monadLoggerLog $(qLocation >>= 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 $(qLocation >>= 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 -> 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
<$ :: forall a b. a -> NoLoggingT m b -> NoLoggingT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> NoLoggingT m b -> NoLoggingT m a
fmap :: forall a b. (a -> b) -> NoLoggingT m a -> NoLoggingT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> NoLoggingT m a -> NoLoggingT m b
Functor, 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
<* :: forall a b. NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m a
*> :: 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 b
liftA2 :: forall a b c.
(a -> b -> c) -> NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m c
<*> :: forall a b.
NoLoggingT m (a -> b) -> NoLoggingT m a -> NoLoggingT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
NoLoggingT m (a -> b) -> NoLoggingT m a -> NoLoggingT m b
pure :: forall a. a -> NoLoggingT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> NoLoggingT m a
Applicative, forall a. a -> NoLoggingT m a
forall a b. NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
forall a b.
NoLoggingT m a -> (a -> NoLoggingT m b) -> NoLoggingT m b
forall {m :: * -> *}. Monad m => Applicative (NoLoggingT m)
forall (m :: * -> *) a. Monad m => a -> NoLoggingT m a
forall (m :: * -> *) a b.
Monad m =>
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
forall (m :: * -> *) a b.
Monad m =>
NoLoggingT m a -> (a -> NoLoggingT m b) -> NoLoggingT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> NoLoggingT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> NoLoggingT m a
>> :: forall a b. NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
NoLoggingT m a -> NoLoggingT m b -> NoLoggingT m b
>>= :: forall a b.
NoLoggingT m a -> (a -> NoLoggingT m b) -> NoLoggingT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
NoLoggingT m a -> (a -> NoLoggingT m b) -> NoLoggingT m b
Monad, forall a. IO a -> NoLoggingT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (NoLoggingT m)
forall (m :: * -> *) a. MonadIO m => IO a -> NoLoggingT m a
liftIO :: forall a. IO a -> NoLoggingT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> NoLoggingT m a
MonadIO, forall e a. Exception e => e -> NoLoggingT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall {m :: * -> *}. MonadThrow m => Monad (NoLoggingT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> NoLoggingT m a
throwM :: forall e a. Exception e => e -> NoLoggingT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> NoLoggingT m a
MonadThrow, forall e a.
Exception e =>
NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall {m :: * -> *}. MonadCatch m => MonadThrow (NoLoggingT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
catch :: forall e a.
Exception e =>
NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
NoLoggingT m a -> (e -> NoLoggingT m a) -> NoLoggingT m a
MonadCatch, forall b.
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
forall a b c.
NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c)
forall {m :: * -> *}. MonadMask m => MonadCatch (NoLoggingT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
forall (m :: * -> *) a b c.
MonadMask m =>
NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
NoLoggingT m a
-> (a -> ExitCase b -> NoLoggingT m c)
-> (a -> NoLoggingT m b)
-> NoLoggingT m (b, c)
uninterruptibleMask :: forall b.
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
mask :: forall b.
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b)
-> NoLoggingT m b
MonadMask, NoLoggingT m Bool
forall (m :: * -> *). Monad m -> m Bool -> MonadActive m
forall {m :: * -> *}. MonadActive m => Monad (NoLoggingT m)
forall (m :: * -> *). MonadActive m => NoLoggingT m Bool
monadActive :: NoLoggingT m Bool
$cmonadActive :: forall (m :: * -> *). MonadActive m => NoLoggingT m Bool
MonadActive, MonadBase b
    , 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
many :: forall a. NoLoggingT m a -> NoLoggingT m [a]
$cmany :: forall (m :: * -> *) a.
Alternative m =>
NoLoggingT m a -> NoLoggingT m [a]
some :: forall a. NoLoggingT m a -> NoLoggingT m [a]
$csome :: forall (m :: * -> *) a.
Alternative m =>
NoLoggingT m a -> NoLoggingT m [a]
<|> :: forall a. NoLoggingT m a -> NoLoggingT m a -> NoLoggingT m a
$c<|> :: forall (m :: * -> *) a.
Alternative m =>
NoLoggingT m a -> NoLoggingT m a -> NoLoggingT m a
empty :: forall a. NoLoggingT m a
$cempty :: forall (m :: * -> *) a. Alternative m => 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall (m :: * -> *). MonadActive m => m Bool
monadActive

instance Trans.MonadTrans NoLoggingT where
    lift :: forall (m :: * -> *) a. Monad m => m a -> NoLoggingT m a
lift = 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 = forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT forall a b. (a -> b) -> a -> b
$ Run NoLoggingT -> m a
f forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT
    restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT NoLoggingT a) -> NoLoggingT m a
restoreT = 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT forall a b. (a -> b) -> a -> b
$
         forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith forall a b. (a -> b) -> a -> b
$ \RunInBase m b
runInBase ->
             RunInBase (NoLoggingT m) b -> b a
f forall a b. (a -> b) -> a -> b
$ RunInBase m b
runInBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT
     restoreM :: forall a. StM (NoLoggingT m) a -> NoLoggingT m a
restoreM = forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
_ = 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Loc
_ Text
_ LogLevel
_ LogStr
_ -> 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 =
    forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
    (forall a. NoLoggingT m a -> IO a) -> IO b
inner (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)

instance (Applicative m, Monoid a) => Monoid (NoLoggingT m a) where
  mempty :: NoLoggingT m a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall a. ([a] -> [a]) -> DList a
DList forall a. a -> a
id

singleton :: a -> DList a
singleton :: forall a. a -> DList a
singleton = forall a. ([a] -> [a]) -> DList a
DList 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 = forall a. ([a] -> [a]) -> DList a
DList (forall a. DList a -> [a] -> [a]
unDList DList a
dl1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. DList a -> [a]
dListToList 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 = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall a b. (a -> b) -> a -> b
$ do
    (a
a, DList LogLine
msgs)   <- m (a, DList LogLine)
ma
    (b
a', DList LogLine
msgs') <- forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT forall a b. (a -> b) -> a -> b
$ a -> WriterLoggingT m b
f a
a
    forall (m :: * -> *) a. Monad m => a -> m a
return (b
a', 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 = forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (a
a, 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 = forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall a b. (a -> b) -> a -> 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, forall a. DList a -> DList a -> DList a
appendDList DList LogLine
msgs DList LogLine
msgs')) ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a -> b, DList LogLine)
mf 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) = forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall a b. (a -> b) -> a -> 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 = forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ((), forall a. a -> DList a
singleton (Loc
loc, Text
source, LogLevel
level, 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 = forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall a b. (a -> b) -> a -> b
$ (, forall a. DList a
emptyDList) 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 = forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall a b. (a -> b) -> a -> b
$ (, forall a. DList a
emptyDList) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` 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 = 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 = forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\a
x -> (a
x, forall a. DList a
emptyDList))
                                      (Run WriterLoggingT -> m a
f forall a b. (a -> b) -> a -> b
$ 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 = 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 = 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 = 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. Exception e => e -> WriterLoggingT m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadCatch m => MonadCatch (WriterLoggingT m) where
  catch :: forall e a.
Exception e =>
WriterLoggingT m a
-> (e -> WriterLoggingT m a) -> WriterLoggingT m a
catch (WriterLoggingT m (a, DList LogLine)
m) e -> WriterLoggingT m a
c =
      forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall a b. (a -> b) -> a -> b
$ m (a, DList LogLine)
m forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> 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.
((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 = forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \ forall a. m a -> m a
u ->  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 b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a} {m :: * -> *} {a}.
(m (a, DList LogLine) -> m (a, DList LogLine))
-> WriterLoggingT m a -> WriterLoggingT m a
q 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 = forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall a b. (a -> b) -> a -> b
$ m (a, DList LogLine) -> m (a, DList LogLine)
u (forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT WriterLoggingT m a
b)

  uninterruptibleMask :: forall b.
((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 = forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> 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 b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a} {m :: * -> *} {a}.
(m (a, DList LogLine) -> m (a, DList LogLine))
-> WriterLoggingT m a -> WriterLoggingT m a
q 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 = forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall a b. (a -> b) -> a -> b
$ m (a, DList LogLine) -> m (a, DList LogLine)
u (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.
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 = forall (m :: * -> *) a. m (a, DList LogLine) -> WriterLoggingT m a
WriterLoggingT forall a b. (a -> b) -> a -> b
$ do
    ((b
b, DList LogLine
_w12), (c
c, DList LogLine
w123)) <- forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (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) <- forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT (a -> ExitCase b -> WriterLoggingT m c
release a
resource (forall a. a -> ExitCase a
ExitCaseSuccess b
b))
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, 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) <- forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT (a -> ExitCase b -> WriterLoggingT m c
release a
resource (forall a. SomeException -> ExitCase a
ExitCaseException SomeException
e))
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, 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) <- forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT (a -> ExitCase b -> WriterLoggingT m c
release a
resource forall a. ExitCase a
ExitCaseAbort)
          forall (m :: * -> *) a. Monad m => a -> m a
return (c
c, 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) <- forall (m :: * -> *) a. WriterLoggingT m a -> m (a, DList LogLine)
unWriterLoggingT (a -> WriterLoggingT m b
use a
resource)
        forall (m :: * -> *) a. Monad m => a -> m a
return (b
a, forall a. DList a -> DList a -> DList a
appendDList DList LogLine
w1 DList LogLine
w2))
    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
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)

instance (Applicative m, Monoid a) => Monoid (WriterLoggingT m a) where
  mempty :: WriterLoggingT m a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall a b. (a -> b) -> a -> b
$ \Loc -> Text -> LogLevel -> LogStr -> IO ()
loggerFn -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall a b. (a -> b) -> a -> b
$ (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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall a b. (a -> b) -> a -> b
$ \Loc -> Text -> LogLevel -> LogStr -> IO ()
loggerFn ->
                                       (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
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (forall a b. a -> b -> a
const 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 = 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 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadThrow m => MonadThrow (LoggingT m) where
    throwM :: forall e a. Exception e => e -> LoggingT m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
instance MonadCatch m => MonadCatch (LoggingT m) where
  catch :: forall e a.
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 =
      forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT 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 forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \e
e -> 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.
((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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall a b. (a -> b) -> a -> b
$ \Loc -> Text -> LogLevel -> LogStr -> IO ()
e -> forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> 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 b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a} {m :: * -> *} {a}.
(m a -> m a) -> LoggingT m a -> LoggingT m a
q 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) = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
b)
  uninterruptibleMask :: forall b.
((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 =
    forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall a b. (a -> b) -> a -> b
$ \Loc -> Text -> LogLevel -> LogStr -> IO ()
e -> forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u -> 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 b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a} {m :: * -> *} {a}.
(m a -> m a) -> LoggingT m a -> LoggingT m a
q 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) = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT (m a -> m a
u 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.
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 =
    forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall a b. (a -> b) -> a -> b
$ \Loc -> Text -> LogLevel -> LogStr -> IO ()
e -> forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
generalBracket
      (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 -> 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 -> 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall a b. (a -> b) -> a -> b
$ \Loc -> Text -> LogLevel -> LogStr -> IO ()
r -> Run LoggingT -> m a
f 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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall a b. (a -> b) -> a -> b
$ \Loc -> Text -> LogLevel -> LogStr -> IO ()
reader' ->
         forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith forall a b. (a -> b) -> a -> b
$ \RunInBase m b
runInBase ->
             RunInBase (LoggingT m) b -> b a
f forall a b. (a -> b) -> a -> b
$ RunInBase m b
runInBase 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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall a b. (a -> b) -> a -> b
$ \Loc -> Text -> LogLevel -> LogStr -> IO ()
f -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Loc -> Text -> LogLevel -> LogStr -> IO ()
f Loc
a Text
b LogLevel
c (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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT 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 =
    forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall a b. (a -> b) -> a -> b
$ \Loc -> Text -> LogLevel -> LogStr -> IO ()
r ->
    forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run ->
    (forall a. LoggingT m a -> IO a) -> IO b
inner (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip 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
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)

instance (Applicative m, Monoid a) => Monoid (LoggingT m a) where
  mempty :: LoggingT m a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 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 -> forall msg. ToLogStr msg => msg -> LogStr
toLogStr Text
t
    LogLevel
_            -> forall msg. ToLogStr msg => msg -> LogStr
toLogStr forall a b. (a -> b) -> a -> b
$ String -> ByteString
S8.pack forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
5 forall a b. (a -> b) -> a -> b
$ 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
"[" forall a. Monoid a => a -> a -> a
`mappend` LogLevel -> LogStr
defaultLogLevelStr LogLevel
level forall a. Monoid a => a -> a -> a
`mappend`
    (if Text -> Bool
T.null Text
src
        then forall a. Monoid a => a
mempty
        else LogStr
"#" forall a. Monoid a => a -> a -> a
`mappend` forall msg. ToLogStr msg => msg -> LogStr
toLogStr Text
src) forall a. Monoid a => a -> a -> a
`mappend`
    LogStr
"] " forall a. Monoid a => a -> a -> a
`mappend`
    LogStr
msg forall a. Monoid a => a -> a -> a
`mappend`
    (if Loc -> Bool
isDefaultLoc Loc
loc
        then LogStr
"\n"
        else
            LogStr
" @(" forall a. Monoid a => a -> a -> a
`mappend`
            forall msg. ToLogStr msg => msg -> LogStr
toLogStr (String -> ByteString
S8.pack String
fileLocStr) 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) forall a. [a] -> [a] -> [a]
++ Char
':' forall a. a -> [a] -> [a]
: (Loc -> String
loc_module Loc
loc) forall a. [a] -> [a] -> [a]
++
      Char
' ' forall a. a -> [a] -> [a]
: (Loc -> String
loc_filename Loc
loc) forall a. [a] -> [a] -> [a]
++ Char
':' forall a. a -> [a] -> [a]
: (Loc -> String
line Loc
loc) forall a. [a] -> [a] -> [a]
++ Char
':' forall a. a -> [a] -> [a]
: (Loc -> String
char Loc
loc)
      where
        line :: Loc -> String
line = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> (Int, Int)
loc_start
        char :: Loc -> String
char = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd 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 = forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    (forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ String -> IOMode -> IO Handle
openFile String
fp IOMode
AppendMode)
    (forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
hClose)
    forall a b. (a -> b) -> a -> b
$ \Handle
h -> forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (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 = (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 = (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 = (forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
`runLoggingT` 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 = 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 = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
    (Loc
loc,Text
src,LogLevel
lvl,LogStr
msg) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Chan a -> IO a
readChan Chan LogLine
chan
    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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall a b. (a -> b) -> a -> b
$ \Loc -> Text -> LogLevel -> LogStr -> IO ()
logger -> do
    TBChan (IO ())
chan <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Int -> IO (TBChan a)
newTBChanIO Int
size
    forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT LoggingT m a
action (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) forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`onException` 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 = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
        Bool
full <- forall a. TBChan a -> STM Bool
isFullTBChan TBChan a
chan
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
full forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. TBChan a -> STM a
readTBChan TBChan a
chan
        forall a. TBChan a -> a -> STM ()
writeTBChan TBChan a
chan 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. STM a -> IO a
atomically (forall (m :: * -> *) a. Monad m => m a -> m Bool -> m [a]
untilM (forall a. TBChan a -> STM a
readTBChan TBChan (IO a)
chan) (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) = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall a b. (a -> b) -> a -> b
$ \Loc -> Text -> LogLevel -> LogStr -> IO ()
logger ->
    (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
f forall a b. (a -> b) -> a -> b
$ \Loc
loc Text
src LogLevel
level LogStr
msg ->
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> LogLevel -> Bool
p Text
src LogLevel
level) 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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall a b. (a -> b) -> a -> b
$ \Loc -> Text -> LogLevel -> LogStr -> IO ()
i -> forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC forall a b. (a -> b) -> a -> b
$ \a -> m b
c -> forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT ((a -> LoggingT m b) -> LoggingT m a
f (forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall a b. (a -> b) -> a -> b
$ \Loc -> Text -> LogLevel -> LogStr -> IO ()
i -> forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT LoggingT m a
r Loc -> Text -> LogLevel -> LogStr -> IO ()
i forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \e
e -> 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT NoLoggingT m a
r forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \e
e -> 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> LoggingT m a -> LoggingT m a
local = forall {m :: * -> *} {a} {m :: * -> *} {a}.
(m a -> m a) -> LoggingT m a -> LoggingT m a
mapLoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> NoLoggingT m a -> NoLoggingT m a
local = forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> NoLoggingT m a -> NoLoggingT n b
mapNoLoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a.
((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a)
-> LoggingT m a
LoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m a -> n b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> LoggingT m ()
put = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put

instance MonadWriter w m => MonadWriter w (LoggingT m) where
  tell :: w -> LoggingT m ()
tell   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: forall a. LoggingT m a -> LoggingT m (a, w)
listen = forall {m :: * -> *} {a} {m :: * -> *} {a}.
(m a -> m a) -> LoggingT m a -> LoggingT m a
mapLoggingT 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   = forall {m :: * -> *} {a} {m :: * -> *} {a}.
(m a -> m a) -> LoggingT m a -> LoggingT m a
mapLoggingT 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 = forall (m :: * -> *) a. m a -> NoLoggingT m a
NoLoggingT forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> n b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. NoLoggingT m a -> m a
runNoLoggingT

instance MonadState s m => MonadState s (NoLoggingT m) where
    get :: NoLoggingT m s
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall s (m :: * -> *). MonadState s m => m s
get
    put :: s -> NoLoggingT m ()
put = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put

instance MonadWriter w m => MonadWriter w (NoLoggingT m) where
    tell :: w -> NoLoggingT m ()
tell   = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    listen :: forall a. NoLoggingT m a -> NoLoggingT m (a, w)
listen = forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> NoLoggingT m a -> NoLoggingT n b
mapNoLoggingT 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   = forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> NoLoggingT m a -> NoLoggingT n b
mapNoLoggingT 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 =
  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 = 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 = 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 = 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 = 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 = forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
CallStack -> Text -> LogLevel -> msg -> m ()
logCS CallStack
cs Text
"" LogLevel
lvl Text
msg

#endif