Free.hs

module Free where

import Control.Applicative (Applicative(..))

data Free f a = Pure a | Free (f (Free f a))

instance Functor f => Functor (Free f) where
    fmap f (Pure a) = Pure (f a)
    fmap f (Free fa) = Free (fmap (fmap f) fa)

instance Functor f => Applicative (Free f) where
    pure = Pure
    Pure f <*> Pure a = Pure (f a)
    Pure f <*> Free ma = Free (fmap (fmap f) ma)
    --Free mf <*> Pure a = Free (fmap (fmap (\f -> f a)) mf)
    Free mf <*> a = Free (fmap (<*> a) mf)

instance Functor f => Monad (Free f) where
    return = Pure
    Pure a >>= f = f a
    Free m >>= f = Free (fmap (>>= f) m)