{-# LANGUAGE TupleSections #-}
module Mini.Transformers.WriterT (
WriterT (
WriterT
),
runWriterT,
tell,
) where
import Control.Applicative (
Alternative (
empty,
(<|>)
),
)
import Control.Monad (
ap,
liftM,
)
import Data.Functor (
(<&>),
)
import Mini.Transformers.Class (
MonadTrans (
lift
),
)
newtype WriterT w m a = WriterT
{ forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT :: m (a, w)
}
instance (Monad m, Monoid w) => Functor (WriterT w m) where
fmap :: forall a b. (a -> b) -> WriterT w m a -> WriterT w m b
fmap = (a -> b) -> WriterT w m a -> WriterT w m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance (Monad m, Monoid w) => Applicative (WriterT w m) where
pure :: forall a. a -> WriterT w m a
pure = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (a, w) -> WriterT w m a)
-> (a -> m (a, w)) -> a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m (a, w)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, w) -> m (a, w)) -> (a -> (a, w)) -> a -> m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,w
forall a. Monoid a => a
mempty)
<*> :: forall a b. WriterT w m (a -> b) -> WriterT w m a -> WriterT w m b
(<*>) = WriterT w m (a -> b) -> WriterT w m a -> WriterT w m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance (Monad m, Alternative m, Monoid w) => Alternative (WriterT w m) where
empty :: forall a. WriterT w m a
empty = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT m (a, w)
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
WriterT w m a
m <|> :: forall a. WriterT w m a -> WriterT w m a -> WriterT w m a
<|> WriterT w m a
n = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$ WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT w m a
m m (a, w) -> m (a, w) -> m (a, w)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT w m a
n
instance (Monad m, Monoid w) => Monad (WriterT w m) where
WriterT w m a
m >>= :: forall a b. WriterT w m a -> (a -> WriterT w m b) -> WriterT w m b
>>= a -> WriterT w m b
k = m (b, w) -> WriterT w m b
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (b, w) -> WriterT w m b) -> m (b, w) -> WriterT w m b
forall a b. (a -> b) -> a -> b
$ do
(a
a, w
w) <- WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT w m a
m
(b
b, w
w') <- WriterT w m b -> m (b, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (a -> WriterT w m b
k a
a)
(b, w) -> m (b, w)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b
b, w
w w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w')
instance (Monoid w) => MonadTrans (WriterT w) where
lift :: forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
lift m a
m = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$ m a
m m a -> (a -> (a, w)) -> m (a, w)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (,w
forall a. Monoid a => a
mempty)
tell :: (Monad m) => w -> WriterT w m ()
tell :: forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell = m ((), w) -> WriterT w m ()
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m ((), w) -> WriterT w m ())
-> (w -> m ((), w)) -> w -> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), w) -> m ((), w)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((), w) -> m ((), w)) -> (w -> ((), w)) -> w -> m ((), w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((),)