gistfile1.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
module Main where

----
-- Coyoneda

data CoYoneda f x = forall b. CoYoneda (b -> x) (f b)

instance Functor (CoYoneda f) where
  fmap f (CoYoneda g v) = CoYoneda (f . g) v


liftCoYoneda :: f a -> CoYoneda f a
liftCoYoneda = CoYoneda id

----
-- Free

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

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

liftF :: Functor f => f r -> Free f r
liftF cmd = Free (fmap Pure cmd)

----
-- Operational

type Program f a = Free (CoYoneda f) a

singleton :: f a -> Program f a
singleton = liftF . liftCoYoneda

----

data StateP s a where
  GetP :: StateP s s
  PutP :: s -> StateP s ()

runStateP :: Program (StateP s) a -> s -> (a, s)
runStateP (Free (CoYoneda f GetP)) s = flip runStateP' s . f $ s
runStateP (Free (CoYoneda f (PutP x))) s = flip runStateP' x . f $ ()
runStateP (Pure x) s = (x, s)