diff --git a/CHANGELOG.md b/CHANGELOG.md index 99db87c..7508fb7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,8 @@ Breaking changes: New features: +- New combinator `withRecovery` (#224 by @jamesdbrock) + Other improvements: ## [v10.2.0](https://github.com/purescript-contrib/purescript-parsing/releases/tag/v10.2.0) - 2022-11-30 diff --git a/src/Parsing/Combinators.purs b/src/Parsing/Combinators.purs index 6592f11..becf2d8 100644 --- a/src/Parsing/Combinators.purs +++ b/src/Parsing/Combinators.purs @@ -43,6 +43,7 @@ module Parsing.Combinators ( try , tryRethrow , lookAhead + , withRecovery , choice , between , notFollowedBy @@ -205,6 +206,29 @@ lookAhead (ParserT k1) = ParserT (mkFn2 \_ res -> runFn2 done state1 res) ) +-- | If the main parser fails, the recovery function will be called to get +-- | a recovery parser. Then the input stream will be backtracked to where the +-- | main parser began, and the recovery parser will run. +-- | +-- | To save the error for later examination, use a parser return type that +-- | includes a possible `ParseError`. There is an example of this in the +-- | test suite. +withRecovery + :: forall s m a. (ParseError -> ParserT s m a) + -> ParserT s m a + -> ParserT s m a +withRecovery recover (ParserT k1) = ParserT + ( mkFn5 \state1 more lift throw done -> + runFn5 k1 state1 more lift + (mkFn2 \_ err -> + let + (ParserT k2) = recover err + in + runFn5 k2 state1 more lift throw done + ) + done + ) + -- | Match the phrase `p` as many times as possible. -- | -- | If `p` never consumes input when it diff --git a/test/Main.purs b/test/Main.purs index bdcb188..edea805 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -13,6 +13,7 @@ import Control.Monad.State (State, lift, modify, runState) import Data.Array (some, toUnfoldable) import Data.Array as Array import Data.Bifunctor (lmap, rmap) +import Data.CodePoint.Unicode (isSpace) import Data.CodePoint.Unicode as CodePoint.Unicode import Data.Either (Either(..), either, fromLeft, hush) import Data.Foldable (oneOf) @@ -36,7 +37,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, 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, 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, optionMaybe, replicateA, sepBy, sepBy1, sepEndBy, sepEndBy1, skipMany, skipMany1, try, tryRethrow, withRecovery, (), (), (<~?>)) import Parsing.Combinators.Array as Combinators.Array import Parsing.Expr (Assoc(..), Operator(..), buildExprParser) import Parsing.Language (haskellDef, haskellStyle, javaStyle) @@ -688,6 +689,24 @@ 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' "withRecovery1" + { actual: runParser " not-an-int here" do + _ <- takeWhile isSpace + withRecovery + (\err -> do + nonint <- takeWhile (not <<< isSpace) + pure $ Left + { error: err + , input: nonint + } + ) + (Right <$> intDecimal) + , expected: Right $ Left + { error: ParseError "Expected Int" (Position {index:2,column:3,line:1}) + , input: "not-an-int" + } :: Either ParseError (Either {error::ParseError, input::String} Int) + } + assertEqual' "skipSpaces consumes if position advancement issue #200" { actual: runParser " " do skipSpaces