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

    -- ** Handlers
  , runLog

    -- * Re-exports
  , module Log
  ) where

import Data.Text (Text)
import Data.Time.Clock
import Effectful.Dispatch.Static
import Effectful
import Log

-- | Provide the ability to log messages via 'MonadLog'.
data Log :: Effect

type instance DispatchOf Log = Static WithSideEffects
newtype instance StaticRep Log = Log LoggerEnv

-- | 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 = 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 forall a b. (a -> b) -> a -> b
$ LoggerEnv -> StaticRep Log
Log 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_ = do
    UTCTime
time <- forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO UTCTime
getCurrentTime
    Log LoggerEnv
logEnv <- forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep
    forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ 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 :: forall a. [Pair] -> Eff es a -> Eff es a
localData [Pair]
data_ = 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 forall a b. (a -> b) -> a -> b
$ \(Log LoggerEnv
logEnv) ->
    LoggerEnv -> StaticRep Log
Log LoggerEnv
logEnv { leData :: [Pair]
leData = [Pair]
data_ forall a. [a] -> [a] -> [a]
++ LoggerEnv -> [Pair]
leData LoggerEnv
logEnv }

  localDomain :: forall a. Text -> Eff es a -> Eff es a
localDomain Text
domain = 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 forall a b. (a -> b) -> a -> b
$ \(Log LoggerEnv
logEnv) ->
    LoggerEnv -> StaticRep Log
Log LoggerEnv
logEnv { leDomain :: [Text]
leDomain = LoggerEnv -> [Text]
leDomain LoggerEnv
logEnv forall a. [a] -> [a] -> [a]
++ [Text
domain] }

  localMaxLogLevel :: forall a. LogLevel -> Eff es a -> Eff es a
localMaxLogLevel LogLevel
level = 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 forall a b. (a -> b) -> a -> b
$ \(Log LoggerEnv
logEnv) ->
    LoggerEnv -> StaticRep Log
Log LoggerEnv
logEnv { leMaxLogLevel :: LogLevel
leMaxLogLevel = LogLevel
level }

  getLoggerEnv :: Eff es LoggerEnv
getLoggerEnv = do
    Log LoggerEnv
env <- forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure LoggerEnv
env