From 2d5cafbcf6fede326083c019608b69e3e5b0e0a8 Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Wed, 26 Jul 2017 09:28:00 -0700 Subject: [PATCH 1/2] Add tryRethrow --- src/Text/Parsing/Parser.purs | 16 ++++++++++++---- src/Text/Parsing/Parser/Combinators.purs | 10 +++++++++- src/Text/Parsing/Parser/String.purs | 4 ++-- src/Text/Parsing/Parser/Token.purs | 4 ++-- test/Main.purs | 5 +++++ 5 files changed, 30 insertions(+), 9 deletions(-) diff --git a/src/Text/Parsing/Parser.purs b/src/Text/Parsing/Parser.purs index b4f9259..9a566e8 100644 --- a/src/Text/Parsing/Parser.purs +++ b/src/Text/Parsing/Parser.purs @@ -1,5 +1,5 @@ module Text.Parsing.Parser - ( ParseError + ( ParseError(..) , parseErrorMessage , parseErrorPosition , ParseState(..) @@ -10,7 +10,9 @@ module Text.Parsing.Parser , hoistParserT , mapParserT , consume + , position , fail + , failWithPosition ) where import Prelude @@ -123,8 +125,14 @@ consume :: forall s m. Monad m => ParserT s m Unit consume = modify \(ParseState input position _) -> ParseState input position true +-- | Returns the current position in the stream. +position :: forall s m. Monad m => ParserT s m Position +position = gets \(ParseState _ pos _) -> pos + -- | Fail with a message. fail :: forall m s a. Monad m => String -> ParserT s m a -fail message = do - position <- gets \(ParseState _ pos _) -> pos - throwError (ParseError message position) +fail message = throwError <<< ParseError message =<< position + +-- | Fail with a message and a position. +failWithPosition :: forall m s a. Monad m => String -> Position -> ParserT s m a +failWithPosition message position = throwError (ParseError message position) diff --git a/src/Text/Parsing/Parser/Combinators.purs b/src/Text/Parsing/Parser/Combinators.purs index 115be15..d346258 100644 --- a/src/Text/Parsing/Parser/Combinators.purs +++ b/src/Text/Parsing/Parser/Combinators.purs @@ -30,7 +30,7 @@ import Data.List (List(..), (:), many, some, singleton) import Data.Maybe (Maybe(..)) import Data.Newtype (unwrap) import Data.Tuple (Tuple(..)) -import Text.Parsing.Parser (ParseState(..), ParserT(..), fail) +import Text.Parsing.Parser (ParseState(..), ParserT(..), ParseError(..), fail) -- | Provide an error message in the case of failure. withErrorMessage :: forall m s a. Monad m => ParserT s m a -> String -> ParserT s m a @@ -74,6 +74,14 @@ try p = (ParserT <<< ExceptT <<< StateT) \(s@(ParseState _ _ consumed)) -> do Left _ -> pure (Tuple e (ParseState input position consumed)) _ -> pure (Tuple e s') +-- | Like `try`, but will reannotate the error location to the `try` point. +tryRethrow :: forall m s a. Monad m => ParserT s m a -> ParserT s m a +tryRethrow p = (ParserT <<< ExceptT <<< StateT) \(s@(ParseState _ position consumed)) -> do + Tuple e s'@(ParseState input' position' _) <- runStateT (runExceptT (unwrap p)) s + case e of + Left (ParseError err _) -> pure (Tuple (Left (ParseError err position)) (ParseState input' position' consumed)) + _ -> pure (Tuple e s') + -- | Parse a phrase, without modifying the consumed state or stream position. lookAhead :: forall s a m. Monad m => ParserT s m a -> ParserT s m a lookAhead p = (ParserT <<< ExceptT <<< StateT) \s -> do diff --git a/src/Text/Parsing/Parser/String.purs b/src/Text/Parsing/Parser/String.purs index e2bebc9..335bab2 100644 --- a/src/Text/Parsing/Parser/String.purs +++ b/src/Text/Parsing/Parser/String.purs @@ -10,7 +10,7 @@ import Data.Maybe (Maybe(..)) import Data.Newtype (wrap) import Data.String (Pattern, fromCharArray, length, singleton) import Text.Parsing.Parser (ParseState(..), ParserT, fail) -import Text.Parsing.Parser.Combinators (try, ()) +import Text.Parsing.Parser.Combinators (tryRethrow, ()) import Text.Parsing.Parser.Pos (updatePosString) import Prelude hiding (between) @@ -62,7 +62,7 @@ anyChar = do -- | Match a character satisfying the specified predicate. satisfy :: forall s m. StringLike s => Monad m => (Char -> Boolean) -> ParserT s m Char -satisfy f = try do +satisfy f = tryRethrow do c <- anyChar if f c then pure c else fail $ "Character '" <> singleton c <> "' did not satisfy predicate" diff --git a/src/Text/Parsing/Parser/Token.purs b/src/Text/Parsing/Parser/Token.purs index 28fc8ac..0761e5f 100644 --- a/src/Text/Parsing/Parser/Token.purs +++ b/src/Text/Parsing/Parser/Token.purs @@ -39,7 +39,7 @@ import Data.String (toCharArray, null, toLower, fromCharArray, singleton, uncons import Data.Tuple (Tuple(..)) import Math (pow) import Text.Parsing.Parser (ParseState(..), ParserT, fail) -import Text.Parsing.Parser.Combinators (skipMany1, try, skipMany, notFollowedBy, option, choice, between, sepBy1, sepBy, (), ()) +import Text.Parsing.Parser.Combinators (skipMany1, try, tryRethrow, skipMany, notFollowedBy, option, choice, between, sepBy1, sepBy, (), ()) import Text.Parsing.Parser.Pos (Position) import Text.Parsing.Parser.String (satisfy, oneOf, noneOf, string, char) import Prelude hiding (when,between) @@ -57,7 +57,7 @@ token tokpos = do -- | Create a parser which matches any token satisfying the predicate. when :: forall m a. Monad m => (a -> Position) -> (a -> Boolean) -> ParserT (List a) m a -when tokpos f = try $ do +when tokpos f = tryRethrow do a <- token tokpos guard $ f a pure a diff --git a/test/Main.purs b/test/Main.purs index 08b8bcd..a401378 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -419,6 +419,11 @@ main = do "foo" (Position { column: 2, line: 1 }) + parseErrorTestPosition + (satisfy (_ == '?')) + "foo" + (Position { column: 1, line: 1 }) + parseTest "foo" Nil From 92c6b504c93befba85a89bb50fa022360afeebc3 Mon Sep 17 00:00:00 2001 From: Nathan Faubion Date: Wed, 26 Jul 2017 10:31:06 -0700 Subject: [PATCH 2/2] Implement fail using failWithPosition --- src/Text/Parsing/Parser.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Text/Parsing/Parser.purs b/src/Text/Parsing/Parser.purs index 9a566e8..5502ded 100644 --- a/src/Text/Parsing/Parser.purs +++ b/src/Text/Parsing/Parser.purs @@ -131,7 +131,7 @@ position = gets \(ParseState _ pos _) -> pos -- | Fail with a message. fail :: forall m s a. Monad m => String -> ParserT s m a -fail message = throwError <<< ParseError message =<< position +fail message = failWithPosition message =<< position -- | Fail with a message and a position. failWithPosition :: forall m s a. Monad m => String -> Position -> ParserT s m a