Logger.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | [monad-logger](https://hackage.haskell.org/package/monad-logger) bridge: a static
-- effect holding a log callback, plus a 'MonadLogger' instance for 'Eff' so the usual @logInfoN@ etc. work.
module Effectful.Logger (
  Logger,
  LogFunc,
  runLogger,
  runStderrLogger,
  runOTelLogger,
) where

import Control.Monad.Logger (
  Loc,
  LogLevel,
  LogSource,
  LogStr,
  MonadLogger (..),
  defaultOutput,
  toLogStr,
 )
import Effectful (Dispatch (..), DispatchOf, Eff, Effect, IOE, (:>))
import Effectful.Dispatch.Static (
  SideEffects (..),
  StaticRep,
  evalStaticRep,
  getStaticRep,
  unsafeEff_,
 )
import OpenTelemetry.Instrumentation.MonadLogger qualified as OTel
import OpenTelemetry.Log.Core qualified as OTel
import System.IO (stderr)

-- | [monad-logger](https://hackage.haskell.org/package/monad-logger) style log callback.
--
-- @since 0.1.0.0
type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()

-- | Static effect providing a 'LogFunc'.
--
-- @since 0.1.0.0
data Logger :: Effect

type instance DispatchOf Logger = Static WithSideEffects

newtype instance StaticRep Logger = Logger LogFunc

-- | Run the t'Logger' effect with the given log callback.
--
-- @since 0.1.0.0
runLogger
  :: IOE :> es
  => LogFunc
  -- ^ log callback
  -> Eff (Logger : es) a
  -- ^ action using the logger
  -> Eff es a
runLogger = evalStaticRep . Logger

-- | Run the t'Logger' effect, writing to stderr.
--
-- @since 0.1.0.0
runStderrLogger
  :: IOE :> es
  => Eff (Logger : es) a
  -- ^ action using the logger
  -> Eff es a
runStderrLogger = runLogger (defaultOutput stderr)

-- | Run the t'Logger' effect, emitting OpenTelemetry log records.
--
-- @since 0.1.0.0
runOTelLogger
  :: IOE :> es
  => OTel.Logger
  -- ^ OpenTelemetry logger
  -> Eff (Logger : es) a
  -- ^ action using the logger
  -> Eff es a
runOTelLogger = runLogger . OTel.makeOTelLogCallback

instance Logger :> es => MonadLogger (Eff es) where
  monadLoggerLog loc src lvl msg = do
    Logger f <- getStaticRep
    unsafeEff_ $ f loc src lvl (toLogStr msg)