Writer Monad

module Main where

import Data.Monoid
import Control.Monad ((>=>))

data Writer w a = Writer a w

runWriter :: Writer w a -> (a, w)
runWriter (Writer a w) = (a, w)

tell :: w -> Writer w ()
tell s = Writer () s

instance (Monoid w) => Functor (Writer w) where
  -- fmap :: (a -> b) -> Writer w a -> Writer w b
  fmap f (Writer a w) = Writer (f a) w

instance (Monoid w) => Applicative (Writer w) where
  -- pure :: a -> Writer w a
  pure x = Writer x mempty

  -- (<*>) :: Writer w (a -> b) -> Writer w a -> Writer w b
  (Writer f m1) <*> (Writer a m2) = Writer (f a) (m1 <> m2)

instance (Monoid w) => Monad (Writer w) where
  -- (Writer w a) -> (a -> Writer w b) -> (Writer w b)
  (Writer a w) >>= k = let (b, w') = runWriter (k a)
                       in  Writer b (w <> w')


-- Exemplo
isEvenW x = (even x, " even ")
notW b = (not b, " not ")
isOddW x = let (b1, w1) = isEvenW x
               (b2, w2) = notW b1
           in (b2, w1 <> w2)


isEvenW' :: Integer -> Writer String Bool
isEvenW' x = do tell " even "
                return (even x)

notW' :: Bool -> Writer String Bool
notW' b = do tell " not " 
             return (not b)

{-
isOddW' x = do b1 <- isEvenW' x
               b2 <- notW' b1
               return b2
-}

isOddW' :: Integer -> Writer String Bool
isOddW' = (isEvenW' >=> notW')

-- outro exemplo
fiboW :: Int -> Writer (Sum Int) Int
fiboW 0 = do tell (Sum 1)
             return 0
fiboW 1 = do tell (Sum 1)
             return 1
fiboW n = do tell (Sum 1)
             f1 <- fiboW (n-1)
             f2 <- fiboW (n-2)
             return (f1+f2)
             
main = do
  print $ runWriter $ isOddW' 3
  mapM_ (print . runWriter . fiboW) [1..10]