{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

#if MIN_VERSION_base(4, 9, 0)
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
#endif

-- | Provides support for treating payloads and namespaces as
-- composable contexts. The common pattern would be to provide a
-- 'KatipContext' instance for your base monad.
module Katip.Monadic
  ( -- * Monadic variants of logging functions from "Katip.Core"
    logFM,
    logTM,
    logLocM,
    logItemM,
    logExceptionM,

    -- * Machinery for merging typed log payloads/contexts
    KatipContext (..),
    AnyLogContext,
    LogContexts,
    liftPayload,

    -- * KatipContextT - Utility transformer that provides Katip and KatipContext instances
    KatipContextT (..),
    runKatipContextT,
    katipAddNamespace,
    katipAddContext,
    KatipContextTState (..),
    NoLoggingT (..),
    askLoggerIO,
  )
where

-------------------------------------------------------------------------------
import Control.Applicative
import Control.Exception.Safe
import Control.Monad                               as CM
import Control.Monad.Base
import Control.Monad.Error.Class
#if MIN_VERSION_base(4, 9, 0)
import qualified Control.Monad.Fail                as MF
#endif
import Control.Monad.Fix                           as MFix
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Trans.Control
#if !MIN_VERSION_either(4, 5, 0)
import           Control.Monad.Trans.Either        (EitherT, mapEitherT)
#endif
import Control.Monad.Trans.Except (ExceptT, mapExceptT)
import Control.Monad.Trans.Identity (IdentityT, mapIdentityT)
import Control.Monad.Trans.Maybe (MaybeT, mapMaybeT)
import Control.Monad.Trans.RWS (RWST, mapRWST)
import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST, mapRWST)
import Control.Monad.Trans.Resource
  ( MonadResource,
    ResourceT,
    transResourceT,
  )
import qualified Control.Monad.Trans.State.Strict as Strict (StateT, mapStateT)
import qualified Control.Monad.Trans.Writer.Strict as Strict
  ( WriterT,
    mapWriterT,
  )
import qualified Control.Monad.Writer as Lazy (WriterT, mapWriterT)
import Control.Monad.Writer.Class as WC
import Data.Aeson
#if MIN_VERSION_aeson(2, 0, 0)
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Aeson.Key as K
#endif
import qualified Data.Foldable as FT
#if !MIN_VERSION_aeson(2, 0, 0)
import qualified Data.HashMap.Strict as HM
#endif
import Data.Semigroup as Semi
import Data.Sequence as Seq
import Data.Text (Text)
#if MIN_VERSION_base(4, 8, 0)
#if !MIN_VERSION_base(4, 9, 0)
import           GHC.SrcLoc
#endif
import GHC.Stack
#endif

-------------------------------------------------------------------------------
import Katip.Core
import Language.Haskell.TH

-------------------------------------------------------------------------------

-- | A wrapper around a log context that erases type information so
-- that contexts from multiple layers can be combined intelligently.
data AnyLogContext where
  AnyLogContext :: (LogItem a) => a -> AnyLogContext

-------------------------------------------------------------------------------

-- | Heterogeneous list of log contexts that provides a smart
-- 'LogContext' instance for combining multiple payload policies. This
-- is critical for log contexts deep down in a stack to be able to
-- inject their own context without worrying about other context that
-- has already been set. Also note that contexts are treated as a
-- sequence and '<>' will be appended to the right hand side of the
-- sequence. If there are conflicting keys in the contexts, the /right
-- side will take precedence/, which is counter to how monoid works
-- for 'Map' and 'HashMap', so bear that in mind. The reasoning is
-- that if the user is /sequentially/ adding contexts to the right
-- side of the sequence, on conflict the intent is to overwrite with
-- the newer value (i.e. the rightmost value).
--
-- Additional note: you should not mappend LogContexts in any sort of
-- infinite loop, as it retains all data, so that would be a memory
-- leak.
newtype LogContexts = LogContexts (Seq AnyLogContext) deriving (Semigroup LogContexts
LogContexts
[LogContexts] -> LogContexts
LogContexts -> LogContexts -> LogContexts
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [LogContexts] -> LogContexts
$cmconcat :: [LogContexts] -> LogContexts
mappend :: LogContexts -> LogContexts -> LogContexts
$cmappend :: LogContexts -> LogContexts -> LogContexts
mempty :: LogContexts
$cmempty :: LogContexts
Monoid, NonEmpty LogContexts -> LogContexts
LogContexts -> LogContexts -> LogContexts
forall b. Integral b => b -> LogContexts -> LogContexts
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> LogContexts -> LogContexts
$cstimes :: forall b. Integral b => b -> LogContexts -> LogContexts
sconcat :: NonEmpty LogContexts -> LogContexts
$csconcat :: NonEmpty LogContexts -> LogContexts
<> :: LogContexts -> LogContexts -> LogContexts
$c<> :: LogContexts -> LogContexts -> LogContexts
Semigroup)

instance ToJSON LogContexts where
  toJSON :: LogContexts -> Value
toJSON (LogContexts Seq AnyLogContext
cs) =
    -- flip mappend to get right-biased merge
    Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
FT.foldr (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Monoid a => a -> a -> a
mappend) forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(AnyLogContext a
v) -> forall a. ToObject a => a -> Object
toObject a
v) Seq AnyLogContext
cs

instance ToObject LogContexts

instance LogItem LogContexts where
  payloadKeys :: Verbosity -> LogContexts -> PayloadSelection
payloadKeys Verbosity
verb (LogContexts Seq AnyLogContext
vs) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
FT.foldr (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Monoid a => a -> a -> a
mappend) forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AnyLogContext -> PayloadSelection
payloadKeys' Seq AnyLogContext
vs
    where
      -- To ensure AllKeys doesn't leak keys from other values when
      -- combined, we resolve AllKeys to its equivalent SomeKeys
      -- representation first.
      payloadKeys' :: AnyLogContext -> PayloadSelection
payloadKeys' (AnyLogContext a
v) = case forall a. LogItem a => Verbosity -> a -> PayloadSelection
payloadKeys Verbosity
verb a
v of
        PayloadSelection
AllKeys -> [Text] -> PayloadSelection
SomeKeys forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [Text]
toKeys forall a b. (a -> b) -> a -> b
$ forall a. ToObject a => a -> Object
toObject a
v
        PayloadSelection
x -> PayloadSelection
x

#if MIN_VERSION_aeson(2, 0, 0)
toKeys :: KM.KeyMap v -> [Text]
toKeys :: forall v. KeyMap v -> [Text]
toKeys = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Key -> Text
K.toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> [Key]
KM.keys
#else
toKeys :: HM.HashMap k v -> [k]
toKeys = HM.keys
#endif

-------------------------------------------------------------------------------

-- | Lift a log context into the generic wrapper so that it can
-- combine with the existing log context.
liftPayload :: (LogItem a) => a -> LogContexts
liftPayload :: forall a. LogItem a => a -> LogContexts
liftPayload = Seq AnyLogContext -> LogContexts
LogContexts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Seq a
Seq.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LogItem a => a -> AnyLogContext
AnyLogContext

-------------------------------------------------------------------------------

-- | A monadic context that has an inherant way to get logging context
-- and namespace. Examples include a web application monad or database
-- monad. The @local@ variants are just like @local@ from Reader and
-- indeed you can easily implement them with @local@ if you happen to
-- be using a Reader in your monad. These give us 'katipAddNamespace'
-- and 'katipAddContext' that works with *any* 'KatipContext', as
-- opposed to making users have to implement these functions on their
-- own in each app.
class Katip m => KatipContext m where
  getKatipContext :: m LogContexts

  -- | Temporarily modify the current context for the duration of the
  -- supplied monad. Used in 'katipAddContext'
  localKatipContext :: (LogContexts -> LogContexts) -> m a -> m a

  getKatipNamespace :: m Namespace

  -- | Temporarily modify the current namespace for the duration of the
  -- supplied monad. Used in 'katipAddNamespace'
  localKatipNamespace :: (Namespace -> Namespace) -> m a -> m a

instance (KatipContext m, Katip (IdentityT m)) => KatipContext (IdentityT m) where
  getKatipContext :: IdentityT m LogContexts
getKatipContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  localKatipContext :: forall a.
(LogContexts -> LogContexts) -> IdentityT m a -> IdentityT m a
localKatipContext = forall {k1} {k2} (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> IdentityT m a -> IdentityT n b
mapIdentityT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(LogContexts -> LogContexts) -> m a -> m a
localKatipContext
  getKatipNamespace :: IdentityT m Namespace
getKatipNamespace = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  localKatipNamespace :: forall a.
(Namespace -> Namespace) -> IdentityT m a -> IdentityT m a
localKatipNamespace = forall {k1} {k2} (m :: k1 -> *) (a :: k1) (n :: k2 -> *) (b :: k2).
(m a -> n b) -> IdentityT m a -> IdentityT n b
mapIdentityT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(Namespace -> Namespace) -> m a -> m a
localKatipNamespace

instance (KatipContext m, Katip (MaybeT m)) => KatipContext (MaybeT m) where
  getKatipContext :: MaybeT m LogContexts
getKatipContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  localKatipContext :: forall a. (LogContexts -> LogContexts) -> MaybeT m a -> MaybeT m a
localKatipContext = forall (m :: * -> *) a (n :: * -> *) b.
(m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(LogContexts -> LogContexts) -> m a -> m a
localKatipContext
  getKatipNamespace :: MaybeT m Namespace
getKatipNamespace = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  localKatipNamespace :: forall a. (Namespace -> Namespace) -> MaybeT m a -> MaybeT m a
localKatipNamespace = forall (m :: * -> *) a (n :: * -> *) b.
(m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(Namespace -> Namespace) -> m a -> m a
localKatipNamespace

#if !MIN_VERSION_either(4, 5, 0)
instance (KatipContext m, Katip (EitherT e m)) => KatipContext (EitherT e m) where
  getKatipContext = lift getKatipContext
  localKatipContext = mapEitherT . localKatipContext
  getKatipNamespace = lift getKatipNamespace
  localKatipNamespace = mapEitherT . localKatipNamespace
#endif

instance (KatipContext m, Katip (ReaderT r m)) => KatipContext (ReaderT r m) where
  getKatipContext :: ReaderT r m LogContexts
getKatipContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  localKatipContext :: forall a.
(LogContexts -> LogContexts) -> ReaderT r m a -> ReaderT r m a
localKatipContext = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(LogContexts -> LogContexts) -> m a -> m a
localKatipContext
  getKatipNamespace :: ReaderT r m Namespace
getKatipNamespace = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  localKatipNamespace :: forall a.
(Namespace -> Namespace) -> ReaderT r m a -> ReaderT r m a
localKatipNamespace = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(Namespace -> Namespace) -> m a -> m a
localKatipNamespace

instance (KatipContext m, Katip (ResourceT m)) => KatipContext (ResourceT m) where
  getKatipContext :: ResourceT m LogContexts
getKatipContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  localKatipContext :: forall a.
(LogContexts -> LogContexts) -> ResourceT m a -> ResourceT m a
localKatipContext = forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> ResourceT m a -> ResourceT n b
transResourceT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(LogContexts -> LogContexts) -> m a -> m a
localKatipContext
  getKatipNamespace :: ResourceT m Namespace
getKatipNamespace = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  localKatipNamespace :: forall a.
(Namespace -> Namespace) -> ResourceT m a -> ResourceT m a
localKatipNamespace = forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> ResourceT m a -> ResourceT n b
transResourceT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(Namespace -> Namespace) -> m a -> m a
localKatipNamespace

instance (KatipContext m, Katip (Strict.StateT s m)) => KatipContext (Strict.StateT s m) where
  getKatipContext :: StateT s m LogContexts
getKatipContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  localKatipContext :: forall a.
(LogContexts -> LogContexts) -> StateT s m a -> StateT s m a
localKatipContext = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Strict.mapStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(LogContexts -> LogContexts) -> m a -> m a
localKatipContext
  getKatipNamespace :: StateT s m Namespace
getKatipNamespace = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  localKatipNamespace :: forall a. (Namespace -> Namespace) -> StateT s m a -> StateT s m a
localKatipNamespace = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Strict.mapStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(Namespace -> Namespace) -> m a -> m a
localKatipNamespace

instance (KatipContext m, Katip (StateT s m)) => KatipContext (StateT s m) where
  getKatipContext :: StateT s m LogContexts
getKatipContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  localKatipContext :: forall a.
(LogContexts -> LogContexts) -> StateT s m a -> StateT s m a
localKatipContext = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(LogContexts -> LogContexts) -> m a -> m a
localKatipContext
  getKatipNamespace :: StateT s m Namespace
getKatipNamespace = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  localKatipNamespace :: forall a. (Namespace -> Namespace) -> StateT s m a -> StateT s m a
localKatipNamespace = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(Namespace -> Namespace) -> m a -> m a
localKatipNamespace

instance (KatipContext m, Katip (ExceptT e m)) => KatipContext (ExceptT e m) where
  getKatipContext :: ExceptT e m LogContexts
getKatipContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  localKatipContext :: forall a.
(LogContexts -> LogContexts) -> ExceptT e m a -> ExceptT e m a
localKatipContext = forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(LogContexts -> LogContexts) -> m a -> m a
localKatipContext
  getKatipNamespace :: ExceptT e m Namespace
getKatipNamespace = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  localKatipNamespace :: forall a.
(Namespace -> Namespace) -> ExceptT e m a -> ExceptT e m a
localKatipNamespace = forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(Namespace -> Namespace) -> m a -> m a
localKatipNamespace

instance (Monoid w, KatipContext m, Katip (Strict.WriterT w m)) => KatipContext (Strict.WriterT w m) where
  getKatipContext :: WriterT w m LogContexts
getKatipContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  localKatipContext :: forall a.
(LogContexts -> LogContexts) -> WriterT w m a -> WriterT w m a
localKatipContext = forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Strict.mapWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(LogContexts -> LogContexts) -> m a -> m a
localKatipContext
  getKatipNamespace :: WriterT w m Namespace
getKatipNamespace = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  localKatipNamespace :: forall a.
(Namespace -> Namespace) -> WriterT w m a -> WriterT w m a
localKatipNamespace = forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Strict.mapWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(Namespace -> Namespace) -> m a -> m a
localKatipNamespace

instance (Monoid w, KatipContext m, Katip (Lazy.WriterT w m)) => KatipContext (Lazy.WriterT w m) where
  getKatipContext :: WriterT w m LogContexts
getKatipContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  localKatipContext :: forall a.
(LogContexts -> LogContexts) -> WriterT w m a -> WriterT w m a
localKatipContext = forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Lazy.mapWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(LogContexts -> LogContexts) -> m a -> m a
localKatipContext
  getKatipNamespace :: WriterT w m Namespace
getKatipNamespace = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  localKatipNamespace :: forall a.
(Namespace -> Namespace) -> WriterT w m a -> WriterT w m a
localKatipNamespace = forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Lazy.mapWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(Namespace -> Namespace) -> m a -> m a
localKatipNamespace

instance (Monoid w, KatipContext m, Katip (Strict.RWST r w s m)) => KatipContext (Strict.RWST r w s m) where
  getKatipContext :: RWST r w s m LogContexts
getKatipContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  localKatipContext :: forall a.
(LogContexts -> LogContexts) -> RWST r w s m a -> RWST r w s m a
localKatipContext = forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Strict.mapRWST forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(LogContexts -> LogContexts) -> m a -> m a
localKatipContext
  getKatipNamespace :: RWST r w s m Namespace
getKatipNamespace = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  localKatipNamespace :: forall a.
(Namespace -> Namespace) -> RWST r w s m a -> RWST r w s m a
localKatipNamespace = forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Strict.mapRWST forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(Namespace -> Namespace) -> m a -> m a
localKatipNamespace

instance (Monoid w, KatipContext m, Katip (RWST r w s m)) => KatipContext (RWST r w s m) where
  getKatipContext :: RWST r w s m LogContexts
getKatipContext = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  localKatipContext :: forall a.
(LogContexts -> LogContexts) -> RWST r w s m a -> RWST r w s m a
localKatipContext = forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
mapRWST forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(LogContexts -> LogContexts) -> m a -> m a
localKatipContext
  getKatipNamespace :: RWST r w s m Namespace
getKatipNamespace = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  localKatipNamespace :: forall a.
(Namespace -> Namespace) -> RWST r w s m a -> RWST r w s m a
localKatipNamespace = forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
mapRWST forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContext m =>
(Namespace -> Namespace) -> m a -> m a
localKatipNamespace

deriving instance (Monad m, KatipContext m) => KatipContext (KatipT m)

-------------------------------------------------------------------------------

-- | Log with everything, including a source code location. This is
-- very low level and you typically can use 'logTM' in its
-- place. Automatically supplies payload and namespace.
logItemM ::
  (Applicative m, KatipContext m, HasCallStack) =>
  Maybe Loc ->
  Severity ->
  LogStr ->
  m ()
logItemM :: forall (m :: * -> *).
(Applicative m, KatipContext m, HasCallStack) =>
Maybe Loc -> Severity -> LogStr -> m ()
logItemM Maybe Loc
loc Severity
sev LogStr
msg = do
  LogContexts
ctx <- forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  Namespace
ns <- forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  forall (m :: * -> *) a.
(Applicative m, LogItem a, Katip m) =>
a -> Namespace -> Maybe Loc -> Severity -> LogStr -> m ()
logItem LogContexts
ctx Namespace
ns Maybe Loc
loc Severity
sev LogStr
msg

-------------------------------------------------------------------------------

-- | Log with full context, but without any code
-- location. Automatically supplies payload and namespace.
logFM ::
  (Applicative m, KatipContext m) =>
  -- | Severity of the message
  Severity ->
  -- | The log message
  LogStr ->
  m ()
logFM :: forall (m :: * -> *).
(Applicative m, KatipContext m) =>
Severity -> LogStr -> m ()
logFM Severity
sev LogStr
msg = do
  LogContexts
ctx <- forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  Namespace
ns <- forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  forall (m :: * -> *) a.
(Applicative m, LogItem a, Katip m) =>
a -> Namespace -> Severity -> LogStr -> m ()
logF LogContexts
ctx Namespace
ns Severity
sev LogStr
msg

-------------------------------------------------------------------------------

-- | 'Loc'-tagged logging when using template-haskell. Automatically
-- supplies payload and namespace.
--
-- @$(logTM) InfoS "Hello world"@
logTM :: ExpQ
logTM :: ExpQ
logTM = [|logItemM (Just $(getLocTH))|]

-------------------------------------------------------------------------------

-- | 'Loc'-tagged logging when using 'GHC.Stack.getCallStack' implicit-callstacks>.
--   Automatically supplies payload and namespace.
--
-- Same consideration as `logLoc` applies.
--
-- By default, location will be logged from the module that invokes 'logLocM'.
-- If you want to use 'logLocM' in a helper, wrap the entire helper in
-- 'withFrozenCallStack' to retain the callsite of the helper in the logs.
--
-- This function does not require template-haskell. Using GHC <= 7.8 will result
-- in the emission of a log line without any location information.
-- Users using GHC <= 7.8 may want to use the template-haskell function
-- `logTM` for maximum compatibility.
--
-- @logLocM InfoS "Hello world"@
logLocM ::
  (Applicative m, KatipContext m, HasCallStack) =>
  Severity ->
  LogStr ->
  m ()
logLocM :: forall (m :: * -> *).
(Applicative m, KatipContext m, HasCallStack) =>
Severity -> LogStr -> m ()
logLocM = forall (m :: * -> *).
(Applicative m, KatipContext m, HasCallStack) =>
Maybe Loc -> Severity -> LogStr -> m ()
logItemM HasCallStack => Maybe Loc
getLoc

-------------------------------------------------------------------------------

-- | Perform an action while logging any exceptions that may occur.
-- Inspired by 'onException`.
--
-- >>>> error "foo" `logExceptionM` ErrorS
logExceptionM ::
  (KatipContext m, MonadCatch m, Applicative m) =>
  -- | Main action to run
  m a ->
  -- | Severity
  Severity ->
  m a
logExceptionM :: forall (m :: * -> *) a.
(KatipContext m, MonadCatch m, Applicative m) =>
m a -> Severity -> m a
logExceptionM m a
action Severity
sev = m a
action forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
e -> SomeException -> m ()
f SomeException
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
e
  where
    f :: SomeException -> m ()
f SomeException
e = forall (m :: * -> *).
(Applicative m, KatipContext m) =>
Severity -> LogStr -> m ()
logFM Severity
sev (forall {a}. Show a => a -> LogStr
msg SomeException
e)
    msg :: a -> LogStr
msg a
e = forall a. StringConv a Text => a -> LogStr
ls (Text
"An exception has occurred: " :: Text) forall a. Semigroup a => a -> a -> a
Semi.<> forall {a}. Show a => a -> LogStr
showLS a
e

-------------------------------------------------------------------------------

-- | Provides a simple transformer that defines a 'KatipContext'
-- instance for a fixed namespace and context. Just like 'KatipT', you
-- should use this if you prefer an explicit transformer stack and
-- don't want to (or cannot) define 'KatipContext' for your monad
-- . This is the slightly more powerful version of KatipT in that it
-- provides KatipContext instead of just Katip. For instance:
--
-- @
--   threadWithLogging = do
--     le <- getLogEnv
--     ctx <- getKatipContext
--     ns <- getKatipNamespace
--     forkIO $ runKatipContextT le ctx ns $ do
--       $(logTM) InfoS "Look, I can log in IO and retain context!"
--       doOtherStuff
-- @
newtype KatipContextT m a = KatipContextT
  { forall (m :: * -> *) a.
KatipContextT m a -> ReaderT KatipContextTState m a
unKatipContextT :: ReaderT KatipContextTState m a
  }
  deriving
    ( forall a b. a -> KatipContextT m b -> KatipContextT m a
forall a b. (a -> b) -> KatipContextT m a -> KatipContextT m b
forall (m :: * -> *) a b.
Functor m =>
a -> KatipContextT m b -> KatipContextT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> KatipContextT m a -> KatipContextT 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 -> KatipContextT m b -> KatipContextT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> KatipContextT m b -> KatipContextT m a
fmap :: forall a b. (a -> b) -> KatipContextT m a -> KatipContextT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> KatipContextT m a -> KatipContextT m b
Functor,
      forall a. a -> KatipContextT m a
forall a b.
KatipContextT m a -> KatipContextT m b -> KatipContextT m a
forall a b.
KatipContextT m a -> KatipContextT m b -> KatipContextT m b
forall a b.
KatipContextT m (a -> b) -> KatipContextT m a -> KatipContextT m b
forall a b c.
(a -> b -> c)
-> KatipContextT m a -> KatipContextT m b -> KatipContextT 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 (KatipContextT m)
forall (m :: * -> *) a. Applicative m => a -> KatipContextT m a
forall (m :: * -> *) a b.
Applicative m =>
KatipContextT m a -> KatipContextT m b -> KatipContextT m a
forall (m :: * -> *) a b.
Applicative m =>
KatipContextT m a -> KatipContextT m b -> KatipContextT m b
forall (m :: * -> *) a b.
Applicative m =>
KatipContextT m (a -> b) -> KatipContextT m a -> KatipContextT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> KatipContextT m a -> KatipContextT m b -> KatipContextT m c
<* :: forall a b.
KatipContextT m a -> KatipContextT m b -> KatipContextT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
KatipContextT m a -> KatipContextT m b -> KatipContextT m a
*> :: forall a b.
KatipContextT m a -> KatipContextT m b -> KatipContextT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
KatipContextT m a -> KatipContextT m b -> KatipContextT m b
liftA2 :: forall a b c.
(a -> b -> c)
-> KatipContextT m a -> KatipContextT m b -> KatipContextT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> KatipContextT m a -> KatipContextT m b -> KatipContextT m c
<*> :: forall a b.
KatipContextT m (a -> b) -> KatipContextT m a -> KatipContextT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
KatipContextT m (a -> b) -> KatipContextT m a -> KatipContextT m b
pure :: forall a. a -> KatipContextT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> KatipContextT m a
Applicative,
      forall a. a -> KatipContextT m a
forall a b.
KatipContextT m a -> KatipContextT m b -> KatipContextT m b
forall a b.
KatipContextT m a -> (a -> KatipContextT m b) -> KatipContextT m b
forall {m :: * -> *}. Monad m => Applicative (KatipContextT m)
forall (m :: * -> *) a. Monad m => a -> KatipContextT m a
forall (m :: * -> *) a b.
Monad m =>
KatipContextT m a -> KatipContextT m b -> KatipContextT m b
forall (m :: * -> *) a b.
Monad m =>
KatipContextT m a -> (a -> KatipContextT m b) -> KatipContextT 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 -> KatipContextT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> KatipContextT m a
>> :: forall a b.
KatipContextT m a -> KatipContextT m b -> KatipContextT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
KatipContextT m a -> KatipContextT m b -> KatipContextT m b
>>= :: forall a b.
KatipContextT m a -> (a -> KatipContextT m b) -> KatipContextT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
KatipContextT m a -> (a -> KatipContextT m b) -> KatipContextT m b
Monad,
      forall a. IO a -> KatipContextT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (KatipContextT m)
forall (m :: * -> *) a. MonadIO m => IO a -> KatipContextT m a
liftIO :: forall a. IO a -> KatipContextT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> KatipContextT m a
MonadIO,
      forall e a. Exception e => e -> KatipContextT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall {m :: * -> *}. MonadThrow m => Monad (KatipContextT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> KatipContextT m a
throwM :: forall e a. Exception e => e -> KatipContextT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> KatipContextT m a
MonadThrow,
      forall e a.
Exception e =>
KatipContextT m a -> (e -> KatipContextT m a) -> KatipContextT 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 (KatipContextT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
KatipContextT m a -> (e -> KatipContextT m a) -> KatipContextT m a
catch :: forall e a.
Exception e =>
KatipContextT m a -> (e -> KatipContextT m a) -> KatipContextT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
KatipContextT m a -> (e -> KatipContextT m a) -> KatipContextT m a
MonadCatch,
      forall b.
((forall a. KatipContextT m a -> KatipContextT m a)
 -> KatipContextT m b)
-> KatipContextT m b
forall a b c.
KatipContextT m a
-> (a -> ExitCase b -> KatipContextT m c)
-> (a -> KatipContextT m b)
-> KatipContextT m (b, c)
forall {m :: * -> *}. MonadMask m => MonadCatch (KatipContextT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. KatipContextT m a -> KatipContextT m a)
 -> KatipContextT m b)
-> KatipContextT m b
forall (m :: * -> *) a b c.
MonadMask m =>
KatipContextT m a
-> (a -> ExitCase b -> KatipContextT m c)
-> (a -> KatipContextT m b)
-> KatipContextT 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.
KatipContextT m a
-> (a -> ExitCase b -> KatipContextT m c)
-> (a -> KatipContextT m b)
-> KatipContextT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
KatipContextT m a
-> (a -> ExitCase b -> KatipContextT m c)
-> (a -> KatipContextT m b)
-> KatipContextT m (b, c)
uninterruptibleMask :: forall b.
((forall a. KatipContextT m a -> KatipContextT m a)
 -> KatipContextT m b)
-> KatipContextT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. KatipContextT m a -> KatipContextT m a)
 -> KatipContextT m b)
-> KatipContextT m b
mask :: forall b.
((forall a. KatipContextT m a -> KatipContextT m a)
 -> KatipContextT m b)
-> KatipContextT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. KatipContextT m a -> KatipContextT m a)
 -> KatipContextT m b)
-> KatipContextT m b
MonadMask,
      MonadBase b,
      MonadState s,
      WC.MonadWriter w,
      MonadError e,
      forall a. KatipContextT m a
forall a.
KatipContextT m a -> KatipContextT m a -> KatipContextT m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall {m :: * -> *}. MonadPlus m => Monad (KatipContextT m)
forall {m :: * -> *}. MonadPlus m => Alternative (KatipContextT m)
forall (m :: * -> *) a. MonadPlus m => KatipContextT m a
forall (m :: * -> *) a.
MonadPlus m =>
KatipContextT m a -> KatipContextT m a -> KatipContextT m a
mplus :: forall a.
KatipContextT m a -> KatipContextT m a -> KatipContextT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
KatipContextT m a -> KatipContextT m a -> KatipContextT m a
mzero :: forall a. KatipContextT m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => KatipContextT m a
CM.MonadPlus,
      forall a. ResourceT IO a -> KatipContextT m a
forall (m :: * -> *).
MonadIO m -> (forall a. ResourceT IO a -> m a) -> MonadResource m
forall {m :: * -> *}. MonadResource m => MonadIO (KatipContextT m)
forall (m :: * -> *) a.
MonadResource m =>
ResourceT IO a -> KatipContextT m a
liftResourceT :: forall a. ResourceT IO a -> KatipContextT m a
$cliftResourceT :: forall (m :: * -> *) a.
MonadResource m =>
ResourceT IO a -> KatipContextT m a
MonadResource,
      forall a. KatipContextT m a
forall a. KatipContextT m a -> KatipContextT m [a]
forall a.
KatipContextT m a -> KatipContextT m a -> KatipContextT 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 (KatipContextT m)
forall (m :: * -> *) a. Alternative m => KatipContextT m a
forall (m :: * -> *) a.
Alternative m =>
KatipContextT m a -> KatipContextT m [a]
forall (m :: * -> *) a.
Alternative m =>
KatipContextT m a -> KatipContextT m a -> KatipContextT m a
many :: forall a. KatipContextT m a -> KatipContextT m [a]
$cmany :: forall (m :: * -> *) a.
Alternative m =>
KatipContextT m a -> KatipContextT m [a]
some :: forall a. KatipContextT m a -> KatipContextT m [a]
$csome :: forall (m :: * -> *) a.
Alternative m =>
KatipContextT m a -> KatipContextT m [a]
<|> :: forall a.
KatipContextT m a -> KatipContextT m a -> KatipContextT m a
$c<|> :: forall (m :: * -> *) a.
Alternative m =>
KatipContextT m a -> KatipContextT m a -> KatipContextT m a
empty :: forall a. KatipContextT m a
$cempty :: forall (m :: * -> *) a. Alternative m => KatipContextT m a
Alternative,
      forall a. (a -> KatipContextT m a) -> KatipContextT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (KatipContextT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> KatipContextT m a) -> KatipContextT m a
mfix :: forall a. (a -> KatipContextT m a) -> KatipContextT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> KatipContextT m a) -> KatipContextT m a
MFix.MonadFix,
      forall (m :: * -> *) a. Monad m => m a -> KatipContextT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> KatipContextT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> KatipContextT m a
MonadTrans
    )

data KatipContextTState = KatipContextTState
  { KatipContextTState -> LogEnv
ltsLogEnv :: !LogEnv,
    KatipContextTState -> LogContexts
ltsContext :: !LogContexts,
    KatipContextTState -> Namespace
ltsNamespace :: !Namespace
  }

instance MonadTransControl KatipContextT where
  type StT KatipContextT a = StT (ReaderT KatipContextTState) a
  liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run KatipContextT -> m a) -> KatipContextT m a
liftWith = forall (m :: * -> *) (n :: (* -> *) -> * -> *)
       (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTransControl n) =>
(forall b. n m b -> t m b)
-> (forall (o :: * -> *) b. t o b -> n o b)
-> (RunDefault t n -> m a)
-> t m a
defaultLiftWith forall (m :: * -> *) a.
ReaderT KatipContextTState m a -> KatipContextT m a
KatipContextT forall (m :: * -> *) a.
KatipContextT m a -> ReaderT KatipContextTState m a
unKatipContextT
  restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT KatipContextT a) -> KatipContextT m a
restoreT = forall (m :: * -> *) (n :: (* -> *) -> * -> *) a
       (t :: (* -> *) -> * -> *).
(Monad m, MonadTransControl n) =>
(n m a -> t m a) -> m (StT n a) -> t m a
defaultRestoreT forall (m :: * -> *) a.
ReaderT KatipContextTState m a -> KatipContextT m a
KatipContextT
  {-# INLINE liftWith #-}
  {-# INLINE restoreT #-}

instance (MonadBaseControl b m) => MonadBaseControl b (KatipContextT m) where
  type StM (KatipContextT m) a = ComposeSt KatipContextT m a
  liftBaseWith :: forall a.
(RunInBase (KatipContextT m) b -> b a) -> KatipContextT 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 (KatipContextT m) a -> KatipContextT m a
restoreM = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM

-- Reader is a passthrough. We don't expose our internal reader so as not to conflict
instance (MonadReader r m) => MonadReader r (KatipContextT m) where
  ask :: KatipContextT m r
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> KatipContextT m a -> KatipContextT m a
local r -> r
f (KatipContextT (ReaderT KatipContextTState -> m a
m)) = forall (m :: * -> *) a.
ReaderT KatipContextTState m a -> KatipContextT m a
KatipContextT forall a b. (a -> b) -> a -> b
$
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \KatipContextTState
r ->
      forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (KatipContextTState -> m a
m KatipContextTState
r)

instance (MonadIO m) => Katip (KatipContextT m) where
  getLogEnv :: KatipContextT m LogEnv
getLogEnv = forall (m :: * -> *) a.
ReaderT KatipContextTState m a -> KatipContextT m a
KatipContextT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \KatipContextTState
lts -> forall (m :: * -> *) a. Monad m => a -> m a
return (KatipContextTState -> LogEnv
ltsLogEnv KatipContextTState
lts)
  localLogEnv :: forall a.
(LogEnv -> LogEnv) -> KatipContextT m a -> KatipContextT m a
localLogEnv LogEnv -> LogEnv
f (KatipContextT ReaderT KatipContextTState m a
m) = forall (m :: * -> *) a.
ReaderT KatipContextTState m a -> KatipContextT m a
KatipContextT (forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\KatipContextTState
s -> KatipContextTState
s {ltsLogEnv :: LogEnv
ltsLogEnv = LogEnv -> LogEnv
f (KatipContextTState -> LogEnv
ltsLogEnv KatipContextTState
s)}) ReaderT KatipContextTState m a
m)

instance (MonadIO m) => KatipContext (KatipContextT m) where
  getKatipContext :: KatipContextT m LogContexts
getKatipContext = forall (m :: * -> *) a.
ReaderT KatipContextTState m a -> KatipContextT m a
KatipContextT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \KatipContextTState
lts -> forall (m :: * -> *) a. Monad m => a -> m a
return (KatipContextTState -> LogContexts
ltsContext KatipContextTState
lts)
  localKatipContext :: forall a.
(LogContexts -> LogContexts)
-> KatipContextT m a -> KatipContextT m a
localKatipContext LogContexts -> LogContexts
f (KatipContextT ReaderT KatipContextTState m a
m) = forall (m :: * -> *) a.
ReaderT KatipContextTState m a -> KatipContextT m a
KatipContextT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\KatipContextTState
s -> KatipContextTState
s {ltsContext :: LogContexts
ltsContext = LogContexts -> LogContexts
f (KatipContextTState -> LogContexts
ltsContext KatipContextTState
s)}) ReaderT KatipContextTState m a
m
  getKatipNamespace :: KatipContextT m Namespace
getKatipNamespace = forall (m :: * -> *) a.
ReaderT KatipContextTState m a -> KatipContextT m a
KatipContextT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \KatipContextTState
lts -> forall (m :: * -> *) a. Monad m => a -> m a
return (KatipContextTState -> Namespace
ltsNamespace KatipContextTState
lts)
  localKatipNamespace :: forall a.
(Namespace -> Namespace) -> KatipContextT m a -> KatipContextT m a
localKatipNamespace Namespace -> Namespace
f (KatipContextT ReaderT KatipContextTState m a
m) = forall (m :: * -> *) a.
ReaderT KatipContextTState m a -> KatipContextT m a
KatipContextT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\KatipContextTState
s -> KatipContextTState
s {ltsNamespace :: Namespace
ltsNamespace = Namespace -> Namespace
f (KatipContextTState -> Namespace
ltsNamespace KatipContextTState
s)}) ReaderT KatipContextTState m a
m

#if MIN_VERSION_unliftio_core(0, 2, 0)
instance MonadUnliftIO m => MonadUnliftIO (KatipContextT m) where
  withRunInIO :: forall b.
((forall a. KatipContextT m a -> IO a) -> IO b)
-> KatipContextT m b
withRunInIO (forall a. KatipContextT m a -> IO a) -> IO b
inner = forall (m :: * -> *) a.
ReaderT KatipContextTState m a -> KatipContextT m a
KatipContextT forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \KatipContextTState
lts -> 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. KatipContextT 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 c (m :: * -> *) a.
LogItem c =>
LogEnv -> c -> Namespace -> KatipContextT m a -> m a
runKatipContextT (KatipContextTState -> LogEnv
ltsLogEnv KatipContextTState
lts) (KatipContextTState -> LogContexts
ltsContext KatipContextTState
lts) (KatipContextTState -> Namespace
ltsNamespace KatipContextTState
lts))
#else
instance MonadUnliftIO m => MonadUnliftIO (KatipContextT m) where
  askUnliftIO = KatipContextT $
    withUnliftIO $ \u ->
      pure (UnliftIO (unliftIO u . unKatipContextT))
#endif

#if MIN_VERSION_base(4, 9, 0)
instance MF.MonadFail m => MF.MonadFail (KatipContextT m) where
    fail :: forall a. String -> KatipContextT m a
fail String
msg = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. MonadFail m => String -> m a
MF.fail String
msg)
    {-# INLINE fail #-}
#endif

-------------------------------------------------------------------------------
runKatipContextT :: (LogItem c) => LogEnv -> c -> Namespace -> KatipContextT m a -> m a
runKatipContextT :: forall c (m :: * -> *) a.
LogItem c =>
LogEnv -> c -> Namespace -> KatipContextT m a -> m a
runKatipContextT LogEnv
le c
ctx Namespace
ns = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT KatipContextTState
lts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
KatipContextT m a -> ReaderT KatipContextTState m a
unKatipContextT
  where
    lts :: KatipContextTState
lts = LogEnv -> LogContexts -> Namespace -> KatipContextTState
KatipContextTState LogEnv
le (forall a. LogItem a => a -> LogContexts
liftPayload c
ctx) Namespace
ns

-------------------------------------------------------------------------------

-- | Append a namespace segment to the current namespace for the given
-- monadic action, then restore the previous state
-- afterwards. Works with anything implementing KatipContext.
katipAddNamespace ::
  (KatipContext m) =>
  Namespace ->
  m a ->
  m a
katipAddNamespace :: forall (m :: * -> *) a. KatipContext m => Namespace -> m a -> m a
katipAddNamespace Namespace
ns = forall (m :: * -> *) a.
KatipContext m =>
(Namespace -> Namespace) -> m a -> m a
localKatipNamespace (forall a. Semigroup a => a -> a -> a
<> Namespace
ns)

-------------------------------------------------------------------------------

-- | Append some context to the current context for the given monadic
-- action, then restore the previous state afterwards. Important note:
-- be careful using this in a loop. If you're using something like
-- 'forever' or 'replicateM_' that does explicit sharing to avoid a
-- memory leak, youll be fine as it will *sequence* calls to
-- 'katipAddNamespace', so each loop will get the same context
-- added. If you instead roll your own recursion and you're recursing
-- in the action you provide, you'll instead accumulate tons of
-- redundant contexts and even if they all merge on log, they are
-- stored in a sequence and will leak memory. Works with anything
-- implementing KatipContext.
katipAddContext ::
  ( LogItem i,
    KatipContext m
  ) =>
  i ->
  m a ->
  m a
katipAddContext :: forall i (m :: * -> *) a.
(LogItem i, KatipContext m) =>
i -> m a -> m a
katipAddContext i
i = forall (m :: * -> *) a.
KatipContext m =>
(LogContexts -> LogContexts) -> m a -> m a
localKatipContext (forall a. Semigroup a => a -> a -> a
<> (forall a. LogItem a => a -> LogContexts
liftPayload i
i))

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,
      MonadBase b,
      MonadState s,
      WC.MonadWriter w,
      MonadError e,
      forall a. NoLoggingT m a
forall a. NoLoggingT m a -> NoLoggingT m a -> NoLoggingT m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall {m :: * -> *}. MonadPlus m => Monad (NoLoggingT m)
forall {m :: * -> *}. MonadPlus m => Alternative (NoLoggingT m)
forall (m :: * -> *) a. MonadPlus m => NoLoggingT m a
forall (m :: * -> *) a.
MonadPlus m =>
NoLoggingT m a -> NoLoggingT m a -> NoLoggingT m a
mplus :: forall a. NoLoggingT m a -> NoLoggingT m a -> NoLoggingT m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
NoLoggingT m a -> NoLoggingT m a -> NoLoggingT m a
mzero :: forall a. NoLoggingT m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => NoLoggingT m a
CM.MonadPlus,
      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,
      forall a. (a -> NoLoggingT m a) -> NoLoggingT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (NoLoggingT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> NoLoggingT m a) -> NoLoggingT m a
mfix :: forall a. (a -> NoLoggingT m a) -> NoLoggingT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> NoLoggingT m a) -> NoLoggingT m a
MFix.MonadFix,
      MonadReader r
    )

instance 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 #-}

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



#if MIN_VERSION_unliftio_core(0, 2, 0)
instance MonadUnliftIO m => MonadUnliftIO (NoLoggingT m) where
  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
instance MonadUnliftIO m => MonadUnliftIO (NoLoggingT m) where
  askUnliftIO = NoLoggingT $
    withUnliftIO $ \u ->
      pure (UnliftIO (unliftIO u . runNoLoggingT))
#endif

instance MonadIO m => Katip (NoLoggingT m) where
  getLogEnv :: NoLoggingT m LogEnv
getLogEnv = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Namespace -> Environment -> IO LogEnv
initLogEnv Namespace
"NoLoggingT" Environment
"no-logging")
  localLogEnv :: forall a. (LogEnv -> LogEnv) -> NoLoggingT m a -> NoLoggingT m a
localLogEnv = forall a b. a -> b -> a
const forall a. a -> a
id

instance MonadIO m => KatipContext (NoLoggingT m) where
  getKatipContext :: NoLoggingT m LogContexts
getKatipContext = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
  localKatipContext :: forall a.
(LogContexts -> LogContexts) -> NoLoggingT m a -> NoLoggingT m a
localKatipContext = forall a b. a -> b -> a
const forall a. a -> a
id
  getKatipNamespace :: NoLoggingT m Namespace
getKatipNamespace = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
  localKatipNamespace :: forall a.
(Namespace -> Namespace) -> NoLoggingT m a -> NoLoggingT m a
localKatipNamespace = forall a b. a -> b -> a
const forall a. a -> a
id

-- | Convenience function for when you have to integrate with a third
-- party API that takes a generic logging function as an argument.
askLoggerIO :: (Applicative m, KatipContext m) => m (Severity -> LogStr -> IO ())
askLoggerIO :: forall (m :: * -> *).
(Applicative m, KatipContext m) =>
m (Severity -> LogStr -> IO ())
askLoggerIO = do
  LogContexts
ctx <- forall (m :: * -> *). KatipContext m => m LogContexts
getKatipContext
  Namespace
ns <- forall (m :: * -> *). KatipContext m => m Namespace
getKatipNamespace
  LogEnv
logEnv <- forall (m :: * -> *). Katip m => m LogEnv
getLogEnv
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (\Severity
sev LogStr
msg -> forall (m :: * -> *) a. LogEnv -> KatipT m a -> m a
runKatipT LogEnv
logEnv forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(Applicative m, LogItem a, Katip m) =>
a -> Namespace -> Severity -> LogStr -> m ()
logF LogContexts
ctx Namespace
ns Severity
sev LogStr
msg)