MonadWriter.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}

module Step where

import qualified Data.Map.Strict as Map
import           Control.Monad.State.Strict (StateT(..))
import           Control.Applicative
import           Control.Monad

newtype Reader r a = Reader { runReader :: r -> a }

instance Functor (Reader r) where
  -- (a -> b) -> Reader r a -> Reader r b
  fmap f (Reader g) = Reader $ \r -> f $ g r

instance Applicative (Reader r) where
  pure a = Reader $ \_ -> a

  -- (Reader r (a -> b)) -> Reader r a  -> Reader r b
  -- (Reader $ \r -> a -> b) -> Reader r a  -> Reader r b
  (Reader f) <*> (Reader g) = Reader $ \r -> f r $ g r

instance Monad (Reader r) where
  -- Reader r a -> (a -> Reader r b) -> Reader r b
  -- (Reader $ \r -> a) -> (a -> Reader $ \r -> b) -> (Reader $ \r -> b)
  (Reader g) >>= f = Reader $ \r -> runReader (f (g r)) r

class (Monad m) => MonadReader r m | m -> r where
  ask :: m r
  local :: (r -> r) -> m a -> m a

instance MonadReader r (Reader r) where
  ask = Reader $ \r -> r

  local f (Reader g) = Reader $ \r -> g $ f r

newtype Writer w a = Writer { runWriter :: (a, w) }

instance Functor (Writer w) where
  fmap f (Writer (a, w)) = Writer (f a, w)

instance Monoid w => Applicative (Writer w) where
  pure a = Writer (a, mempty)

  -- (Writer w (a -> b)) -> (Writer w a) -> (Writer w b)
  -- (Writer ((a -> b), w)) -> (Writer (a, w)) -> (Writer (b, w))
  (Writer (f, wf)) <*> (Writer (a, w)) = Writer (f a, w `mappend` wf)

instance Monoid w => Monad (Writer w) where
  (Writer (a, w)) >>= f = let (Writer (b, w')) = f a
                          in Writer (b, w `mappend` w')

class (Monoid w, Monad m) => MonadWriter w m | m -> w where
  writer :: (a, w) -> m a
  writer (a, w) = do
    tell w
    return a

  tell :: w -> m ()
  tell w = writer ((), w)

  listen :: m a -> m (a, w)
  pass :: m (a, w -> w) -> m a
  {-# MINIMAL (writer | tell), listen, pass #-}

instance (Monoid w) => MonadWriter w (Writer w) where
  tell w = Writer ((), w)

  listen (Writer (a, w)) = Writer ((a, w), w)

  pass (Writer ((a, f), w)) = Writer (a, f w)

https://page.mi.fu-berlin.de/scravy/realworldhaskell/materialien/monad-transformers-step-by-step.pdf