diff --git a/CHANGELOG.md b/CHANGELOG.md index 3333030..352fc26 100644 --- a/CHANGELOG.md +++ b/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: diff --git a/src/Parsing/Combinators.purs b/src/Parsing/Combinators.purs index d625e6e..18673cd 100644 --- a/src/Parsing/Combinators.purs +++ b/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. diff --git a/src/Parsing/Combinators/Array.purs b/src/Parsing/Combinators/Array.purs index b03fe9e..3613d26 100644 --- a/src/Parsing/Combinators/Array.purs +++ b/src/Parsing/Combinators/Array.purs @@ -19,6 +19,7 @@ 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) @@ -26,7 +27,7 @@ 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) diff --git a/test/Main.purs b/test/Main.purs index a4cb822..d307ac4 100644 --- a/test/Main.purs +++ b/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" ] } +