Skip to content

Instantly share code, notes, and snippets.

@gatlin

gatlin/cont.hs

Last active May 22, 2020
Embed
What would you like to do?
Delimited continuation monad transformer
{- cabal:
build-depends: base
-}
module ContT
( ContT
, reset
, shift
, liftIO
)
where
import Data.Functor.Identity
-- * ContT continuation monad transformer.
newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }
-- It is 2020 and we are doing explicit type class instances.
instance Monad m => Functor (ContT r m) where
fmap f c = ContT $ \k -> runContT c (k . f)
instance Monad m => Applicative (ContT r m) where
pure x = ContT ($ x)
f <*> v = ContT $ \c -> runContT f $ \g -> runContT v (c . g)
m *> k = m >>= \_ -> k
instance Monad m => Monad (ContT r m) where
return x = ContT $ \k -> k x
m >>= k = _join (fmap k m) where
_join :: ContT r m (ContT r m a) -> ContT r m a
_join cc = ContT $ \c -> runContT cc (\x -> runContT x c)
-- Dynamically limits the extent of a continuation.
reset :: Monad m => ContT a m a -> m a
reset cc = runContT cc return
-- Captures the reified continuation up to the innermost enclosing reset.
shift :: Monad m => ((a -> m r) -> ContT r m r) -> ContT r m a
shift e = ContT $ \k -> reset (e k)
-- If you have to pick one monad to sit atop why not pick IO?
liftIO :: IO a -> ContT r IO a
liftIO x = ContT (x >>=)
-- * Examples!
-- | Interleaves IO and control flow side effects to produce a result.
sixteen :: ContT Int IO Int
sixteen = do
n <- shift $ \k -> liftIO $ do
x <- k 4
putStrLn ("(k 4) = " ++ show x)
y <- k x
putStrLn ("(k (k 4)) = " ++ show y)
return y
liftIO $ putStrLn "This is printed twice"
return (n * 2) -- this will be k's return value above
-- |
seventeen :: IO Int
seventeen = do
_16 <- reset sixteen
return (_16 + 1)
{-
reset :: Cont a a -> a
reset cc = runCont cc id
shift :: ((a -> r) -> Cont r r) -> Cont r a
shift e = Cont $ \k -> reset (e k)
-}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment