[Haskell] 継続モナドのテスト

cont2.hs

import Control.Applicative
import Control.Monad.Cont
import Control.Monad.ST
import Control.Monad.Identity
import Data.STRef

-- callCC :: ((a -> m b) -> m a) -> m a

test1 :: Cont r Int
test1 = return 1

test2 :: Cont r Int
test2 = cont $ \k -> k 1

test3 :: Cont r Int
test3 = callCC $ \_ -> return 1

test4 :: Cont r Int
test4 = callCC $ \exit -> exit 1

test5 = do
    a <- newSTRef 0
    (`runContT` id) $ callCC $ \exit -> do
        lift $ writeSTRef a 2
        return $ writeSTRef a 1
    readSTRef a

test6 f k = reset (shift f >>= k)
test7 f k = reset (f (evalCont . k))
test8 f k = reset $ (cont $ \k -> evalCont (f k)) >>= k

evalCont :: Cont r r -> r
evalCont m = runCont m id

reset :: Cont r r -> Cont r' r
reset = return . evalCont

shift :: ((a -> r) -> Cont r r) -> Cont r a
shift f = cont $ \k -> evalCont (f k)

-- https://github.com/krdlab/examples/blob/master/delimited-continuation/README.md
-- example1 = reset $ \p -> (3 +) <$> shift p (\_ -> return 1)
-- example2 = reset $ \p -> (3 +) <$> shift p (\k -> k $ return 1)

example1 = reset $ (3 +) <$> shift (\_ -> return 1)
example2 = reset $ (3 +) <$> shift (\k -> return $ k 1)
example1' = reset $ shift (\_ -> return 1) >>= return.(3 +)
example2' = reset $ shift (\k -> return $ k 1) >>= return.(3 +)
example1'' = reset $ do
    a <- shift $ \_ -> return 1
    return $ 3 + a
example2'' = reset $ do
    a <- shift $ \k -> return $ k 1
    return $ 3 + a

main = do
    runCont test1 print
    runCont test2 print
    runCont test3 print
    runCont test4 print
    print $ runST test5
    runCont (test6 (\k -> return $ k () + 1) (\_ -> return 2)) print
    runCont (test7 (\k -> return $ k () + 1) (\_ -> return 2)) print
    runCont (test8 (\k -> return $ k () + 1) (\_ -> return 2)) print
    runCont (test6 (\_ -> return 2) (\k -> return $ k () + 1)) print
    runCont (test7 (\_ -> return 2) (\k -> return $ k () + 1)) print
    runCont (test8 (\_ -> return 2) (\k -> return $ k () + 1)) print
    runCont example1 print
    runCont example2 print
    runCont example1' print
    runCont example2' print
    runCont example1'' print
    runCont example2'' print