Yoneda lemma example

Code.hs

{-# LANGUAGE GADTs #-}

data Free f a = Done a | Free (f (Free f a))

instance Functor f => Monad (Free f) where
    return = Done

    Done a >>= f = f a
    Free s >>= f = Free $ fmap (f =<<) s


data Instr a where
    Get :: (Int -> a) -> Instr a
    Put :: Int -> a -> Instr a

instance Functor Instr where
    fmap f (Get k)   = Get (f . k)
    fmap f (Put i a) = Put i (f a)

foldFree :: Functor f => (a -> b) -> (f b -> b) -> Free f a -> b
foldFree kd _ (Done a)  = kd a
foldFree kd kf (Free s) = kf (fmap (foldFree kd kf) s)

get :: Free Instr Int
get = Free $ Get Done

put :: Int -> Free Instr ()
put i = Free $ Put i (Done ())

runInstr :: Free Instr a -> Int
runInstr instrs = foldFree done go instrs $ 0
  where
    done _ i = i

    go (Get k) i   = k i i
    go (Put i k) _ = k i

instrs :: Free Instr ()
instrs = do
  i <- get
  put (i + 1)

test :: Int
test = runInstr instrs -- 1