{-# LANGUAGE UndecidableInstances #-}

-- | simple logging to a mutable cell for testing purposes
module Control.Carrier.Logging.Ref where

import Control.Algebra (Algebra (alg), (:+:) (L, R))
import Control.Carrier.Reader (ReaderC (ReaderC))
import Control.Effect.Logging (LogMsg (MkLogMsg), Logging (LoggerLog))
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Logger (ToLogStr (toLogStr))
import Data.IORef (IORef, atomicModifyIORef')
import Data.Kind (Type)
import Data.Sequence (Seq ((:|>)))
import UnliftIO (MonadUnliftIO)

type RefLoggingC :: (Type -> Type) -> Type -> Type
newtype RefLoggingC m a = RefLoggingC {runRefLoggingC :: IORef (Seq LogMsg) -> m a}
  deriving
    (Functor, Applicative, Monad, MonadIO, MonadFail, MonadUnliftIO)
    via ReaderC (IORef (Seq LogMsg)) m

-- | pass a cell that is supposed to be logged to
runRefLogging :: IORef (Seq LogMsg) -> RefLoggingC m a -> m a
runRefLogging = flip runRefLoggingC
{-# INLINE runRefLogging #-}

instance (Algebra sig m, MonadIO m) => Algebra (Logging :+: sig) (RefLoggingC m) where
  alg hdl sig ctx = case sig of
    L (LoggerLog (MkLogMsg loc lvl msg)) ->
      (<$ ctx) <$> RefLoggingC \ref -> do
        liftIO do
          atomicModifyIORef' ref (\t -> (t :|> MkLogMsg loc lvl (toLogStr msg), ()))
    R other -> RefLoggingC \ref -> do
      alg (runRefLogging ref . hdl) other ctx