[Haskell-cafe] Fail-back monad

[oleg at okmij.org]

> I thoutgh on the use or ErrorT or something similar but the fact is
> that i need many bacPoints, not just one. That is, The user can go
> many pages back in the navigation pressing many times te back
> buttton.

The approach in the previous message extends to an arbitrary,
statically unknown number of checkpoints. If we run the following
simple code

> test1 = loop "" 1
>  where
>  loop acc n = inquire ("Enter string " ++ show n) >>= check acc n
>  check acc n ""  = liftIO . putStrLn $ "You have entered: " ++ acc
>  check acc n str = loop (acc ++ str) (n+1)
>
> test1r = runContT test1 return

we can do the following:

    *BackT> test1r
    Enter string 1
    s1
    Enter string 2
    s2
    Enter string 3
    s3
    Enter string 4
    s4
    Enter string 5
    back
    Enter string 4
    back
    Enter string 3
    back
    Enter string 2
    x1
    Enter string 3
    x2
    Enter string 4
    x3
    Enter string 5
    back
    Enter string 4
    y3
    Enter string 5

    You have entered: s1x1x2y3

I decided to go back after the fourth string, but you should feel free
to go forth.

The ContT approach is very flexible: we can not only go back, or go
back more. We can go all the way back. We can go back to the point
where certain condition was true, like when the value of the certain
named field was entered or certain value was computed.

Here is the complete code. For a change, it uses IO exceptions rather
than ErrorT.

> {-# LANGUAGE DeriveDataTypeable #-}
>
> module BackT where  
>
> import Control.Monad.Trans
> import Control.Monad.Cont
> import Control.Exception
> import Data.Typeable
> import Prelude hiding (catch)
>
> data RestartMe = RestartMe deriving (Show, Typeable)
> instance Exception RestartMe
>
> -- Make a `restartable' exception 
> -- (restartable from the beginning, that is)
> -- We redo the computation once we catch the exception RestartMe
> -- Other exceptions propagate up as usual.
>
> type BackT r m a = ContT r m a
> abort e = ContT(\k -> e)
>
> -- Send a prompt, receive a reply. If it is "back", go to the
> -- previous checkpoint.
> type Prompt = String
> inquire :: Prompt -> BackT r IO String
> inquire prompt = ContT loop
>  where
>  loop k = exchange >>= checkpoint k
>  exchange = do
>             putStrLn prompt
>             r <- getLine
>             if r == "back" then throw RestartMe
>                else return r
>  checkpoint k r = k r `catch` (\RestartMe -> loop k)
>
> -- Go to the previous checkpoint
> goBack :: BackT r m a
> goBack = abort (throw RestartMe)
>
>
> test1 = loop "" 1
>  where
>  loop acc n = inquire ("Enter string " ++ show n) >>= check acc n
>  check acc n "" = liftIO . putStrLn $ "You have entered: " ++ acc
>  check acc n str = loop (acc ++ str) (n+1)
>
> test1r = runContT test1 return