{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Effectful.Log
(
Log
, runLog
, module Log
) where
import Data.Text (Text)
import Data.Time.Clock
import Effectful.Dispatch.Static
import Effectful
import Log
data Log :: Effect
type instance DispatchOf Log = Static WithSideEffects
newtype instance StaticRep Log = Log LoggerEnv
runLog
:: IOE :> es
=> Text
-> Logger
-> LogLevel
-> Eff (Log : es) a
-> 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
}
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