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]
