consumeWith: propagate consumed flag it was set

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

Fixes: #236

Author: Hi-Angel

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

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"