{-# LANGUAGE DeriveFunctor, ExistentialQuantification, StandaloneDeriving #-}
module Control.Effect.Writer.Internal
( Writer(..)
) where

import Control.Effect.Class

-- | @since 0.1.0.0
data Writer w m k
  = Tell w (m k)
  | forall a . Listen (m a) (w -> a -> m k)
  | forall a . Censor (w -> w) (m a) (a -> m k)

deriving instance Functor m => Functor (Writer w m)

instance HFunctor (Writer w) where
  hmap :: (forall x. m x -> n x) -> Writer w m a -> Writer w n a
hmap f :: forall x. m x -> n x
f (Tell w :: w
w     k :: m a
k) = w -> n a -> Writer w n a
forall w (m :: * -> *) k. w -> m k -> Writer w m k
Tell w
w         (m a -> n a
forall x. m x -> n x
f       m a
k)
  hmap f :: forall x. m x -> n x
f (Listen   m :: m a
m k :: w -> a -> m a
k) = n a -> (w -> a -> n a) -> Writer w n a
forall w (m :: * -> *) k a. m a -> (w -> a -> m k) -> Writer w m k
Listen   (m a -> n a
forall x. m x -> n x
f m a
m) ((m a -> n a
forall x. m x -> n x
f (m a -> n a) -> (a -> m a) -> a -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> m a) -> a -> n a) -> (w -> a -> m a) -> w -> a -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> a -> m a
k)
  hmap f :: forall x. m x -> n x
f (Censor g :: w -> w
g m :: m a
m k :: a -> m a
k) = (w -> w) -> n a -> (a -> n a) -> Writer w n a
forall w (m :: * -> *) k a.
(w -> w) -> m a -> (a -> m k) -> Writer w m k
Censor w -> w
g (m a -> n a
forall x. m x -> n x
f m a
m) (m a -> n a
forall x. m x -> n x
f     (m a -> n a) -> (a -> m a) -> a -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
k)
  {-# INLINE hmap #-}

instance Effect (Writer w) where
  thread :: ctx ()
-> (forall x. ctx (m x) -> n (ctx x))
-> Writer w m a
-> Writer w n (ctx a)
thread ctx :: ctx ()
ctx handler :: forall x. ctx (m x) -> n (ctx x)
handler (Tell w :: w
w     k :: m a
k) = w -> n (ctx a) -> Writer w n (ctx a)
forall w (m :: * -> *) k. w -> m k -> Writer w m k
Tell w
w                        (ctx (m a) -> n (ctx a)
forall x. ctx (m x) -> n (ctx x)
handler (m a
k m a -> ctx () -> ctx (m a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx))
  thread ctx :: ctx ()
ctx handler :: forall x. ctx (m x) -> n (ctx x)
handler (Listen   m :: m a
m k :: w -> a -> m a
k) = n (ctx a) -> (w -> ctx a -> n (ctx a)) -> Writer w n (ctx a)
forall w (m :: * -> *) k a. m a -> (w -> a -> m k) -> Writer w m k
Listen   (ctx (m a) -> n (ctx a)
forall x. ctx (m x) -> n (ctx x)
handler (m a
m m a -> ctx () -> ctx (m a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)) ((ctx (m a) -> n (ctx a))
-> (ctx a -> ctx (m a)) -> ctx a -> n (ctx a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ctx (m a) -> n (ctx a)
forall x. ctx (m x) -> n (ctx x)
handler ((ctx a -> ctx (m a)) -> ctx a -> n (ctx a))
-> (w -> ctx a -> ctx (m a)) -> w -> ctx a -> n (ctx a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m a) -> ctx a -> ctx (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> m a) -> ctx a -> ctx (m a))
-> (w -> a -> m a) -> w -> ctx a -> ctx (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> a -> m a
k)
  thread ctx :: ctx ()
ctx handler :: forall x. ctx (m x) -> n (ctx x)
handler (Censor f :: w -> w
f m :: m a
m k :: a -> m a
k) = (w -> w) -> n (ctx a) -> (ctx a -> n (ctx a)) -> Writer w n (ctx a)
forall w (m :: * -> *) k a.
(w -> w) -> m a -> (a -> m k) -> Writer w m k
Censor w -> w
f (ctx (m a) -> n (ctx a)
forall x. ctx (m x) -> n (ctx x)
handler (m a
m m a -> ctx () -> ctx (m a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)) (ctx (m a) -> n (ctx a)
forall x. ctx (m x) -> n (ctx x)
handler (ctx (m a) -> n (ctx a))
-> (ctx a -> ctx (m a)) -> ctx a -> n (ctx a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m a) -> ctx a -> ctx (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> m a
k)
  {-# INLINE thread #-}