From cf6c74147d1e744a560d7871294d5c8a8637008f Mon Sep 17 00:00:00 2001 From: James Brock Date: Wed, 19 Apr 2023 16:29:48 +0900 Subject: [PATCH 1/2] PureScript 15.7 --- packages.dhall | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/packages.dhall b/packages.dhall index 5f9db17..a0219a8 100644 --- a/packages.dhall +++ b/packages.dhall @@ -1,5 +1,5 @@ let upstream = - https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20221110/packages.dhall - sha256:55be93ee309eeb1b3a1d30c7b9fa5d18ffefa67f5fbeec1566b7b6a70b0ac218 + https://github.com/purescript/package-sets/releases/download/psc-0.15.7-20230408/packages.dhall + sha256:eafb4e5bcbc2de6172e9457f321764567b33bc7279bd6952468d0d422aa33948 in upstream From fda0dc81ea6bcd556f2debf5fa5ecffa1b62b444 Mon Sep 17 00:00:00 2001 From: James Brock Date: Wed, 19 Apr 2023 17:19:18 +0900 Subject: [PATCH 2/2] New combinator: withRecovery --- CHANGELOG.md | 2 ++ src/Parsing/Combinators.purs | 36 ++++++++++++++++++++++++++++++++++++ test/Main.purs | 22 +++++++++++++++++++++- 3 files changed, 59 insertions(+), 1 deletion(-) 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