consumeWith doesn't consume if position does not advance

This will effect parsers:

* rest
* string
* takeN
* regex
* whiteSpace
* skipSpaces

Author: jamesdbrock

CHANGELOG.md

@@ -4,6 +4,20 @@ Notable changes to this project are documented in this file. The format is based
 
 ## [Unreleased]
 
+Bugfixes:
+
+- consumeWith doesn't consume if position does not advance
+
+  This will effect parsers:
+
+  * rest
+  * string
+  * takeN
+  * regex
+  * whiteSpace
+  * skipSpaces
+
+
 ## [v9.1.0](https://github.com/purescript-contrib/purescript-parsing/releases/tag/v9.1.0) - 2022-06-12
 
 Breaking changes:

src/Parsing/String.purs

@@ -296,7 +296,7 @@ consumeWith f = ParserT
         Left err ->
           runFn2 throw state1 (ParseError err pos)
         Right { value, consumed, remainder } ->
-          runFn2 done (ParseState remainder (updatePosString pos consumed remainder) true) value
+          runFn2 done (ParseState remainder (updatePosString pos consumed remainder) (not (String.null consumed))) value
   )
 
 -- | Combinator which finds the first position in the input `String` where the

src/Parsing/String/Basic.purs

@@ -148,11 +148,17 @@ satisfyCP :: forall m. (CodePoint -> Boolean) -> ParserT String m Char
 satisfyCP p = satisfy (p <<< codePointFromChar)
 
 -- | Match zero or more whitespace characters satisfying
--- | `Data.CodePoint.Unicode.isSpace`. Always succeeds.
+-- | `Data.CodePoint.Unicode.isSpace`.
+-- |
+-- | Always succeeds. Will consume only when matched whitespace string
+-- | is non-empty.
 whiteSpace :: forall m. ParserT String m String
 whiteSpace = fst <$> match skipSpaces
 
--- | Skip whitespace characters and throw them away. Always succeeds.
+-- | Skip whitespace characters satisfying `Data.CodePoint.Unicode.isSpace`
+-- | and throw them away.
+-- |
+-- | Always succeeds. Will only consume when some characters are skipped.
 skipSpaces :: forall m. ParserT String m Unit
 skipSpaces = consumeWith \input -> do
   let consumed = takeWhile isSpace input

test/Main.purs

@@ -33,13 +33,13 @@ import Effect (Effect)
 import Effect.Console (log, logShow)
 import Effect.Unsafe (unsafePerformEffect)
 import Node.Process (lookupEnv)
-import Parsing (ParseError(..), Parser, ParserT, Position(..), consume, fail, initialPos, parseErrorMessage, parseErrorPosition, position, region, runParser)
+import Parsing (ParseError(..), ParseState(..), Parser, ParserT, Position(..), consume, fail, getParserT, initialPos, parseErrorMessage, 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, sepBy, sepBy1, sepEndBy, sepEndBy1, skipMany, skipMany1, try, (<?>), (<??>), (<~?>))
 import Parsing.Combinators.Array as Combinators.Array
 import Parsing.Expr (Assoc(..), Operator(..), buildExprParser)
 import Parsing.Language (haskellDef, haskellStyle, javaStyle)
 import Parsing.String (anyChar, anyCodePoint, anyTill, char, eof, match, regex, rest, satisfy, string, takeN)
-import Parsing.String.Basic (intDecimal, letter, noneOfCodePoints, number, oneOfCodePoints, whiteSpace)
+import Parsing.String.Basic (intDecimal, letter, noneOfCodePoints, number, oneOfCodePoints, skipSpaces, whiteSpace)
 import Parsing.String.Replace (breakCap, replace, replaceT, splitCap, splitCapT)
 import Parsing.Token (TokenParser, makeTokenParser, token, when)
 import Parsing.Token as Token
@@ -685,6 +685,22 @@ main = do
   parseErrorTestPosition (string "a\nb\nc\n" *> eof) "a\nb\nc\nd\n" (Position { index: 6, column: 1, line: 4 })
   parseErrorTestPosition (string "\ta" *> eof) "\tab" (Position { index: 2, column: 10, line: 1 })
 
+  assertEqual' "skipSpaces consumes if position advancement issue #200"
+    { actual: runParser " " do
+        skipSpaces
+        ParseState _ _ c <- getParserT
+        pure c
+    , expected: Right true
+    }
+
+  assertEqual' "skipSpaces doesn't consume if no position advancement issue #200"
+    { actual: runParser "x" do
+        skipSpaces
+        ParseState _ _ c <- getParserT
+        pure c
+    , expected: Right false
+    }
+
   log "\nTESTS number\n"
 
   -- assert' "Number.fromString" $ Just infinity == Data.Number.fromString "Infinity"