diff --git a/README.md b/README.md index 028aa08..0f14ee8 100644 --- a/README.md +++ b/README.md @@ -19,6 +19,12 @@ bower install purescript-parsing - [See the tests](test/Main.purs) for some example usages. - Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-parsing). +## Related Packages + +- [__purescript-parsing-dataview__](https://pursuit.purescript.org/packages/purescript-parsing-dataview) + Provides the module __Text.Parsing.Parser.DataView__ for binary parsing of + `ArrayBuffer`. + ## Contributing Read the [contribution guidelines](https://github.com/purescript-contrib/purescript-parsing/blob/master/.github/contributing.md) to get started and see helpful related resources. diff --git a/src/Text/Parsing/Parser.purs b/src/Text/Parsing/Parser.purs index 55204ad..013df83 100644 --- a/src/Text/Parsing/Parser.purs +++ b/src/Text/Parsing/Parser.purs @@ -13,6 +13,7 @@ module Text.Parsing.Parser , position , fail , failWithPosition + , label ) where import Prelude @@ -20,7 +21,7 @@ import Prelude import Control.Alt (class Alt) import Control.Apply (lift2) import Control.Lazy (defer, class Lazy) -import Control.Monad.Error.Class (class MonadThrow, throwError) +import Control.Monad.Error.Class (class MonadThrow, throwError, catchError) import Control.Monad.Except (class MonadError, ExceptT(..), runExceptT, mapExceptT) import Control.Monad.Rec.Class (class MonadRec) import Control.Monad.State (class MonadState, StateT(..), evalStateT, gets, mapStateT, modify_, runStateT) @@ -136,3 +137,9 @@ 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 failWithPosition message pos = throwError (ParseError message pos) + +-- | If parsing fails inside this labelled context, then prepend the `String` +-- | to the error `String` in the `ParseError`. +label :: forall m s a. Monad m => String -> ParserT s m a -> ParserT s m a +label messagePrefix p = catchError p $ \ (ParseError message pos) -> + throwError $ ParseError (messagePrefix <> message) pos diff --git a/test/Main.purs b/test/Main.purs index 7e41902..21c0dd5 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -13,7 +13,7 @@ import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Console (logShow) import Test.Assert (assert') -import Text.Parsing.Parser (Parser, ParserT, runParser, parseErrorPosition) +import Text.Parsing.Parser (Parser, ParserT, ParseError(..), runParser, parseErrorPosition, label) import Text.Parsing.Parser.Combinators (endBy1, sepBy1, optionMaybe, try, chainl, between) import Text.Parsing.Parser.Expr (Assoc(..), Operator(..), buildExprParser) import Text.Parsing.Parser.Language (javaStyle, haskellStyle, haskellDef) @@ -496,3 +496,15 @@ main = do haskellStyleTest javaStyleTest + + case runParser "aa" p of + Right _ -> assert' "error: ParseError expected!" false + Left (ParseError message pos) -> do + let messageExpected = "context1context2Expected \"b\"" + assert' ("expected message: " <> messageExpected <> ", message: " <> message) (message == messageExpected) + logShow messageExpected + where + p = label "context1" $ do + _ <- string "a" + label "context2" $ do + string "b"