free.hs

data Free f a = Unit a | Bind (f (Free f a))

instance Functor f => Functor (Free f) where
  fmap f (Unit a) = Unit (f a)
  fmap f (Bind x) = Bind (fmap (fmap f) x)

instance Functor f => Applicative (Free f) where
  pure = Unit
  Unit f <*> Unit a = Unit (f a)
  Unit f <*> Bind x = Bind (fmap (fmap f) x)
  Bind x <*> y = Bind (fmap (\f -> f <*> y) x)

instance Functor f => Monad (Free f) where
  return = pure
  Unit a >>= f = f a
  Bind x >>= f = Bind (fmap (\a -> a >>= f) x)