effects.hs

{-# LANGUAGE GADTs, DataKinds, TypeOperators, FlexibleInstances, KindSignatures, RankNTypes, QuantifiedConstraints, FlexibleContexts #-}

data Free (fs :: [(* -> *) -> * -> *]) (a :: *) where
  Pure   :: a -> Free '[] a
  Effect :: f (Free fs) a -> Free (f ': fs) a
  
instance Functor (Free '[]) where
  fmap f (Pure x) = Pure (f x)
  
instance ((forall x. Functor x => Functor (f x))
         ,Functor (Free fs)) 
         => Functor (Free (f ': fs)) where
  fmap f (Effect xs) = Effect (fmap f xs)

instance Applicative (Free '[]) where
  pure = Pure
  Pure f <*> Pure x = Pure (f x)

instance ((forall x. Functor x => Functor (f x))
         ,(forall x. Applicative x => Applicative (f x))
         ,Applicative (Free fs)) 
         => Applicative (Free (f ': fs)) where
  pure x = Effect (pure x)
  Effect fs <*> Effect xs = Effect (fs <*> xs)