Created
May 2, 2015 07:17
-
-
Save ninegua/97833cb4f82451f6c3db to your computer and use it in GitHub Desktop.
BackT (in MFlow) is not a monad
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
import Control.Monad | |
import Control.Monad.Trans | |
-- The following is taken from the paper "MFlow, a contiuation-based web | |
-- framework without continuations" by Alberto Gomez Corona, April 23, 2014, | |
-- with minor modifications to make it runnable in GHCi. | |
data FailBack a = BackPoint a | NoBack a | GoBack | |
newtype BackT m a = BackT { runBackT :: m (FailBack a ) } | |
instance Monad m => Monad (BackT m) where | |
fail _ = BackT $ return GoBack | |
return x = BackT . return $ NoBack x | |
x >>= f = BackT $ loop | |
where | |
loop = do | |
v <- runBackT x | |
case v of | |
NoBack y -> runBackT (f y) | |
BackPoint y -> do | |
z <- runBackT (f y) | |
case z of | |
GoBack -> loop | |
other -> return other | |
GoBack -> return GoBack | |
instance MonadTrans BackT where | |
lift f = BackT $ f >>= \x -> return $ NoBack x | |
breturn = BackT . return . BackPoint | |
-- The main function does exactly what the paper suggests, entering | |
-- "back" will backtrack a single step. | |
main = runBackT $ do | |
lift (print "will return here at most") >> breturn () | |
n <- ask "give me the first number" | |
n' <- ask "give me the second number" | |
lift $ print $ n+n' | |
where | |
ask s = do | |
lift $ putStrLn s | |
s <- lift $ getLine | |
if s == "back" then fail "" else return $ read s | |
-- Unfortunately, BackT is not a monad. It violates the associative | |
-- law, as the program shown below, test1 enters an infinite loop, | |
-- and test2 exits after printing 3 lines. | |
test1 = runBackT (a >> (b >> c)) | |
test2 = runBackT ((a >> b) >> c) | |
a = lift (print "step 1") >> breturn () | |
b = lift (print "step 2") >> return () | |
c = lift (print "step 3") >> fail "" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment