Yield: Mainstream Delimited Continuations via Codensity

codensity-yield

module Yield where

-- Cleaned up version of Yield: Mainstream Delimited Continuations by Roshan James and Amr Sabry from TPDC 2011

import Data.Traversable
import Control.Monad.Trans
import Control.Monad.Free
import Control.Monad.Codensity
import Control.Comonad.Trans.Store

liftF :: Functor f => f a -> Free f a 
liftF = Free . fmap Pure

-- The indexed store comonad
data Susp i o r = Susp (i -> r) o

instance Functor (Susp i o) where
   fmap f (Susp k o) = Susp (f . k) o

class Functor y => Yieldable y i o | y -> i o where
   yield :: o -> y i 

instance Yieldable (Susp i o) i o where
   yield = Susp id

instance Yieldable (Store s) s s where
   yield = store id

instance Yieldable y i o => Yieldable (Free y) i o where
   yield = liftF . yield

instance (Monad y, Yieldable y i o) => Yieldable (CodensityT y) i o where
   yield = lift . yield

type Iterator i o = Free (Susp i o)
type Yield i o = CodensityT (Iterator i o)

run :: Yield i o r -> Iterator i o r
run r = lowerCodensityT r

walk :: Traversable f => f a -> Yield b a (f b)
walk = traverse yield

-- data Tree a = Tip a | Bin (Tree a) (Tree b) deriving (Functor, Foldable, Traversable)
-- walk :: Tree a -> Yield b a (Tree b)
-- walk (Bin l r) = Bin <$> walk l <*> walk r
-- walk (Tip a)   = Tip <$> yield a