-- | a Logging effect and utility functions using it
module Control.Effect.Logging
  ( -- ** logging log messages as an effect
    LogMsg (..)
  , Logging (..)
  , loggerLog

    -- ** logging with TH
  , logTH
  , logDebug
  , logInfo
  , logWarn
  , logError
  )
where

import Control.Algebra (Has, send)
import Control.Monad.Logger
  ( Loc
  , LogLevel (LevelDebug, LevelError, LevelInfo, LevelWarn)
  , ToLogStr
  , liftLoc
  )
import Data.Kind (Type)
import Data.Text (Text)
import Language.Haskell.TH (Exp, Q)
import Language.Haskell.TH.Syntax qualified as TH

-- | a single line of a logging message
data LogMsg where
  MkLogMsg
    :: ToLogStr msg
    => { LogMsg -> Loc
loc :: !Loc
        -- ^ The location of the code that is logging this
       , LogMsg -> LogLevel
lvl :: !LogLevel
        -- ^ the log level of this function
       , ()
msg :: !msg
        -- ^ the message that is being put into the log
       }
    -> LogMsg

-- | the logging effect
type Logging :: (Type -> Type) -> Type -> Type
data Logging m r where
  LoggerLog :: !LogMsg -> Logging m ()

-- | logs with a location 'Loc', level 'LogLevel' and message @msg@
loggerLog :: forall msg sig m. (Has Logging sig m, ToLogStr msg) => Loc -> LogLevel -> msg -> m ()
loggerLog :: forall msg (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has Logging sig m, ToLogStr msg) =>
Loc -> LogLevel -> msg -> m ()
loggerLog Loc
loc LogLevel
lvl msg
msg = Logging m () -> m ()
forall (eff :: (* -> *) -> * -> *) (sig :: (* -> *) -> * -> *)
       (m :: * -> *) a.
(Member eff sig, Algebra sig m) =>
eff m a -> m a
send (LogMsg -> Logging m ()
forall (m :: * -> *). LogMsg -> Logging m ()
LoggerLog (Loc -> LogLevel -> msg -> LogMsg
forall msg. ToLogStr msg => Loc -> LogLevel -> msg -> LogMsg
MkLogMsg Loc
loc LogLevel
lvl msg
msg))
{-# INLINE loggerLog #-}

-- | takes a 'LogLevel' and returns a splice that, if spliced in, returns a function
--   that takes a 'Text' and returns @'Has' 'Logging' sig m => m ()@
logTH :: LogLevel -> Q Exp
logTH :: LogLevel -> Q Exp
logTH LogLevel
level = [|loggerLog @Text $(Q Loc
forall (m :: * -> *). Quasi m => m Loc
TH.qLocation Q Loc -> (Loc -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Loc -> Q Exp
liftLoc) $(LogLevel -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => LogLevel -> m Exp
TH.lift LogLevel
level)|]

-- | log with loglevel 'LevelDebug'
logDebug :: Q Exp
logDebug :: Q Exp
logDebug = LogLevel -> Q Exp
logTH LogLevel
LevelDebug

-- | log with loglevel 'LevelInfo'
logInfo :: Q Exp
logInfo :: Q Exp
logInfo = LogLevel -> Q Exp
logTH LogLevel
LevelInfo

-- | log with loglevel 'LevelWarn'
logWarn :: Q Exp
logWarn :: Q Exp
logWarn = LogLevel -> Q Exp
logTH LogLevel
LevelWarn

-- | log with loglevel 'LevelError'
logError :: Q Exp
logError :: Q Exp
logError = LogLevel -> Q Exp
logTH LogLevel
LevelError