parsing failure context label (#96)

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.

src/Text/Parsing/Parser.purs

@@ -13,14 +13,15 @@ module Text.Parsing.Parser
   , position
   , fail
   , failWithPosition
+  , label
   ) where
 
 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

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"