-- | 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
    => { loc :: !Loc
        -- ^ The location of the code that is logging this
       , 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 loc lvl msg = send (LoggerLog (MkLogMsg loc lvl 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 level = [|loggerLog @Text $(TH.qLocation >>= liftLoc) $(TH.lift level)|]

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

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

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

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