{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- | A pure carrier for the 'Logger' effect, using an underlying 'Writer'
-- effect.
--
-- >>> length (fst (run (runLoggerW (logDebugN "1" >> logDebugN "2" >> logWarnN "3"))))
-- 3
module Control.Carrier.Logger.Writer (
  LoggerWriterC (..),
  runLoggerW,
) where

import Control.Algebra (Algebra (..), (:+:) (..))
import Control.Carrier.Writer.Strict (WriterC, runWriter, tell)
import Control.Effect.Logger (Logger (..))
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Logger (
  LogLine,
  ToLogStr (..),
 )

-- | Reinterpreter from logger to writer. The underlying 'Writer' is always
-- 'Control.Carrier.Writer.Strict'.
newtype LoggerWriterC w m a = LoggerWriterC
  { forall (w :: * -> *) (m :: * -> *) a.
LoggerWriterC w m a -> WriterC (w LogLine) m a
runLoggerWriterC :: WriterC (w LogLine) m a
  }
  deriving (Functor (LoggerWriterC w m)
Functor (LoggerWriterC w m) =>
(forall a. a -> LoggerWriterC w m a)
-> (forall a b.
    LoggerWriterC w m (a -> b)
    -> LoggerWriterC w m a -> LoggerWriterC w m b)
-> (forall a b c.
    (a -> b -> c)
    -> LoggerWriterC w m a
    -> LoggerWriterC w m b
    -> LoggerWriterC w m c)
-> (forall a b.
    LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m b)
-> (forall a b.
    LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m a)
-> Applicative (LoggerWriterC w m)
forall a. a -> LoggerWriterC w m a
forall a b.
LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m a
forall a b.
LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m b
forall a b.
LoggerWriterC w m (a -> b)
-> LoggerWriterC w m a -> LoggerWriterC w m b
forall a b c.
(a -> b -> c)
-> LoggerWriterC w m a
-> LoggerWriterC w m b
-> LoggerWriterC w m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (w :: * -> *) (m :: * -> *).
Monad m =>
Functor (LoggerWriterC w m)
forall (w :: * -> *) (m :: * -> *) a.
Monad m =>
a -> LoggerWriterC w m a
forall (w :: * -> *) (m :: * -> *) a b.
Monad m =>
LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m a
forall (w :: * -> *) (m :: * -> *) a b.
Monad m =>
LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m b
forall (w :: * -> *) (m :: * -> *) a b.
Monad m =>
LoggerWriterC w m (a -> b)
-> LoggerWriterC w m a -> LoggerWriterC w m b
forall (w :: * -> *) (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> LoggerWriterC w m a
-> LoggerWriterC w m b
-> LoggerWriterC w m c
$cpure :: forall (w :: * -> *) (m :: * -> *) a.
Monad m =>
a -> LoggerWriterC w m a
pure :: forall a. a -> LoggerWriterC w m a
$c<*> :: forall (w :: * -> *) (m :: * -> *) a b.
Monad m =>
LoggerWriterC w m (a -> b)
-> LoggerWriterC w m a -> LoggerWriterC w m b
<*> :: forall a b.
LoggerWriterC w m (a -> b)
-> LoggerWriterC w m a -> LoggerWriterC w m b
$cliftA2 :: forall (w :: * -> *) (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> LoggerWriterC w m a
-> LoggerWriterC w m b
-> LoggerWriterC w m c
liftA2 :: forall a b c.
(a -> b -> c)
-> LoggerWriterC w m a
-> LoggerWriterC w m b
-> LoggerWriterC w m c
$c*> :: forall (w :: * -> *) (m :: * -> *) a b.
Monad m =>
LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m b
*> :: forall a b.
LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m b
$c<* :: forall (w :: * -> *) (m :: * -> *) a b.
Monad m =>
LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m a
<* :: forall a b.
LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m a
Applicative, (forall a b.
 (a -> b) -> LoggerWriterC w m a -> LoggerWriterC w m b)
-> (forall a b. a -> LoggerWriterC w m b -> LoggerWriterC w m a)
-> Functor (LoggerWriterC w m)
forall a b. a -> LoggerWriterC w m b -> LoggerWriterC w m a
forall a b. (a -> b) -> LoggerWriterC w m a -> LoggerWriterC w m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (w :: * -> *) (m :: * -> *) a b.
Functor m =>
a -> LoggerWriterC w m b -> LoggerWriterC w m a
forall (w :: * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> LoggerWriterC w m a -> LoggerWriterC w m b
$cfmap :: forall (w :: * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> LoggerWriterC w m a -> LoggerWriterC w m b
fmap :: forall a b. (a -> b) -> LoggerWriterC w m a -> LoggerWriterC w m b
$c<$ :: forall (w :: * -> *) (m :: * -> *) a b.
Functor m =>
a -> LoggerWriterC w m b -> LoggerWriterC w m a
<$ :: forall a b. a -> LoggerWriterC w m b -> LoggerWriterC w m a
Functor, Applicative (LoggerWriterC w m)
Applicative (LoggerWriterC w m) =>
(forall a b.
 LoggerWriterC w m a
 -> (a -> LoggerWriterC w m b) -> LoggerWriterC w m b)
-> (forall a b.
    LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m b)
-> (forall a. a -> LoggerWriterC w m a)
-> Monad (LoggerWriterC w m)
forall a. a -> LoggerWriterC w m a
forall a b.
LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m b
forall a b.
LoggerWriterC w m a
-> (a -> LoggerWriterC w m b) -> LoggerWriterC w m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (w :: * -> *) (m :: * -> *).
Monad m =>
Applicative (LoggerWriterC w m)
forall (w :: * -> *) (m :: * -> *) a.
Monad m =>
a -> LoggerWriterC w m a
forall (w :: * -> *) (m :: * -> *) a b.
Monad m =>
LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m b
forall (w :: * -> *) (m :: * -> *) a b.
Monad m =>
LoggerWriterC w m a
-> (a -> LoggerWriterC w m b) -> LoggerWriterC w m b
$c>>= :: forall (w :: * -> *) (m :: * -> *) a b.
Monad m =>
LoggerWriterC w m a
-> (a -> LoggerWriterC w m b) -> LoggerWriterC w m b
>>= :: forall a b.
LoggerWriterC w m a
-> (a -> LoggerWriterC w m b) -> LoggerWriterC w m b
$c>> :: forall (w :: * -> *) (m :: * -> *) a b.
Monad m =>
LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m b
>> :: forall a b.
LoggerWriterC w m a -> LoggerWriterC w m b -> LoggerWriterC w m b
$creturn :: forall (w :: * -> *) (m :: * -> *) a.
Monad m =>
a -> LoggerWriterC w m a
return :: forall a. a -> LoggerWriterC w m a
Monad, Monad (LoggerWriterC w m)
Monad (LoggerWriterC w m) =>
(forall a. IO a -> LoggerWriterC w m a)
-> MonadIO (LoggerWriterC w m)
forall a. IO a -> LoggerWriterC w m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (w :: * -> *) (m :: * -> *).
MonadIO m =>
Monad (LoggerWriterC w m)
forall (w :: * -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> LoggerWriterC w m a
$cliftIO :: forall (w :: * -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> LoggerWriterC w m a
liftIO :: forall a. IO a -> LoggerWriterC w m a
MonadIO)

instance
  forall sig w m
   . ( Algebra sig m
     , Applicative w
     , Monoid (w LogLine)
     )
  => Algebra (Logger :+: sig) (LoggerWriterC w m)
  where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (LoggerWriterC w m)
-> (:+:) Logger sig n a -> ctx () -> LoggerWriterC w m (ctx a)
alg Handler ctx n (LoggerWriterC w m)
hdl (:+:) Logger sig n a
sig ctx ()
ctx = case (:+:) Logger sig n a
sig of
    L (LoggerLog Loc
loc LogSource
src LogLevel
lvl msg
msg) ->
      ctx a
ctx ()
ctx ctx a -> LoggerWriterC w m () -> LoggerWriterC w m (ctx a)
forall a b. a -> LoggerWriterC w m b -> LoggerWriterC w m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ WriterC (w LogLine) m () -> LoggerWriterC w m ()
forall (w :: * -> *) (m :: * -> *) a.
WriterC (w LogLine) m a -> LoggerWriterC w m a
LoggerWriterC (w LogLine -> WriterC (w LogLine) m ()
forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Writer w) sig m =>
w -> m ()
tell (LogLine -> w LogLine
forall a. a -> w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Loc
loc, LogSource
src, LogLevel
lvl, msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
msg) :: w LogLine))
    R sig n a
other ->
      WriterC (w LogLine) m (ctx a) -> LoggerWriterC w m (ctx a)
forall (w :: * -> *) (m :: * -> *) a.
WriterC (w LogLine) m a -> LoggerWriterC w m a
LoggerWriterC (Handler ctx n (WriterC (w LogLine) m)
-> (:+:) (Writer (w LogLine)) sig n a
-> ctx ()
-> WriterC (w LogLine) m (ctx a)
forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (WriterC (w LogLine) m)
-> (:+:) (Writer (w LogLine)) sig n a
-> ctx ()
-> WriterC (w LogLine) m (ctx a)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) (ctx :: * -> *)
       (n :: * -> *) a.
(Algebra sig m, Functor ctx) =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
alg (LoggerWriterC w m (ctx x) -> WriterC (w LogLine) m (ctx x)
forall (w :: * -> *) (m :: * -> *) a.
LoggerWriterC w m a -> WriterC (w LogLine) m a
runLoggerWriterC (LoggerWriterC w m (ctx x) -> WriterC (w LogLine) m (ctx x))
-> (ctx (n x) -> LoggerWriterC w m (ctx x))
-> ctx (n x)
-> WriterC (w LogLine) m (ctx x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx (n x) -> LoggerWriterC w m (ctx x)
Handler ctx n (LoggerWriterC w m)
hdl) (sig n a -> (:+:) (Writer (w LogLine)) sig n a
forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) k.
g m k -> (:+:) f g m k
R sig n a
other) ctx ()
ctx)

runLoggerW
  :: Monoid (w LogLine)
  => LoggerWriterC w m a
  -> m (w LogLine, a)
runLoggerW :: forall (w :: * -> *) (m :: * -> *) a.
Monoid (w LogLine) =>
LoggerWriterC w m a -> m (w LogLine, a)
runLoggerW = WriterC (w LogLine) m a -> m (w LogLine, a)
forall w (m :: * -> *) a. Monoid w => WriterC w m a -> m (w, a)
runWriter (WriterC (w LogLine) m a -> m (w LogLine, a))
-> (LoggerWriterC w m a -> WriterC (w LogLine) m a)
-> LoggerWriterC w m a
-> m (w LogLine, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggerWriterC w m a -> WriterC (w LogLine) m a
forall (w :: * -> *) (m :: * -> *) a.
LoggerWriterC w m a -> WriterC (w LogLine) m a
runLoggerWriterC