Skip to content

Instantly share code, notes, and snippets.

@tokiwoousaka
Created December 20, 2014 10:29
Show Gist options
  • Save tokiwoousaka/744595f076137b1402e3 to your computer and use it in GitHub Desktop.
Save tokiwoousaka/744595f076137b1402e3 to your computer and use it in GitHub Desktop.
{-# 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment