Free.hs

module Free where

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

instance (Functor f) => Functor (Free f) where
  fmap = undefined

instance (Functor f) => Applicative (Free f) where
  pure = Pure
  (<*>) = undefined

instance (Functor f) => Monad (Free f) where
  return = pure
  --(Free x) >>= f = Free (fmap (>>= f) x)
  (Free x) >>= f =
    let y = fmap z x
        z ffa = ffa >>= f
    in Free y
  (Pure r) >>= f = f r

{-
x :: f (Free f a)
f :: a -> Free f b
-}

data Toy b next =
    Output b next
  | Bell next
  | Done

instance Functor (Toy b) where
    fmap f (Output x next) = Output x (f next)
    fmap f (Bell     next) = Bell     (f next)
    fmap f  Done           = Done

output :: a -> Free (Toy a) ()
output x = Free (Output x (Pure ()))