From f5c80c2b4f6ccd8d4cb2c182b84174f22f73c290 Mon Sep 17 00:00:00 2001
From: Konstantin Kharlamov <Hi-Angel@yandex.ru>
Date: Sat, 1 Mar 2025 22:45:03 +0300
Subject: [PATCH] consumeWith: propagate `consumed` flag when it was set

The Parsing design implies that if input was consumed, it must
propagate further unless `try` is used to reset that.

Fixes: https://github.com/purescript-contrib/purescript-parsing/issues/236
---
 src/Parsing/String.purs |  4 ++--
 test/Test/Main.purs     | 13 ++++++++++++-
 2 files changed, 14 insertions(+), 3 deletions(-)

diff --git a/src/Parsing/String.purs b/src/Parsing/String.purs
index 29c7652..3ce0854 100644
--- a/src/Parsing/String.purs
+++ b/src/Parsing/String.purs
@@ -282,12 +282,12 @@ consumeWith
    . (String -> Either String { value :: a, consumed :: String, remainder :: String })
   -> ParserT String m a
 consumeWith f = ParserT
-  ( mkFn5 \state1@(ParseState input pos _) _ _ throw done ->
+  ( mkFn5 \state1@(ParseState input pos oldConsumed) _ _ throw done ->
       case f input of
         Left err ->
           runFn2 throw state1 (ParseError err pos)
         Right { value, consumed, remainder } ->
-          runFn2 done (ParseState remainder (updatePosString pos consumed remainder) (not (String.null consumed))) value
+          runFn2 done (ParseState remainder (updatePosString pos consumed remainder) (oldConsumed || not (String.null consumed))) value
   )
 
 -- | Combinator which finds the first position in the input `String` where the
diff --git a/test/Test/Main.purs b/test/Test/Main.purs
index e2c0e23..68fdb6f 100644
--- a/test/Test/Main.purs
+++ b/test/Test/Main.purs
@@ -36,7 +36,7 @@ import Effect.Console (log, logShow)
 import Effect.Unsafe (unsafePerformEffect)
 import Node.Process (lookupEnv)
 import Parsing (ParseError(..), ParseState(..), Parser, ParserT, Position(..), consume, fail, getParserT, initialPos, parseErrorPosition, position, region, runParser)
-import Parsing.Combinators (advance, between, chainl, chainl1, chainr, chainr1, choice, empty, endBy, endBy1, lookAhead, many, many1, many1Till, many1Till_, manyIndex, manyTill, manyTill_, notFollowedBy, optionMaybe, replicateA, sepBy, sepBy1, sepEndBy, sepEndBy1, skipMany, skipMany1, try, tryRethrow, (<?>), (<??>), (<~?>))
+import Parsing.Combinators (advance, between, chainl, chainl1, chainr, chainr1, choice, empty, endBy, endBy1, lookAhead, many, many1, many1Till, many1Till_, manyIndex, manyTill, manyTill_, notFollowedBy, optional, optionMaybe, replicateA, sepBy, sepBy1, sepEndBy, sepEndBy1, skipMany, skipMany1, try, tryRethrow, (<?>), (<??>), (<~?>))
 import Parsing.Combinators.Array as Combinators.Array
 import Parsing.Expr (Assoc(..), Operator(..), buildExprParser)
 import Parsing.Language (haskellDef, haskellStyle, javaStyle)
@@ -572,6 +572,15 @@ javaStyleTest = do
     "hello {- comment\n -} foo"
     (mkPos 7)
 
+takeWhilePropagateFail :: TestM
+takeWhilePropagateFail = do
+  -- `takeWhile` always succeeds, but if input was consumed prior and failure happens
+  -- later, then the failure with consumption should propagate past `optional` #236
+  parseErrorTestPosition
+    (optional (char 'f' <* takeWhile (const false) <* fail "failure"))
+    "f"
+    (Position { index: 1, line: 1, column: 2 })
+
 main :: Effect Unit
 main = do
 
@@ -734,6 +743,8 @@ main = do
     , expected: Left $ ParseError "Expected letter" (Position { index: 0, line: 1, column: 1 })
     }
 
+  takeWhilePropagateFail
+
   log "\nTESTS number\n"
 
   -- assert' "Number.fromString" $ Just infinity == Data.Number.fromString "Infinity"