Better errors for manyIndex

CHANGELOG.md

@@ -15,6 +15,8 @@ New features:
 
 Other improvements:
 
+- Better error messages for `manyIndex` (#211 by @jamesbrock)
+
 ## [v10.0.0](https://github.com/purescript-contrib/purescript-parsing/releases/tag/v9.1.0) - 2022-07-18
 
 Bugfixes:

src/Parsing/Combinators.purs

@@ -84,6 +84,7 @@ module Parsing.Combinators
 import Prelude
 
 import Control.Lazy (defer)
+import Control.Monad.Error.Class (catchError, throwError)
 import Control.Monad.Rec.Class (Step(..), tailRecM)
 import Control.Plus (empty, (<|>), alt)
 import Data.Foldable (class Foldable, foldl, foldr)
@@ -98,7 +99,7 @@ import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested (type (/\), (/\))
 import Data.Unfoldable (replicateA)
 import Data.Unfoldable1 (replicate1A)
-import Parsing (ParseError(..), ParseState(..), ParserT(..), Position(..), fail, position)
+import Parsing (ParseError(..), ParseState(..), ParserT(..), Position(..), fail, parseErrorMessage, parseErrorPosition, position)
 
 -- | Provide an error message in the case of failure.
 withErrorMessage :: forall m s a. ParserT s m a -> String -> ParserT s m a
@@ -461,15 +462,17 @@ manyIndex from to p =
   go (Tuple i xs) =
     if i >= to then
       pure (Done (Tuple i (reverse xs)))
-    else alt
+    else catchError
       do
         x <- p i
         pure (Loop (Tuple (i + 1) (x : xs)))
-      do
+      \e -> do
         if i >= from then
           pure (Done (Tuple i (reverse xs)))
         else
-          fail "Expected more phrases"
+          throwError $ ParseError
+            (parseErrorMessage e <> " (at least " <> show from <> ", but only parsed " <> show i <> ")")
+            (parseErrorPosition e)
 
 -- | If the parser succeeds without advancing the input stream position,
 -- | then force the parser to fail.

src/Parsing/Combinators/Array.purs

@@ -19,14 +19,15 @@ module Parsing.Combinators.Array
 import Prelude
 
 import Control.Alt (alt)
+import Control.Monad.Error.Class (catchError, throwError)
 import Control.Monad.Rec.Class (Step(..), tailRecM)
 import Data.Array as Array
 import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Array.NonEmpty as Array.NonEmpty
 import Data.List (List(..), (:))
 import Data.Maybe (Maybe(..))
 import Data.Tuple (Tuple(..))
-import Parsing (ParserT, fail)
+import Parsing (ParseError(..), ParserT, fail, parseErrorMessage, parseErrorPosition)
 import Parsing.Combinators (try)
 
 -- | Match the phrase `p` as many times as possible.
@@ -85,12 +86,14 @@ manyIndex from to p =
   go (Tuple i xs) =
     if i >= to then
       pure (Done (Tuple i xs))
-    else alt
+    else catchError
       do
         x <- p i
         pure (Loop (Tuple (i + 1) (x : xs)))
-      do
+      \e -> do
         if i >= from then
           pure (Done (Tuple i xs))
         else
-          fail "Expected more phrases"
+          throwError $ ParseError
+            (parseErrorMessage e <> " (at least " <> show from <> ", but only parsed " <> show i <> ")")
+            (parseErrorPosition e)

test/Main.purs

@@ -27,7 +27,7 @@ import Data.String.CodePoints as SCP
 import Data.String.CodeUnits (fromCharArray, singleton)
 import Data.String.CodeUnits as SCU
 import Data.String.Regex.Flags (RegexFlags, ignoreCase, noFlags)
-import Data.Tuple (Tuple(..), fst)
+import Data.Tuple (Tuple(..), fst, snd)
 import Data.Tuple.Nested (get2, (/\))
 import Effect (Effect)
 import Effect.Console (log, logShow)
@@ -1060,6 +1060,10 @@ main = do
     { actual: runParser "aaa" $ manyIndex (-2) (1) (\_ -> char 'a')
     , expected: Right (Tuple 0 (Nil))
     }
+  assertEqual' "manyIndex 6 errors"
+    { actual: lmap parseErrorPosition $ runParser "aab" $ map snd $ manyIndex 3 3 (\_ -> char 'a')
+    , expected: lmap parseErrorPosition $ runParser "aab" $ (replicateA 3 (char 'a') :: Parser String (List Char))
+    }
 
   log "\nTESTS advance\n"
 
@@ -1106,3 +1110,4 @@ main = do
           $ string "aaaa\r\n" *> (replicateA 5 letter :: Parser String (List Char))
       , expected: [ "Expected letter at position index:6 (line:2, column:1)", "▼", "🍷bbbb" ]
       }
+