{-# LANGUAGE RankNTypes, DeriveFunctor #-}
module Util.Free (
F(..),
liftF
) where
import Control.Applicative (Applicative, (<*>), pure)
newtype F f a = F { runF :: forall r. (a -> r) -> (f r -> r) -> r }
instance Functor f => Functor (F f) where
fmap f (F g) = F (\kp -> g (kp . f))
instance Functor f => Applicative (F f) where
pure a = F (\kp _ -> kp a)
F f <*> F g = F (\kp kf -> f (\a -> g (kp . a) kf) kf)
instance Functor f => Monad (F f) where
return a = F (\kp _ -> kp a)
F m >>= f = F (\kp kf -> m (\a -> runF (f a) kp kf) kf)
wrap :: Functor f => f (F f a) -> F f a
wrap f = F (\kp kf -> kf (fmap (\ (F m) -> m kp kf) f))
liftF :: Functor f => f a -> F f a
liftF = wrap . fmap return