mrkkrp/megaparsec
1
1
Fork 0
mirror of https://github.com/mrkkrp/megaparsec.git synced 2024-11-23 10:23:39 +03:00
Code Issues Projects Releases Wiki Activity

Do not alter labels artificially (#319)

Browse Source 
In particular, don't prepend the phrase “the rest of ”.
This commit is contained in:
Mark Karpov 2018-09-02 23:29:38 +07:00 committed by GitHub
parent 243f34359b
commit 4e79ac91b2
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Text/Megaparsec/Internal.hs
View File

@ -344,8 +344,10 @@ pFancyFailure xs = ParsecT $ \s@(State _ o _) _ _ _ eerr ->
pLabel :: String -> ParsecT e s m a -> ParsecT e s m a
pLabel l p = ParsecT $ \s cok cerr eok eerr ->
let el = Label <$> NE.nonEmpty l
cl = Label . (NE.fromList "the rest of " <>) <$> NE.nonEmpty l
cok' x s' hs = cok x s' (refreshLastHint hs cl)
cok' x s' hs =
case el of
Nothing -> cok x s' (refreshLastHint hs Nothing)
Just _ -> cok x s' hs
eok' x s' hs = eok x s' (refreshLastHint hs el)
eerr' err = eerr $
case err of

4
tests/Text/MegaparsecSpec.hs
View File

@ -441,12 +441,12 @@ spec = do
grs p s (`shouldFailWith` err 1 mempty)
grs' p s (`failsLeaving` "")
context "inner parser produces hints" $
it "replaces the last hint with “the rest of <label>”" $
it "does not alter the hints" $
property $ \lbl a -> not (null lbl) ==> do
let p :: MonadParsec Void String m => m String
p = label lbl (many (char a)) <* empty
s = [a]
grs p s (`shouldFailWith` err 1 (elabel $ "the rest of " ++ lbl))
grs p s (`shouldFailWith` err 1 (etok a))
grs' p s (`failsLeaving` "")
context "when inner parser consumes and fails" $
it "reports parse error without modification" $