Merge pull request purescript-contrib#16 from stefankoegel/line-and-column-numbers

Add line and column numbers to `ParseError`

Author: jdegoes

docs/Module.md

@@ -2,13 +2,11 @@
 
 ## Module Text.Parsing.Parser
 
-
-
 #### `ParseError`
 
 ``` purescript
 data ParseError
-  = ParseError { message :: String }
+  = ParseError { position :: Position, message :: String }
 ```
 
 
@@ -26,25 +24,34 @@ instance showParseError :: Show ParseError
 ```
 
 
+#### `PState`
+
+``` purescript
+data PState s
+  = PState { position :: Position, input :: s }
+```
+
+`PState` contains the remaining input and current position.
+
 #### `ParserT`
 
 ``` purescript
 newtype ParserT s m a
-  = ParserT (s -> m { consumed :: Boolean, result :: Either ParseError a, input :: s })
+  = ParserT (PState s -> m { position :: Position, consumed :: Boolean, result :: Either ParseError a, input :: s })
 ```
 
 
 #### `unParserT`
 
 ``` purescript
-unParserT :: forall m s a. ParserT s m a -> s -> m { consumed :: Boolean, result :: Either ParseError a, input :: s }
+unParserT :: forall m s a. ParserT s m a -> PState s -> m { position :: Position, consumed :: Boolean, result :: Either ParseError a, input :: s }
 ```
 
 
 #### `runParserT`
 
 ``` purescript
-runParserT :: forall m s a. (Monad m) => s -> ParserT s m a -> m (Either ParseError a)
+runParserT :: forall m s a. (Monad m) => PState s -> ParserT s m a -> m (Either ParseError a)
 ```
 
 
@@ -160,10 +167,18 @@ fail :: forall m s a. (Monad m) => String -> ParserT s m a
 ```
 
 
+#### `parseFailed`
 
-## Module Text.Parsing.Parser.Combinators
+``` purescript
+parseFailed :: forall s a. s -> Position -> String -> { position :: Position, consumed :: Boolean, result :: Either ParseError a, input :: s }
+```
+
+Creates a failed parser state for the remaining input `s` and current position
+with an error message.
+Most of the time, `fail` should be used instead.
 
 
+## Module Text.Parsing.Parser.Combinators
 
 #### `(<?>)`
 
@@ -343,8 +358,6 @@ many1Till :: forall s a m e. (Monad m) => ParserT s m a -> ParserT s m e -> Pars
 
 ## Module Text.Parsing.Parser.Expr
 
-
-
 #### `Assoc`
 
 ``` purescript
@@ -436,9 +449,51 @@ buildExprParser :: forall m s a. (Monad m) => OperatorTable m s a -> ParserT s m
 
 
 
-## Module Text.Parsing.Parser.String
+## Module Text.Parsing.Parser.Pos
 
+#### `Position`
 
+``` purescript
+data Position
+  = Position { column :: Number, line :: Number }
+```
+
+`Position` represents the position of the parser in the input.
+- `line` is the current line in the input
+- `column` is the column of the next character in the current line that will be parsed
+
+#### `showPosition`
+
+``` purescript
+instance showPosition :: Show Position
+```
+
+
+#### `eqPosition`
+
+``` purescript
+instance eqPosition :: Eq Position
+```
+
+
+#### `initialPos`
+
+``` purescript
+initialPos :: Position
+```
+
+The `Position` before any input has been parsed.
+
+#### `updatePosString`
+
+``` purescript
+updatePosString :: Position -> String -> Position
+```
+
+Updates a `Position` by adding the columns and lines in `String`.
+
+
+## Module Text.Parsing.Parser.String
 
 #### `eof`
 
@@ -499,26 +554,24 @@ noneOf :: forall s m a. (Monad m) => [String] -> ParserT String m String
 
 ## Module Text.Parsing.Parser.Token
 
-
-
 #### `token`
 
 ``` purescript
-token :: forall m a. (Monad m) => ParserT [a] m a
+token :: forall m a. (Monad m) => (a -> Position) -> ParserT [a] m a
 ```
 
 
 #### `when`
 
 ``` purescript
-when :: forall m a. (Monad m) => (a -> Boolean) -> ParserT [a] m a
+when :: forall m a. (Monad m) => (a -> Position) -> (a -> Boolean) -> ParserT [a] m a
 ```
 
 
 #### `match`
 
 ``` purescript
-match :: forall a m. (Monad m, Eq a) => a -> ParserT [a] m a
+match :: forall a m. (Monad m, Eq a) => (a -> Position) -> a -> ParserT [a] m a
 ```
 
 

examples/Test.purs

@@ -7,6 +7,7 @@ import Data.Maybe
 
 import Control.Alt
 import Control.Alternative
+import Control.Apply ((*>))
 import Control.Monad.Eff
 import Control.Lazy
 
@@ -17,6 +18,7 @@ import Text.Parsing.Parser.Combinators
 import Text.Parsing.Parser.Expr
 import Text.Parsing.Parser.String
 import Text.Parsing.Parser.Token
+import Text.Parsing.Parser.Pos
 
 parens :: forall m a. (Monad m) => ParserT String m a -> ParserT String m a
 parens = between (string "(") (string ")")
@@ -31,6 +33,15 @@ parseTest p input = case runParser input p of
   Left (ParseError err) -> print err.message
   Right result -> print result
 
+parseErrorTestPosition :: forall s a eff. (Show a) => Parser s a -> s -> Position -> Eff (trace :: Trace | eff) Unit
+parseErrorTestPosition p input expected = case runParser input p of
+  Right _ -> print "error: ParseError expected!"
+  Left (ParseError { position: pos }) -> case expected == pos of
+    true  -> print $ "ok, as expected: " ++ show pos
+    false -> print $ "error: got " ++ show pos ++ " instead of " ++ show expected
+
+
+
 opTest :: Parser String String
 opTest = chainl char (do string "+"
                          return (++)) ""
@@ -91,21 +102,27 @@ main = do
   parseTest exprTest "1*2+3/4-5"
   parseTest manySatisfyTest "ab?"
 
+  let tokpos = const initialPos
   print "should be A"
-  parseTest token [A, B]
+  parseTest (token tokpos) [A, B]
   print "should be B"
-  parseTest token [B, A]
+  parseTest (token tokpos) [B, A]
 
   print "should be A"
-  parseTest (when isA) [A, B]
+  parseTest (when tokpos isA) [A, B]
   print "should fail"
-  parseTest (when isA) [B, B]
+  parseTest (when tokpos isA) [B, B]
 
   print "should be A"
-  parseTest (match A) [A]
+  parseTest (match tokpos A) [A]
   print "should be B"
-  parseTest (match B) [B]
+  parseTest (match tokpos B) [B]
   print "should be A"
-  parseTest (match A) [A, B]
+  parseTest (match tokpos A) [A, B]
   print "should fail"
-  parseTest (match B) [A, B]
+  parseTest (match tokpos B) [A, B]
+
+  parseErrorTestPosition (string "abc") "bcd" (Position { column: 1, line: 1 })
+  parseErrorTestPosition (string "abc" *> eof) "abcdefg" (Position { column: 4, line: 1 })
+  parseErrorTestPosition (string "a\nb\nc\n" *> eof) "a\nb\nc\nd\n" (Position { column: 1, line: 4 })
+  parseErrorTestPosition (string "\ta" *> eof) "\tab" (Position { column: 10, line: 1 })

src/Text/Parsing/Parser.purs

@@ -19,42 +19,51 @@ import Control.Monad.Error.Trans
 import Control.MonadPlus
 import Control.Plus
 
+import Text.Parsing.Parser.Pos
+
 data ParseError = ParseError
   { message :: String
+  , position :: Position
   }
 
 instance errorParseError :: Error ParseError where
-  noMsg = ParseError { message: "" }
-  strMsg msg = ParseError { message: msg }
+  noMsg = ParseError { message: "", position: initialPos }
+  strMsg msg = ParseError { message: msg, position: initialPos }
 
 instance showParseError :: Show ParseError where
-  show (ParseError msg) = "ParseError { message: " ++ msg.message ++ " }"
+  show (ParseError msg) = "ParseError { message: " ++ msg.message ++ ", position: " ++ show msg.position ++ " }"
+
+-- | `PState` contains the remaining input and current position.
+data PState s = PState
+  { input :: s
+  , position :: Position
+  }
 
-newtype ParserT s m a = ParserT (s -> m { input :: s, result :: Either ParseError a, consumed :: Boolean })
+newtype ParserT s m a = ParserT (PState s -> m { input :: s, result :: Either ParseError a, consumed :: Boolean, position :: Position })
 
-unParserT :: forall m s a. ParserT s m a -> s -> m { input :: s, result :: Either ParseError a, consumed :: Boolean }
+unParserT :: forall m s a. ParserT s m a -> PState s -> m { input :: s, result :: Either ParseError a, consumed :: Boolean, position :: Position }
 unParserT (ParserT p) = p
 
-runParserT :: forall m s a. (Monad m) => s -> ParserT s m a -> m (Either ParseError a)
+runParserT :: forall m s a. (Monad m) => PState s -> ParserT s m a -> m (Either ParseError a)
 runParserT s p = do
   o <- unParserT p s
   return o.result
 
 type Parser s a = ParserT s Identity a
 
 runParser :: forall s a. s -> Parser s a -> Either ParseError a
-runParser s = runIdentity <<< runParserT s
+runParser s = runIdentity <<< runParserT (PState { input: s, position: initialPos })
 
 instance functorParserT :: (Functor m) => Functor (ParserT s m) where
   (<$>) f p = ParserT $ \s -> f' <$> unParserT p s
     where
-    f' o = { input: o.input, result: f <$> o.result, consumed: o.consumed }
+    f' o = { input: o.input, result: f <$> o.result, consumed: o.consumed, position: o.position }
 
 instance applyParserT :: (Monad m) => Apply (ParserT s m) where
   (<*>) = ap
 
 instance applicativeParserT :: (Monad m) => Applicative (ParserT s m) where
-  pure a = ParserT $ \s -> pure { input: s, result: Right a, consumed: false }
+  pure a = ParserT $ \(PState { input: s, position: pos }) -> pure { input: s, result: Right a, consumed: false, position: pos }
 
 instance altParserT :: (Monad m) => Alt (ParserT s m) where
   (<|>) p1 p2 = ParserT $ \s -> unParserT p1 s >>= \o ->
@@ -70,29 +79,35 @@ instance alternativeParserT :: (Monad m) => Alternative (ParserT s m)
 instance bindParserT :: (Monad m) => Bind (ParserT s m) where
   (>>=) p f = ParserT $ \s -> unParserT p s >>= \o ->
     case o.result of
-      Left err -> return { input: o.input, result: Left err, consumed: o.consumed }
-      Right a -> updateConsumedFlag o.consumed <$> unParserT (f a) o.input
+      Left err -> return { input: o.input, result: Left err, consumed: o.consumed, position: o.position }
+      Right a -> updateConsumedFlag o.consumed <$> unParserT (f a) (PState { input: o.input, position: o.position })
     where
-    updateConsumedFlag c o = { input: o.input, consumed: c || o.consumed, result: o.result }
+    updateConsumedFlag c o = { input: o.input, consumed: c || o.consumed, result: o.result, position: o.position }
 
 instance monadParserT :: (Monad m) => Monad (ParserT s m)
 
 instance monadPlusParserT :: (Monad m) => MonadPlus (ParserT s m)
 
 instance monadTransParserT :: MonadTrans (ParserT s) where
-  lift m = ParserT $ \s -> (\a -> { input: s, consumed: false, result: Right a }) <$> m
+  lift m = ParserT $ \(PState { input: s, position: pos }) -> (\a -> { input: s, consumed: false, result: Right a, position: pos }) <$> m
 
 instance monadStateParserT :: (Monad m) => MonadState s (ParserT s m) where
-  state f = ParserT $ \s ->
+  state f = ParserT $ \(PState { input: s, position: pos }) ->
     return $ case f s of
-      Tuple a s' -> { input: s', consumed: false, result: Right a }
+      Tuple a s' -> { input: s', consumed: false, result: Right a, position: pos }
 
 instance lazy1ParserT :: Lazy1 (ParserT s m) where
   defer1 f = ParserT $ \s -> unParserT (f unit) s
 
 consume :: forall s m. (Monad m) => ParserT s m Unit
-consume = ParserT $ \s -> return { consumed: true, input: s, result: Right unit }
+consume = ParserT $ \(PState { input: s, position: pos }) -> return { consumed: true, input: s, result: Right unit, position: pos }
 
 fail :: forall m s a. (Monad m) => String -> ParserT s m a
-fail message = ParserT $ \s -> return { input: s, consumed: false, result: Left (ParseError { message: message }) }
+fail message = ParserT $ \(PState { input: s, position: pos }) -> return $ parseFailed s pos message
+
+-- | Creates a failed parser state for the remaining input `s` and current position
+-- | with an error message.
+-- | Most of the time, `fail` should be used instead.
+parseFailed :: forall s a. s -> Position -> String -> { input :: s, result :: Either ParseError a, consumed :: Boolean, position :: Position }
+parseFailed s pos message = { input: s, consumed: false, result: Left (ParseError { message: message, position: pos }), position: pos }
 

src/Text/Parsing/Parser/Combinators.purs

@@ -38,10 +38,10 @@ optionMaybe :: forall m s a. (Functor m, Monad m) => ParserT s m a -> ParserT s
 optionMaybe p = option Nothing (Just <$> p)
 
 try :: forall m s a. (Functor m) => ParserT s m a -> ParserT s m a
-try p = ParserT $ \s -> try' s <$> unParserT p s
+try p = ParserT $ \(PState { input: s, position: pos }) -> try' s pos <$> unParserT p (PState { input: s, position: pos })
   where
-  try' s o@{ result = Left _ } = { input: s, result: o.result, consumed: false }
-  try' _ o = o
+  try' s pos o@{ result = Left _ } = { input: s, result: o.result, consumed: false, position: pos }
+  try' _ _   o = o
 
 sepBy :: forall m s a sep. (Monad m) => ParserT s m a -> ParserT s m sep -> ParserT s m [a]
 sepBy p sep = sepBy1 p sep <|> return []
@@ -117,9 +117,9 @@ skipMany1 p = do
   return unit
 
 lookAhead :: forall s a m. (Monad m) => ParserT s m a -> ParserT s m a
-lookAhead (ParserT p) = ParserT \s -> do
-  state <- p s
-  return state{input = s, consumed = false}
+lookAhead (ParserT p) = ParserT \(PState { input: s, position: pos }) -> do
+  state <- p (PState { input: s, position: pos })
+  return state{input = s, consumed = false, position = pos}
 
 notFollowedBy :: forall s a m. (Monad m) => ParserT s m a -> ParserT s m Unit
 notFollowedBy p = try $ (try p *> fail "Negated parser succeeded") <|> return unit