{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- | Logging via 'MonadLog'.
module Effectful.Log
  ( -- * Effect
    Log (..)

    -- ** Handlers
  , runLog

    -- * Re-exports
  , module Log
  ) where

import Data.Aeson.Types
import Data.Text (Text)
import Data.Time.Clock
import Effectful.Dispatch.Dynamic
import Effectful.Reader.Static
import Effectful
import Log

-- | Provide the ability to log messages via 'MonadLog'.
data Log :: Effect where
  LogMessageOp :: LogLevel -> Text -> Value -> Log m ()
  LocalData :: [Pair] -> m a -> Log m a
  LocalDomain :: Text -> m a -> Log m a
  LocalMaxLogLevel :: LogLevel -> m a -> Log m a
  GetLoggerEnv :: Log m LoggerEnv

type instance DispatchOf Log = Dynamic

-- | Run the 'Log' effect.
--
-- /Note:/ this is the @effectful@ version of 'runLogT'.
runLog
  :: IOE :> es
  => Text
  -- ^ Application component name to use.
  -> Logger
  -- ^ The logging back-end to use.
  -> LogLevel
  -- ^ The maximum log level allowed to be logged.
  -> Eff (Log : es) a
  -- ^ The computation to run.
  -> Eff es a
runLog :: forall (es :: [Effect]) a.
(IOE :> es) =>
Text -> Logger -> LogLevel -> Eff (Log : es) a -> Eff es a
runLog Text
component Logger
logger LogLevel
maxLogLevel = (Eff (Reader LoggerEnv : es) a -> Eff es a)
-> (forall {a} {localEs :: [Effect]}.
    (HasCallStack, Log :> localEs) =>
    LocalEnv localEs (Reader LoggerEnv : es)
    -> Log (Eff localEs) a -> Eff (Reader LoggerEnv : es) a)
-> Eff (Log : es) a
-> Eff es a
forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (Reader LoggerEnv : es) a -> Eff es a
reader ((forall {a} {localEs :: [Effect]}.
  (HasCallStack, Log :> localEs) =>
  LocalEnv localEs (Reader LoggerEnv : es)
  -> Log (Eff localEs) a -> Eff (Reader LoggerEnv : es) a)
 -> Eff (Log : es) a -> Eff es a)
-> (forall {a} {localEs :: [Effect]}.
    (HasCallStack, Log :> localEs) =>
    LocalEnv localEs (Reader LoggerEnv : es)
    -> Log (Eff localEs) a -> Eff (Reader LoggerEnv : es) a)
-> Eff (Log : es) a
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (Reader LoggerEnv : es)
env -> \case
  LogMessageOp LogLevel
level Text
message Value
data_ -> do
    UTCTime
time <- IO UTCTime -> Eff (Reader LoggerEnv : es) UTCTime
forall a. IO a -> Eff (Reader LoggerEnv : es) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    LoggerEnv
logEnv <- Eff (Reader LoggerEnv : es) LoggerEnv
forall r (es :: [Effect]).
(HasCallStack, Reader r :> es) =>
Eff es r
ask
    IO () -> Eff (Reader LoggerEnv : es) ()
forall a. IO a -> Eff (Reader LoggerEnv : es) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff (Reader LoggerEnv : es) ())
-> IO () -> Eff (Reader LoggerEnv : es) ()
forall a b. (a -> b) -> a -> b
$ LoggerEnv -> UTCTime -> LogLevel -> Text -> Value -> IO ()
logMessageIO LoggerEnv
logEnv UTCTime
time LogLevel
level Text
message Value
data_
  LocalData [Pair]
data_ Eff localEs a
action -> LocalEnv localEs (Reader LoggerEnv : es)
-> ((forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r)
    -> Eff (Reader LoggerEnv : es) a)
-> Eff (Reader LoggerEnv : es) a
forall (es :: [Effect]) (handlerEs :: [Effect])
       (localEs :: [Effect]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs (Reader LoggerEnv : es)
env (((forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r)
  -> Eff (Reader LoggerEnv : es) a)
 -> Eff (Reader LoggerEnv : es) a)
-> ((forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r)
    -> Eff (Reader LoggerEnv : es) a)
-> Eff (Reader LoggerEnv : es) a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r
unlift -> do
    ((LoggerEnv -> LoggerEnv)
-> Eff (Reader LoggerEnv : es) a -> Eff (Reader LoggerEnv : es) a
forall r (es :: [Effect]) a.
(HasCallStack, Reader r :> es) =>
(r -> r) -> Eff es a -> Eff es a
`local` Eff localEs a -> Eff (Reader LoggerEnv : es) a
forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r
unlift Eff localEs a
action) ((LoggerEnv -> LoggerEnv) -> Eff (Reader LoggerEnv : es) a)
-> (LoggerEnv -> LoggerEnv) -> Eff (Reader LoggerEnv : es) a
forall a b. (a -> b) -> a -> b
$ \LoggerEnv
logEnv -> LoggerEnv
logEnv { leData = data_ ++ leData logEnv }
  LocalDomain Text
domain Eff localEs a
action -> LocalEnv localEs (Reader LoggerEnv : es)
-> ((forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r)
    -> Eff (Reader LoggerEnv : es) a)
-> Eff (Reader LoggerEnv : es) a
forall (es :: [Effect]) (handlerEs :: [Effect])
       (localEs :: [Effect]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs (Reader LoggerEnv : es)
env (((forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r)
  -> Eff (Reader LoggerEnv : es) a)
 -> Eff (Reader LoggerEnv : es) a)
-> ((forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r)
    -> Eff (Reader LoggerEnv : es) a)
-> Eff (Reader LoggerEnv : es) a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r
unlift -> do
    ((LoggerEnv -> LoggerEnv)
-> Eff (Reader LoggerEnv : es) a -> Eff (Reader LoggerEnv : es) a
forall r (es :: [Effect]) a.
(HasCallStack, Reader r :> es) =>
(r -> r) -> Eff es a -> Eff es a
`local` Eff localEs a -> Eff (Reader LoggerEnv : es) a
forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r
unlift Eff localEs a
action) ((LoggerEnv -> LoggerEnv) -> Eff (Reader LoggerEnv : es) a)
-> (LoggerEnv -> LoggerEnv) -> Eff (Reader LoggerEnv : es) a
forall a b. (a -> b) -> a -> b
$ \LoggerEnv
logEnv -> LoggerEnv
logEnv { leDomain = leDomain logEnv ++ [domain] }
  LocalMaxLogLevel LogLevel
level Eff localEs a
action -> LocalEnv localEs (Reader LoggerEnv : es)
-> ((forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r)
    -> Eff (Reader LoggerEnv : es) a)
-> Eff (Reader LoggerEnv : es) a
forall (es :: [Effect]) (handlerEs :: [Effect])
       (localEs :: [Effect]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs (Reader LoggerEnv : es)
env (((forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r)
  -> Eff (Reader LoggerEnv : es) a)
 -> Eff (Reader LoggerEnv : es) a)
-> ((forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r)
    -> Eff (Reader LoggerEnv : es) a)
-> Eff (Reader LoggerEnv : es) a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r
unlift -> do
    ((LoggerEnv -> LoggerEnv)
-> Eff (Reader LoggerEnv : es) a -> Eff (Reader LoggerEnv : es) a
forall r (es :: [Effect]) a.
(HasCallStack, Reader r :> es) =>
(r -> r) -> Eff es a -> Eff es a
`local` Eff localEs a -> Eff (Reader LoggerEnv : es) a
forall {r}. Eff localEs r -> Eff (Reader LoggerEnv : es) r
unlift Eff localEs a
action) ((LoggerEnv -> LoggerEnv) -> Eff (Reader LoggerEnv : es) a)
-> (LoggerEnv -> LoggerEnv) -> Eff (Reader LoggerEnv : es) a
forall a b. (a -> b) -> a -> b
$ \LoggerEnv
logEnv -> LoggerEnv
logEnv { leMaxLogLevel = level }
  Log (Eff localEs) a
GetLoggerEnv -> Eff (Reader LoggerEnv : es) a
forall r (es :: [Effect]).
(HasCallStack, Reader r :> es) =>
Eff es r
ask
  where
    reader :: Eff (Reader LoggerEnv : es) a -> Eff es a
reader = LoggerEnv -> Eff (Reader LoggerEnv : es) a -> Eff es a
forall r (es :: [Effect]) a.
HasCallStack =>
r -> Eff (Reader r : es) a -> Eff es a
runReader LoggerEnv
      { leLogger :: Logger
leLogger = Logger
logger
      , leComponent :: Text
leComponent = Text
component
      , leDomain :: [Text]
leDomain = []
      , leData :: [Pair]
leData = []
      , leMaxLogLevel :: LogLevel
leMaxLogLevel = LogLevel
maxLogLevel
      }

-- | Orphan, canonical instance.
instance Log :> es => MonadLog (Eff es) where
  logMessage :: LogLevel -> Text -> Value -> Eff es ()
logMessage LogLevel
level Text
message Value
data_ = Log (Eff es) () -> Eff es ()
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Log (Eff es) () -> Eff es ()) -> Log (Eff es) () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ LogLevel -> Text -> Value -> Log (Eff es) ()
forall (m :: Type -> Type). LogLevel -> Text -> Value -> Log m ()
LogMessageOp LogLevel
level Text
message Value
data_
  localData :: forall a. [Pair] -> Eff es a -> Eff es a
localData [Pair]
data_ Eff es a
action = Log (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Log (Eff es) a -> Eff es a) -> Log (Eff es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ [Pair] -> Eff es a -> Log (Eff es) a
forall (m :: Type -> Type) a. [Pair] -> m a -> Log m a
LocalData [Pair]
data_ Eff es a
action
  localDomain :: forall a. Text -> Eff es a -> Eff es a
localDomain Text
domain Eff es a
action = Log (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Log (Eff es) a -> Eff es a) -> Log (Eff es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Text -> Eff es a -> Log (Eff es) a
forall (m :: Type -> Type) a. Text -> m a -> Log m a
LocalDomain Text
domain Eff es a
action
  localMaxLogLevel :: forall a. LogLevel -> Eff es a -> Eff es a
localMaxLogLevel LogLevel
level Eff es a
action = Log (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Log (Eff es) a -> Eff es a) -> Log (Eff es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ LogLevel -> Eff es a -> Log (Eff es) a
forall (m :: Type -> Type) a. LogLevel -> m a -> Log m a
LocalMaxLogLevel LogLevel
level Eff es a
action
  getLoggerEnv :: Eff es LoggerEnv
getLoggerEnv = Log (Eff es) LoggerEnv -> Eff es LoggerEnv
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Log (Eff es) LoggerEnv
forall (m :: Type -> Type). Log m LoggerEnv
GetLoggerEnv