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..6d04f56 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,41 @@ lookAhead (ParserT k1) = ParserT (mkFn2 \_ res -> runFn2 done state1 res) ) +-- | If the main parser fails, the recovery function will be called +-- | on the `ParseError` to get +-- | a recovery parser. Then the input stream will be backtracked to where the +-- | main parser began, and the recovery parser will run. +-- | +-- | The recovery parser should typically consume input until it is safe to +-- | resume normal parsing and then return some data describing the parse +-- | failure and recovery. +-- | +-- | If the recovery parser fails, the original `ParseError` from the main parser +-- | will be returned. There is no way to see the error from the recovery parser. +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 \state2 err -> + let + (ParserT k2) = recover err + in + runFn5 k2 state1 more lift + --throw + -- https://hackage.haskell.org/package/megaparsec-9.3.0/docs/Text-Megaparsec.html#v:withRecovery + -- “if recovery fails, the original error message is reported as + -- if without withRecovery. In no way can the recovering parser r + -- influence error messages.” + (mkFn2 \_ _ -> runFn2 throw state2 err) + 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..212a8a4 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,25 @@ 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