Make ‘try’ truly backtrack parser state

Close #142.

This seemingly has no effect on performance.
This commit is contained in:
mrkkrp 2016-09-27 09:41:23 +03:00
parent dfbc6f0893
commit 6772b88e93
3 changed files with 15 additions and 9 deletions

View File

@ -23,6 +23,10 @@
`hpesc-megaparsec` package, which also improved the latter (that package
is the recommended way to test Megaparsec parsers).
* The `try` combinator now truly backtracks parser state when its argument
parser fails (either consuming input or not). Most users will never notice
the difference though. See #142.
* Further documentation improvements.
## Megaparsec 5.0.1

View File

@ -536,8 +536,8 @@ class (ErrorComponent e, Stream s, A.Alternative m, MonadPlus m)
hidden :: m a -> m a
hidden = label ""
-- | The parser @try p@ behaves like parser @p@, except that it
-- pretends that it hasn't consumed any input when an error occurs.
-- | The parser @try p@ behaves like parser @p@, except that it backtracks
-- parser state when @p@ fails (either consuming input or not).
--
-- This combinator is used whenever arbitrary look ahead is needed. Since
-- it pretends that it hasn't consumed any input when @p@ fails, the
@ -708,7 +708,8 @@ pLabel l p = ParsecT $ \s cok cerr eok eerr ->
pTry :: ParsecT e s m a -> ParsecT e s m a
pTry p = ParsecT $ \s cok _ eok eerr ->
unParser p s cok eerr eok eerr
let eerr' err _ = eerr err s
in unParser p s cok eerr' eok eerr'
{-# INLINE pTry #-}
pLookAhead :: ParsecT e s m a -> ParsecT e s m a

View File

@ -598,13 +598,12 @@ spec = do
grs' p s (`succeedsLeaving` "")
context "when inner parser fails consuming" $
it "backtracks, it appears as if the parser has not consumed anything" $
-- TODO also check that it backtracks state in general as well
property $ \a b c -> b /= c ==> do
let p :: MonadParsec Dec String m => m Char
p = try (char a *> char b)
s = [a,c]
grs p s (`shouldFailWith` err (posN (1 :: Int) s) (utok c <> etok b))
grs' p s (`failsLeaving` [c]) -- FIXME it should leave entire input
grs' p s (`failsLeaving` s)
context "when inner parser succeeds without consuming" $
it "try has no effect" $
property $ \a -> do
@ -612,10 +611,12 @@ spec = do
p = try (return a)
grs p "" (`shouldParse` a)
context "when inner parser fails without consuming" $
it "try has no effect" $ do
let p :: MonadParsec Dec String m => m Char
p = try empty
grs p "" (`shouldFailWith` err posI mempty)
it "try backtracks parser state anyway" $
property $ \w -> do
let p :: MonadParsec Dec String m => m Char
p = try (setTabWidth w *> empty)
grs p "" (`shouldFailWith` err posI mempty)
grs' p "" ((`shouldBe` defaultTabWidth) . stateTabWidth . fst)
describe "lookAhead" $ do
context "when inner parser succeeds consuming" $