Last active
May 22, 2020 17:42
-
-
Save gatlin/d688faef5eba61e2dab5c1b18cabd09e to your computer and use it in GitHub Desktop.
Delimited continuation monad transformer
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{- 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