{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

{- |
Module: Effectful.Katip
Description: Effect to use Katip
-}
module Effectful.Katip (
  -- * Framework Types
  Namespace (..),
  Environment (..),
  Severity (..),
  renderSeverity,
  textToSeverity,
  Verbosity (..),
  ToObject (..),
  LogItem (..),
  Item (..),
  ThreadIdText (..),
  PayloadSelection (..),
  Scribe (..),
  LogEnv (..),
  SimpleLogPayload,
  sl,
  defaultScribeSettings,
  ScribeSettings,
  scribeBufferSize,
  _scribeBufferSize,

  -- ** @lens@-Compatible Lenses
  itemApp,
  itemEnv,
  itemSeverity,
  itemThread,
  itemHost,
  itemProcess,
  itemPayload,
  itemMessage,
  itemTime,
  itemNamespace,
  itemLoc,
  logEnvHost,
  logEnvPid,
  logEnvApp,
  logEnvEnv,
  logEnvTimer,
  logEnvScribes,

  -- * Effect
  KatipE,

  -- ** Running The Effect
  runKatipE,
  runKatipContextE,
  startKatipE,
  startKatipContextE,

  -- * Initializing Loggers
  registerScribe,

  -- * Dropping Scribes Temporarily
  unregisterScribe,
  clearScribes,

  -- * Finalizing Scribes At Shutdown
  closeScribe,

  -- * Logging Functions
  LogStr (..),
  logStr,
  ls,
  showLS,

  -- ** Katip Logging Functions
  getLogEnv,
  localLogEnv,
  logF,
  logMsg,
  logT,
  logLoc,
  logItem,
  logKatipItem,
  logException,

  -- ** KatipContext Logging Functions
  getKatipContext,
  localKatipContext,
  getKatipNamespace,
  localKatipNamespace,
  logFM,
  logTM,
  logLocM,
  logItemM,
  logExceptionM,
  AnyLogContext,
  LogContexts,
  liftPayload,

  -- *** Temporarily Changing Log Behaviour
  katipAddNamespace,
  katipAddContext,
  katipNoLogging,

  -- * Included Scribes
  mkHandleScribe,
  mkHandleScribeWithFormatter,
  mkFileScribe,
  ColorStrategy (..),
  ItemFormatter,
  bracketFormat,
  jsonFormat,

  -- * Tools For Implementing Scribes
  PermitFunc,
  permitAND,
  permitOR,
  permitItem,
  payloadObject,
  itemJson,
) where

import Effectful
import Effectful.Dispatch.Static
import Katip (
  --  logging

  -- logContext
  AnyLogContext,
  -- formatting
  ColorStrategy (..),
  Environment (..),
  Item (..),
  ItemFormatter,
  LogContexts,
  LogEnv (..),
  LogItem (..),
  LogStr (..),
  Namespace (..),
  PayloadSelection (..),
  -- permission
  PermitFunc,
  Scribe (..),
  ScribeSettings,
  Severity (..),
  SimpleLogPayload,
  ThreadIdText (..),
  ToObject (..),
  Verbosity (..),
  bracketFormat,
  -- removing scribe

  clearScribes,
  defaultScribeSettings,
  itemApp,
  itemEnv,
  itemHost,
  itemJson,
  itemLoc,
  itemMessage,
  itemNamespace,
  itemPayload,
  itemProcess,
  itemSeverity,
  itemThread,
  itemTime,
  jsonFormat,
  liftPayload,
  logEnvApp,
  logEnvEnv,
  logEnvHost,
  logEnvPid,
  logEnvScribes,
  logEnvTimer,
  logStr,
  ls,
  payloadObject,
  permitAND,
  permitItem,
  permitOR,
  renderSeverity,
  scribeBufferSize,
  showLS,
  sl,
  textToSeverity,
  unregisterScribe,
  _scribeBufferSize,
 )

import Data.Kind
import Data.Text (Text)
import Katip qualified as K
import Katip.Core (getLocTH)
import Language.Haskell.TH (Loc)
import Language.Haskell.TH.Lib
import System.IO (Handle)
import Unsafe.Coerce (unsafeCoerce)

-- | A Effect you can use to run logging actions. there is only one effect as we can't have duplicated instances.
type KatipE :: Effect
data KatipE m a

type instance DispatchOf KatipE = Static WithSideEffects

data instance StaticRep KatipE = MkKatipE !LogEnv !LogContexts !Namespace

-- | Run a KatipE Effect without a 'Namespace' or a 'LogContexts'. This also calls closeScribes
runKatipE :: forall es a. (IOE :> es) => LogEnv -> Eff (KatipE : es) a -> Eff es a
runKatipE :: forall (es :: [Effect]) a.
(IOE :> es) =>
LogEnv -> Eff (KatipE : es) a -> Eff es a
runKatipE LogEnv
l Eff (KatipE : es) a
act = StaticRep KatipE -> Eff (KatipE : es) a -> Eff es a
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(DispatchOf e ~ 'Static sideEffects, MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep (LogEnv -> LogContexts -> Namespace -> StaticRep KatipE
MkKatipE LogEnv
l LogContexts
forall a. Monoid a => a
mempty Namespace
forall a. Monoid a => a
mempty) Eff (KatipE : es) a
act Eff es a -> Eff es LogEnv -> Eff es a
forall a b. Eff es a -> Eff es b -> Eff es a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* IO LogEnv -> Eff es LogEnv
forall a. IO a -> Eff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (LogEnv -> IO LogEnv
K.closeScribes LogEnv
l)

-- | Run a KatipE Effect with a 'Namespace' and a 'LogContexts'. this also calls closeScribes
runKatipContextE :: forall es a a1. (LogItem a, IOE :> es) => LogEnv -> a -> Namespace -> Eff (KatipE : es) a1 -> Eff es a1
runKatipContextE :: forall (es :: [Effect]) a a1.
(LogItem a, IOE :> es) =>
LogEnv -> a -> Namespace -> Eff (KatipE : es) a1 -> Eff es a1
runKatipContextE LogEnv
l a
pl Namespace
ns Eff (KatipE : es) a1
act = StaticRep KatipE -> Eff (KatipE : es) a1 -> Eff es a1
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(DispatchOf e ~ 'Static sideEffects, MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep (LogEnv -> LogContexts -> Namespace -> StaticRep KatipE
MkKatipE LogEnv
l (a -> LogContexts
forall a. LogItem a => a -> LogContexts
liftPayload a
pl) Namespace
ns) Eff (KatipE : es) a1
act Eff es a1 -> Eff es LogEnv -> Eff es a1
forall a b. Eff es a -> Eff es b -> Eff es a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* IO LogEnv -> Eff es LogEnv
forall a. IO a -> Eff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (LogEnv -> IO LogEnv
K.closeScribes LogEnv
l)

instance forall es. (IOE :> es, KatipE :> es) => K.Katip (Eff es) where
  getLogEnv :: (IOE :> es, KatipE :> es) => Eff es LogEnv
  getLogEnv :: (IOE :> es, KatipE :> es) => Eff es LogEnv
getLogEnv = Eff es LogEnv
forall (es :: [Effect]). (KatipE :> es) => Eff es LogEnv
getLogEnv
  localLogEnv ::
    (IOE :> es, KatipE :> es) =>
    (LogEnv -> LogEnv) ->
    Eff es a ->
    Eff es a
  localLogEnv :: forall a.
(IOE :> es, KatipE :> es) =>
(LogEnv -> LogEnv) -> Eff es a -> Eff es a
localLogEnv = (LogEnv -> LogEnv) -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(KatipE :> es) =>
(LogEnv -> LogEnv) -> Eff es a -> Eff es a
localLogEnv
instance forall es. (IOE :> es, KatipE :> es) => K.KatipContext (Eff es) where
  getKatipContext :: Eff es LogContexts
  getKatipContext :: Eff es LogContexts
getKatipContext = Eff es LogContexts
forall (es :: [Effect]). (KatipE :> es) => Eff es LogContexts
getKatipContext
  localKatipContext ::
    (IOE :> es, KatipE :> es) =>
    (LogContexts -> LogContexts) ->
    Eff es a ->
    Eff es a
  localKatipContext :: forall a.
(IOE :> es, KatipE :> es) =>
(LogContexts -> LogContexts) -> Eff es a -> Eff es a
localKatipContext = (LogContexts -> LogContexts) -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(KatipE :> es) =>
(LogContexts -> LogContexts) -> Eff es a -> Eff es a
localKatipContext
  getKatipNamespace :: (IOE :> es, KatipE :> es) => Eff es Namespace
  getKatipNamespace :: (IOE :> es, KatipE :> es) => Eff es Namespace
getKatipNamespace = Eff es Namespace
forall (es :: [Effect]). (KatipE :> es) => Eff es Namespace
getKatipNamespace
  localKatipNamespace ::
    (IOE :> es, KatipE :> es) =>
    (Namespace -> Namespace) ->
    Eff es a ->
    Eff es a
  localKatipNamespace :: forall a.
(IOE :> es, KatipE :> es) =>
(Namespace -> Namespace) -> Eff es a -> Eff es a
localKatipNamespace = (Namespace -> Namespace) -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(KatipE :> es) =>
(Namespace -> Namespace) -> Eff es a -> Eff es a
localKatipNamespace

-- | Run a KatipE Effect without a 'Namespace' or a 'LogContexts' and creating a 'LogEnv'
startKatipE :: (IOE :> es) => Namespace -> Environment -> Eff (KatipE : es) a -> Eff es a
startKatipE :: forall (es :: [Effect]) a.
(IOE :> es) =>
Namespace -> Environment -> Eff (KatipE : es) a -> Eff es a
startKatipE Namespace
ns Environment
env Eff (KatipE : es) a
act = IO LogEnv -> Eff es LogEnv
forall a. IO a -> Eff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Namespace -> Environment -> IO LogEnv
K.initLogEnv Namespace
ns Environment
env) Eff es LogEnv -> (LogEnv -> Eff es a) -> Eff es a
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \LogEnv
lenv -> LogEnv -> Eff (KatipE : es) a -> Eff es a
forall (es :: [Effect]) a.
(IOE :> es) =>
LogEnv -> Eff (KatipE : es) a -> Eff es a
runKatipE LogEnv
lenv Eff (KatipE : es) a
act

-- | Run a KatipE Effect with a 'Namespace' and a 'LogContexts' and creating a 'LogEnv'
startKatipContextE :: (IOE :> es, LogItem a) => Environment -> a -> Namespace -> Eff (KatipE : es) a1 -> Eff es a1
startKatipContextE :: forall (es :: [Effect]) a a1.
(IOE :> es, LogItem a) =>
Environment -> a -> Namespace -> Eff (KatipE : es) a1 -> Eff es a1
startKatipContextE Environment
env a
a Namespace
ns Eff (KatipE : es) a1
act = IO LogEnv -> Eff es LogEnv
forall a. IO a -> Eff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (Namespace -> Environment -> IO LogEnv
K.initLogEnv Namespace
ns Environment
env) Eff es LogEnv -> (LogEnv -> Eff es a1) -> Eff es a1
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \LogEnv
e -> LogEnv -> a -> Namespace -> Eff (KatipE : es) a1 -> Eff es a1
forall (es :: [Effect]) a a1.
(LogItem a, IOE :> es) =>
LogEnv -> a -> Namespace -> Eff (KatipE : es) a1 -> Eff es a1
runKatipContextE LogEnv
e a
a Namespace
ns Eff (KatipE : es) a1
act

{- | Add a scribe to the list.
All future log calls will go to this scribe in addition to the others.
Writes will be buffered per the ScribeSettings to prevent slow scribes from slowing down logging.
Writes will be dropped if the buffer fills.
-}
registerScribe :: (KatipE :> es) => Text -> Scribe -> ScribeSettings -> Eff es ()
registerScribe :: forall (es :: [Effect]).
(KatipE :> es) =>
Text -> Scribe -> ScribeSettings -> Eff es ()
registerScribe Text
txt Scribe
scrb ScribeSettings
scrbs = do
  MkKatipE LogEnv
lenv LogContexts
lctx Namespace
ns <- Eff es (StaticRep KatipE)
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep
  LogEnv
nlenv <- IO LogEnv -> Eff es LogEnv
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO LogEnv -> Eff es LogEnv) -> IO LogEnv -> Eff es LogEnv
forall a b. (a -> b) -> a -> b
$ Text -> Scribe -> ScribeSettings -> LogEnv -> IO LogEnv
K.registerScribe Text
txt Scribe
scrb ScribeSettings
scrbs LogEnv
lenv
  StaticRep KatipE -> Eff es ()
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
StaticRep e -> Eff es ()
putStaticRep (StaticRep KatipE -> Eff es ()) -> StaticRep KatipE -> Eff es ()
forall a b. (a -> b) -> a -> b
$ LogEnv -> LogContexts -> Namespace -> StaticRep KatipE
MkKatipE LogEnv
nlenv LogContexts
lctx Namespace
ns

-- | Finalize a scribe early. Note that it isn't necessary to call this as both 'runKatipE' and 'runKatipContextE' call 'K.closeScribes'
closeScribe :: (KatipE :> es) => Text -> Eff es ()
closeScribe :: forall (es :: [Effect]). (KatipE :> es) => Text -> Eff es ()
closeScribe Text
name = do
  MkKatipE LogEnv
le LogContexts
lc Namespace
ns <- Eff es (StaticRep KatipE)
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep
  LogEnv
newle <- IO LogEnv -> Eff es LogEnv
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO LogEnv -> Eff es LogEnv) -> IO LogEnv -> Eff es LogEnv
forall a b. (a -> b) -> a -> b
$ Text -> LogEnv -> IO LogEnv
K.closeScribe Text
name LogEnv
le
  StaticRep KatipE -> Eff es ()
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
StaticRep e -> Eff es ()
putStaticRep (StaticRep KatipE -> Eff es ()) -> StaticRep KatipE -> Eff es ()
forall a b. (a -> b) -> a -> b
$ LogEnv -> LogContexts -> Namespace -> StaticRep KatipE
MkKatipE LogEnv
newle LogContexts
lc Namespace
ns
-- | get the 'KatipE' 'LogEnv'
getLogEnv :: forall es. (KatipE :> es) => Eff es LogEnv
getLogEnv :: forall (es :: [Effect]). (KatipE :> es) => Eff es LogEnv
getLogEnv = do
  StaticRep KatipE
s <- forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep @KatipE
  case StaticRep KatipE
s of
    MkKatipE LogEnv
le LogContexts
_ Namespace
_ -> LogEnv -> Eff es LogEnv
forall a. a -> Eff es a
forall (m :: Type -> Type) a. Monad m => a -> m a
return LogEnv
le
-- | temporarily modify the 'LogEnv'
localLogEnv :: forall es a. (KatipE :> es) => (LogEnv -> LogEnv) -> Eff es a -> Eff es a
localLogEnv :: forall (es :: [Effect]) a.
(KatipE :> es) =>
(LogEnv -> LogEnv) -> Eff es a -> Eff es a
localLogEnv LogEnv -> LogEnv
f = forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
(StaticRep e -> StaticRep e) -> Eff es a -> Eff es a
localStaticRep @KatipE ((StaticRep KatipE -> StaticRep KatipE) -> Eff es a -> Eff es a)
-> (StaticRep KatipE -> StaticRep KatipE) -> Eff es a -> Eff es a
forall a b. (a -> b) -> a -> b
$ \(MkKatipE LogEnv
le LogContexts
lc Namespace
ns) -> LogEnv -> LogContexts -> Namespace -> StaticRep KatipE
MkKatipE (LogEnv -> LogEnv
f LogEnv
le) LogContexts
lc Namespace
ns
-- | get the 'KatipE' 'LogContexts'
getKatipContext :: (KatipE :> es) => Eff es LogContexts
getKatipContext :: forall (es :: [Effect]). (KatipE :> es) => Eff es LogContexts
getKatipContext = do
  StaticRep KatipE
s <- forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep @KatipE
  case StaticRep KatipE
s of
    MkKatipE LogEnv
_ LogContexts
lc Namespace
_ -> LogContexts -> Eff es LogContexts
forall a. a -> Eff es a
forall (m :: Type -> Type) a. Monad m => a -> m a
return LogContexts
lc
-- | temporarily modify the 'LogContexts'
localKatipContext :: forall es a. (KatipE :> es) => (LogContexts -> LogContexts) -> Eff es a -> Eff es a
localKatipContext :: forall (es :: [Effect]) a.
(KatipE :> es) =>
(LogContexts -> LogContexts) -> Eff es a -> Eff es a
localKatipContext LogContexts -> LogContexts
f = forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
(StaticRep e -> StaticRep e) -> Eff es a -> Eff es a
localStaticRep @KatipE ((StaticRep KatipE -> StaticRep KatipE) -> Eff es a -> Eff es a)
-> (StaticRep KatipE -> StaticRep KatipE) -> Eff es a -> Eff es a
forall a b. (a -> b) -> a -> b
$ \(MkKatipE LogEnv
le LogContexts
lc Namespace
ns) -> LogEnv -> LogContexts -> Namespace -> StaticRep KatipE
MkKatipE LogEnv
le (LogContexts -> LogContexts
f LogContexts
lc) Namespace
ns
getKatipNamespace :: forall es. (KatipE :> es) => Eff es Namespace
-- | get the 'KatipE' 'Namespace'
getKatipNamespace :: forall (es :: [Effect]). (KatipE :> es) => Eff es Namespace
getKatipNamespace = do
  StaticRep KatipE
s <- forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep @KatipE
  case StaticRep KatipE
s of
    MkKatipE LogEnv
_ LogContexts
_ Namespace
ns -> Namespace -> Eff es Namespace
forall a. a -> Eff es a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Namespace
ns
-- | temporarily modify the 'Namespace'
localKatipNamespace :: forall es a. (KatipE :> es) => (Namespace -> Namespace) -> Eff es a -> Eff es a
localKatipNamespace :: forall (es :: [Effect]) a.
(KatipE :> es) =>
(Namespace -> Namespace) -> Eff es a -> Eff es a
localKatipNamespace Namespace -> Namespace
f = forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
(StaticRep e -> StaticRep e) -> Eff es a -> Eff es a
localStaticRep @KatipE ((StaticRep KatipE -> StaticRep KatipE) -> Eff es a -> Eff es a)
-> (StaticRep KatipE -> StaticRep KatipE) -> Eff es a -> Eff es a
forall a b. (a -> b) -> a -> b
$ \(MkKatipE LogEnv
le LogContexts
lc Namespace
ns) -> LogEnv -> LogContexts -> Namespace -> StaticRep KatipE
MkKatipE LogEnv
le LogContexts
lc (Namespace -> StaticRep KatipE) -> Namespace -> StaticRep KatipE
forall a b. (a -> b) -> a -> b
$ Namespace -> Namespace
f Namespace
ns

-- | escape hatch for implementing your own scribes
unsafeEmbedIOE :: forall es a. (KatipE :> es) => ((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE :: forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (KatipE :> es, IOE :> es) => Eff es a
act = Dict (KatipE :> es, IOE :> es)
-> ((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
forall (a :: Constraint) r. Dict a -> (a => r) -> r
useDict (Dict (KatipE :> es) -> Dict (KatipE :> es, IOE :> es)
forall a b. a -> b
unsafeCoerce (forall (a :: Constraint). a => Dict a
MkDict @(KatipE :> es)) :: Dict (KatipE :> es, IOE :> es)) Eff es a
(KatipE :> es, IOE :> es) => Eff es a
(KatipE :> es, IOE :> es) => Eff es a
act

type Dict :: Constraint -> Type
data Dict a where
  MkDict :: (a) => Dict a

useDict :: forall a r. Dict a -> ((a) => r) -> r
useDict :: forall (a :: Constraint) r. Dict a -> (a => r) -> r
useDict Dict a
MkDict a => r
r = r
a => r
r
-- | Log with full context, but without any code location.
logF :: forall a es. (LogItem a, KatipE :> es) => a -> Namespace -> Severity -> LogStr -> Eff es ()
logF :: forall a (es :: [Effect]).
(LogItem a, KatipE :> es) =>
a -> Namespace -> Severity -> LogStr -> Eff es ()
logF a
a Namespace
ns Severity
sev LogStr
logs = ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ())
-> ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ a -> Namespace -> Severity -> LogStr -> Eff es ()
forall (m :: Type -> Type) a.
(Applicative m, LogItem a, Katip m) =>
a -> Namespace -> Severity -> LogStr -> m ()
K.logF a
a Namespace
ns Severity
sev LogStr
logs

-- | Log a message without any payload/context or code location.
logMsg :: forall es. (KatipE :> es) => Namespace -> Severity -> LogStr -> Eff es ()
logMsg :: forall (es :: [Effect]).
(KatipE :> es) =>
Namespace -> Severity -> LogStr -> Eff es ()
logMsg Namespace
ns Severity
sev LogStr
logs = ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ())
-> ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Namespace -> Severity -> LogStr -> Eff es ()
forall (m :: Type -> Type).
(Applicative m, Katip m) =>
Namespace -> Severity -> LogStr -> m ()
K.logMsg Namespace
ns Severity
sev LogStr
logs

{-# INLINE logT #-}
-- | Loc-tagged logging when using template-haskell. 
-- @
-- $(logT) obj mempty InfoS "Hello world"
-- @
logT :: ExpQ
logT :: ExpQ
logT = [|\a ns sev msg -> logItem a ns (Just $(ExpQ
getLocTH)) sev msg|]

{-# INLINE logLoc #-}
-- | 'Loc'-tagged logging using 'GHC.Stack.Stack' when available.
-- This function does not require template-haskell as it automatically uses implicit-callstacks when the code is compiled using GHC > 7.8.
-- Using an older version of the compiler will result in the emission of a log line without any location information, so be aware of it.
-- @
-- logLoc obj mempty InfoS "Hello world"
-- @
logLoc :: (LogItem a, KatipE :> es, HasCallStack) => a -> Namespace -> Severity -> LogStr -> Eff es ()
logLoc :: forall a (es :: [Effect]).
(LogItem a, KatipE :> es, HasCallStack) =>
a -> Namespace -> Severity -> LogStr -> Eff es ()
logLoc a
a Namespace
ns Severity
sev LogStr
logs = ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ())
-> ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ a -> Namespace -> Severity -> LogStr -> Eff es ()
forall (m :: Type -> Type) a.
(Applicative m, LogItem a, Katip m, HasCallStack) =>
a -> Namespace -> Severity -> LogStr -> m ()
K.logLoc a
a Namespace
ns Severity
sev LogStr
logs
-- | Log with everything, including a source code location.
-- This is very low level and you typically can use 'logT' in its place.
logItem :: (LogItem a, KatipE :> es) => a -> Namespace -> Maybe Loc -> Severity -> LogStr -> Eff es ()
logItem :: forall a (es :: [Effect]).
(LogItem a, KatipE :> es) =>
a -> Namespace -> Maybe Loc -> Severity -> LogStr -> Eff es ()
logItem a
a Namespace
ns Maybe Loc
loc Severity
sev LogStr
logs = ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ())
-> ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ a -> Namespace -> Maybe Loc -> Severity -> LogStr -> Eff es ()
forall (m :: Type -> Type) a.
(Applicative m, LogItem a, Katip m) =>
a -> Namespace -> Maybe Loc -> Severity -> LogStr -> m ()
K.logItem a
a Namespace
ns Maybe Loc
loc Severity
sev LogStr
logs
-- | Log an already constructed 'Item'.
-- This is the lowest level function that other log* functions use.
-- It can be useful when implementing centralised logging services.
logKatipItem :: (LogItem a, KatipE :> es) => Item a -> Eff es ()
logKatipItem :: forall a (es :: [Effect]).
(LogItem a, KatipE :> es) =>
Item a -> Eff es ()
logKatipItem Item a
item = ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ())
-> ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Item a -> Eff es ()
forall (m :: Type -> Type) a.
(Applicative m, LogItem a, Katip m) =>
Item a -> m ()
K.logKatipItem Item a
item
-- | Perform an action while logging any exceptions that may occur.
-- @
-- >>> > logException () mempty ErrorS (error "foo")
-- @
logException :: (LogItem a, KatipE :> es) => a -> Namespace -> Severity -> Eff es b -> Eff es b
logException :: forall a (es :: [Effect]) b.
(LogItem a, KatipE :> es) =>
a -> Namespace -> Severity -> Eff es b -> Eff es b
logException a
a Namespace
ns Severity
sev Eff es b
act = ((KatipE :> es, IOE :> es) => Eff es b) -> Eff es b
forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (((KatipE :> es, IOE :> es) => Eff es b) -> Eff es b)
-> ((KatipE :> es, IOE :> es) => Eff es b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ a -> Namespace -> Severity -> Eff es b -> Eff es b
forall (m :: Type -> Type) a b.
(Katip m, LogItem a, MonadCatch m, Applicative m) =>
a -> Namespace -> Severity -> m b -> m b
K.logException a
a Namespace
ns Severity
sev Eff es b
act
-- | Log with full context, but without any code location. 
-- Automatically supplies payload and namespace.
logFM :: (KatipE :> es) => Severity -> LogStr -> Eff es ()
logFM :: forall (es :: [Effect]).
(KatipE :> es) =>
Severity -> LogStr -> Eff es ()
logFM Severity
sev LogStr
logs = ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ())
-> ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Severity -> LogStr -> Eff es ()
forall (m :: Type -> Type).
(Applicative m, KatipContext m) =>
Severity -> LogStr -> m ()
K.logFM Severity
sev LogStr
logs

{-# INLINE logTM #-}
-- | 'Loc'-tagged logging when using template-haskell.
-- Automatically supplies payload and namespace.
-- @
-- $(logTM) InfoS "Hello world"
-- @
logTM :: ExpQ
logTM :: ExpQ
logTM = [|logItemM (Just $(ExpQ
getLocTH))|]
{-#INLINE logLocM #-}
-- | '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. 
-- @
-- logLocM InfoS "Hello world"
-- @
logLocM :: (KatipE :> es, HasCallStack) => Severity -> LogStr -> Eff es ()
logLocM :: forall (es :: [Effect]).
(KatipE :> es, HasCallStack) =>
Severity -> LogStr -> Eff es ()
logLocM Severity
sev LogStr
logs = ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ())
-> ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Severity -> LogStr -> Eff es ()
forall (m :: Type -> Type).
(Applicative m, KatipContext m, HasCallStack) =>
Severity -> LogStr -> m ()
K.logLocM Severity
sev LogStr
logs
-- | 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 :: (KatipE :> es, HasCallStack) => Maybe Loc -> Severity -> LogStr -> Eff es ()
logItemM :: forall (es :: [Effect]).
(KatipE :> es, HasCallStack) =>
Maybe Loc -> Severity -> LogStr -> Eff es ()
logItemM Maybe Loc
loc Severity
sev LogStr
logs = ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ())
-> ((KatipE :> es, IOE :> es) => Eff es ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ Maybe Loc -> Severity -> LogStr -> Eff es ()
forall (m :: Type -> Type).
(Applicative m, KatipContext m, HasCallStack) =>
Maybe Loc -> Severity -> LogStr -> m ()
K.logItemM Maybe Loc
loc Severity
sev LogStr
logs
-- | Perform an action while logging any exceptions that may occur.
-- @
-- >>> > error "foo" `logExceptionM` ErrorS
-- @
logExceptionM :: (KatipE :> es) => Eff es a -> Severity -> Eff es a
logExceptionM :: forall (es :: [Effect]) a.
(KatipE :> es) =>
Eff es a -> Severity -> Eff es a
logExceptionM Eff es a
act Severity
sev = ((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a)
-> ((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ Eff es a -> Severity -> Eff es a
forall (m :: Type -> Type) a.
(KatipContext m, MonadCatch m, Applicative m) =>
m a -> Severity -> m a
K.logExceptionM Eff es a
act Severity
sev

-- | Append a namespace segment to the current namespace for the given monadic action,
-- then restore the previous state afterwards.
katipAddNamespace :: (KatipE :> es) => Namespace -> Eff es a -> Eff es a
katipAddNamespace :: forall (es :: [Effect]) a.
(KatipE :> es) =>
Namespace -> Eff es a -> Eff es a
katipAddNamespace Namespace
ns = (Namespace -> Namespace) -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(KatipE :> es) =>
(Namespace -> Namespace) -> Eff es a -> Eff es a
localKatipNamespace (Namespace -> Namespace -> Namespace
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.
katipAddContext :: (KatipE :> es, LogItem i) => i -> Eff es a -> Eff es a
katipAddContext :: forall (es :: [Effect]) i a.
(KatipE :> es, LogItem i) =>
i -> Eff es a -> Eff es a
katipAddContext i
ctx = (LogContexts -> LogContexts) -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(KatipE :> es) =>
(LogContexts -> LogContexts) -> Eff es a -> Eff es a
localKatipContext (LogContexts -> LogContexts -> LogContexts
forall a. Semigroup a => a -> a -> a
<> i -> LogContexts
forall a. LogItem a => a -> LogContexts
liftPayload i
ctx)
-- | Disable all scribes for the given monadic action,
-- then restore them afterwards.
katipNoLogging :: (KatipE :> es) => Eff es a -> Eff es a
katipNoLogging :: forall (es :: [Effect]) a. (KatipE :> es) => Eff es a -> Eff es a
katipNoLogging = (LogEnv -> LogEnv) -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(KatipE :> es) =>
(LogEnv -> LogEnv) -> Eff es a -> Eff es a
localLogEnv ((LogEnv -> LogEnv) -> Eff es a -> Eff es a)
-> (LogEnv -> LogEnv) -> Eff es a -> Eff es a
forall a b. (a -> b) -> a -> b
$ \LogEnv
lenv -> LogEnv
lenv{_logEnvScribes = mempty}

-- | Logs to a file handle such as stdout, stderr, or a file.
-- Contexts and other information will be flattened out into bracketed fields. 
-- For example:]
-- @
-- [2016-05-11 21:01:15][MyApp][Info][myhost.example.com][PID 1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:32:7] Started
-- [2016-05-11 21:01:15][MyApp.confrabulation][Debug][myhost.example.com][PID 1724][ThreadId 1154][confrab_factor:42.0][main:Helpers.Logging Helpers/Logging.hs:41:9] Confrabulating widgets, with extra namespace and context
-- [2016-05-11 21:01:15][MyApp][Info][myhost.example.com][PID 1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:43:7] Namespace and context are back to normal
-- @
-- Returns the newly-created 'Scribe'. The finalizer flushes the handle. Handle mode is set to 'System.IO.LineBuffering' automatically.
mkHandleScribe :: forall es. (KatipE :> es) => ColorStrategy -> Handle -> PermitFunc -> Verbosity -> Eff es Scribe
mkHandleScribe :: forall (es :: [Effect]).
(KatipE :> es) =>
ColorStrategy -> Handle -> PermitFunc -> Verbosity -> Eff es Scribe
mkHandleScribe ColorStrategy
cs Handle
h PermitFunc
pf Verbosity
v = ((KatipE :> es, IOE :> es) => Eff es Scribe) -> Eff es Scribe
forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (((KatipE :> es, IOE :> es) => Eff es Scribe) -> Eff es Scribe)
-> ((KatipE :> es, IOE :> es) => Eff es Scribe) -> Eff es Scribe
forall a b. (a -> b) -> a -> b
$ IO Scribe -> Eff es Scribe
forall a. IO a -> Eff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Scribe -> Eff es Scribe) -> IO Scribe -> Eff es Scribe
forall a b. (a -> b) -> a -> b
$ ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe
K.mkHandleScribe ColorStrategy
cs Handle
h Item a -> IO Bool
PermitFunc
pf Verbosity
v
-- | Logs to a file handle such as stdout, stderr, or a file.
-- Takes a custom 'ItemFormatter' that can be used to format 'Item' as needed.
-- Returns the newly-created 'Scribe'.
-- The finalizer flushes the handle.
-- Handle mode is set to 'System.IO.LineBuffering' automatically.
mkHandleScribeWithFormatter :: forall es. (KatipE :> es) => (forall a. (LogItem a) => ItemFormatter a) -> ColorStrategy -> Handle -> PermitFunc -> Verbosity -> Eff es Scribe
mkHandleScribeWithFormatter :: forall (es :: [Effect]).
(KatipE :> es) =>
(forall a. LogItem a => ItemFormatter a)
-> ColorStrategy
-> Handle
-> PermitFunc
-> Verbosity
-> Eff es Scribe
mkHandleScribeWithFormatter forall a. LogItem a => ItemFormatter a
ifa ColorStrategy
cs Handle
h PermitFunc
pf Verbosity
v = ((KatipE :> es, IOE :> es) => Eff es Scribe) -> Eff es Scribe
forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (((KatipE :> es, IOE :> es) => Eff es Scribe) -> Eff es Scribe)
-> ((KatipE :> es, IOE :> es) => Eff es Scribe) -> Eff es Scribe
forall a b. (a -> b) -> a -> b
$ IO Scribe -> Eff es Scribe
forall a. IO a -> Eff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Scribe -> Eff es Scribe) -> IO Scribe -> Eff es Scribe
forall a b. (a -> b) -> a -> b
$ (forall a. LogItem a => ItemFormatter a)
-> ColorStrategy -> Handle -> PermitFunc -> Verbosity -> IO Scribe
K.mkHandleScribeWithFormatter ItemFormatter a
forall a. LogItem a => ItemFormatter a
ifa ColorStrategy
cs Handle
h Item a -> IO Bool
PermitFunc
pf Verbosity
v
-- | A specialization of 'mkHandleScribe' that takes a 'FilePath' instead of a 'Handle'. It is responsible for opening the file in 'System.IO.AppendMode' and will close the file handle on closeScribe/closeScribes. Does not do log coloring. Sets handle to 'System.IO.LineBuffering' mode.
mkFileScribe :: forall es. (KatipE :> es) => FilePath -> PermitFunc -> Verbosity -> Eff es Scribe
mkFileScribe :: forall (es :: [Effect]).
(KatipE :> es) =>
FilePath -> PermitFunc -> Verbosity -> Eff es Scribe
mkFileScribe FilePath
fp PermitFunc
pf Verbosity
v = ((KatipE :> es, IOE :> es) => Eff es Scribe) -> Eff es Scribe
forall (es :: [Effect]) a.
(KatipE :> es) =>
((KatipE :> es, IOE :> es) => Eff es a) -> Eff es a
unsafeEmbedIOE (((KatipE :> es, IOE :> es) => Eff es Scribe) -> Eff es Scribe)
-> ((KatipE :> es, IOE :> es) => Eff es Scribe) -> Eff es Scribe
forall a b. (a -> b) -> a -> b
$ IO Scribe -> Eff es Scribe
forall a. IO a -> Eff es a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO Scribe -> Eff es Scribe) -> IO Scribe -> Eff es Scribe
forall a b. (a -> b) -> a -> b
$ FilePath -> PermitFunc -> Verbosity -> IO Scribe
K.mkFileScribe FilePath
fp Item a -> IO Bool
PermitFunc
pf Verbosity
v