[Haskell-cafe] Monad with limited backtracking

[Darryn Reid]

Kind Sirs/Madams,

Thanks in advance for your patience; the solution will no doubt be obvious to 
those with greater experience than me. I have formulated a monad to provide 
limited backtracking for implementing a rewrite system. The success case works 
fine, but my intention is that on failure the result should contain the list of 
input symbols consumed up to the failure, and it is this part that I would 
like some advice about. Code follows:
-------------------------------------------------------------------------------
import Control.Monad
import Debug.Trace

newtype Rewrite a b = Rewrite { run :: Input a -> Result a b }

data Input a = Input [a]

data Result a b = Fail [a] | Ok b [a]
                  deriving (Eq, Show)

instance (Show a) => Monad (Rewrite a) where
   return y = Rewrite $ \(Input xs) -> Ok y xs
   p >>= f  = Rewrite $ \inp ->
                 case run p inp of
                   Fail xs -> trace ("1.xs=" ++ show xs) $
                              Fail xs
                   Ok y xs -> case run (f y) (Input xs) of
                                Fail xs' -> trace ("2.xs=" ++ show xs) $
                                            Fail xs
                                okay -> okay

instance (Show a) => MonadPlus (Rewrite a) where
   mzero = Rewrite $ \inp -> Fail []
   p `mplus` q = Rewrite $ \inp -> case run p inp of
                                     Fail _ -> run q inp
                                     okay   -> okay
(>>=?) ::(Show a) => Rewrite a b -> (b -> Bool) -> Rewrite a b
p >>=? f = p >>= \y -> guard (f y) >> return y

next :: Rewrite a a
next = Rewrite $ \(Input xs) -> case xs of
                                  []      -> Fail []
                                  (x:xs') -> Ok x xs'

exactly :: (Show a, Eq a) => [a] -> Rewrite a [a]
exactly = mapM $ \i -> next >>=? (==i)
-------------------------------------------------------------------------------
For example, using ghci:
    *Main> run (exactly [1,2]) (Input [1,2,3,4])
    Ok [1,2] [3,4]
which is what I intend. However, while the thing correctly reports failure, I 
cannot get it to return the list of symbols up to the point of failure:
    *Main> run (exactly [1,2,3]) (Input [1,2,7,4])
    1.xs=[]
    2.xs=[4]
    1.xs=[4]
    1.xs=[4]
    2.xs=[7,4]
    1.xs=[7,4]
    2.xs=[2,7,4]
    Fail [2,7,4]      *I would like Fail [1,2] here instead*
 
I thank you in advance for any guidance you might offer.

Dr Darryn J Reid.