Add parsers rest, take, eof

- `Parser.String.rest`
- `Parser.String.take`
- `Parser.Token.eof`

Bugfixes:

- `Parser.String.eof` Set consumed on success so that this parser combines
  correctly with `notFollowedBy eof`. Added a test for this.

Author: jamesdbrock

CHANGELOG.md

@@ -8,10 +8,19 @@ Breaking changes:
 
 New features:
 
+- `Parser.String.rest` (#140 by @jamesdbrock)
+- `Parser.String.takeN` (#140 by @jamesdbrock)
+- `Parser.Token.eof` (#140 by @jamesdbrock)
+
 Bugfixes:
 
+- `Parser.String.eof` Set consumed on success so that this parser combines
+  correctly with `notFollowedBy eof`. Added a test for this. (#140 by @jamesdbrock)
+
 Other improvements:
 
+- Documentation. (#140 by @jamesdbrock)
+
 ## [v8.1.0](https://github.com/purescript-contrib/purescript-parsing/releases/tag/v8.1.0) - 2022-01-10
 
 Other improvements: README Quick start monadic parsing tutorial

src/Text/Parsing/Parser.purs

@@ -172,4 +172,3 @@ failWithPosition message pos = throwError (ParseError message pos)
 -- | `region` as the parser backs out the call stack.
 region :: forall m s a. Monad m => (ParseError -> ParseError) -> ParserT s m a -> ParserT s m a
 region context p = catchError p $ \err -> throwError $ context err
-

src/Text/Parsing/Parser/Combinators.purs

@@ -387,7 +387,6 @@ skipMany1Rec p = p *> tailRecM go unit
 -- | Fail if the specified parser matches.
 notFollowedBy :: forall s a m. Monad m => ParserT s m a -> ParserT s m Unit
 notFollowedBy p = try $ (try p *> fail "Negated parser succeeded") <|> pure unit
--- why do we need the outer try?
 
 -- | Parse several phrases until the specified terminator matches.
 manyTill :: forall s a m e. Monad m => ParserT s m a -> ParserT s m e -> ParserT s m (List a)

src/Text/Parsing/Parser/String.purs

@@ -2,7 +2,7 @@
 -- |
 -- | All of these primitive parsers will consume their input when they succeed.
 -- |
--- | All of these primitive parsers will consume no input (backtrack) when they
+-- | All of these primitive parsers will consume no input when they
 -- | fail.
 -- |
 -- | The behavior of these primitive parsers is based on the behavior of the
@@ -22,11 +22,13 @@
 module Text.Parsing.Parser.String
   ( string
   , eof
+  , rest
   , anyChar
   , anyCodePoint
   , satisfy
   , satisfyCodePoint
   , char
+  , takeN
   , whiteSpace
   , skipSpaces
   , oneOf
@@ -44,10 +46,10 @@ import Data.Char (fromCharCode)
 import Data.CodePoint.Unicode (isSpace)
 import Data.Foldable (elem)
 import Data.Maybe (Maybe(..))
-import Data.String (CodePoint, Pattern(..), null, singleton, stripPrefix, uncons)
+import Data.String (CodePoint, Pattern(..), length, null, singleton, splitAt, stripPrefix, uncons)
 import Data.String.CodeUnits as SCU
 import Data.Tuple (Tuple(..), fst)
-import Text.Parsing.Parser (ParseState(..), ParserT, fail)
+import Text.Parsing.Parser (ParseState(..), ParserT, consume, fail)
 import Text.Parsing.Parser.Combinators (skipMany, tryRethrow, (<?>), (<~?>))
 import Text.Parsing.Parser.Pos (Position(..))
 import Unsafe.Coerce (unsafeCoerce)
@@ -56,7 +58,17 @@ import Unsafe.Coerce (unsafeCoerce)
 eof :: forall m. Monad m => ParserT String m Unit
 eof = do
   ParseState input _ _ <- get
-  unless (null input) (fail "Expected EOF")
+  if (null input)
+  -- We must consume so this combines correctly with notFollowedBy
+  then consume
+  else (fail "Expected EOF")
+
+-- | Match the entire rest of the input stream. Always succeeds.
+rest :: forall m. Monad m => ParserT String m String
+rest = do
+  ParseState input position _ <- get
+  put $ ParseState "" (updatePosString position input) true
+  pure input
 
 -- | Match the specified string.
 string :: forall m. Monad m => String -> ParserT String m String
@@ -111,8 +123,18 @@ satisfyCodePoint f = tryRethrow do
 char :: forall m. Monad m => Char -> ParserT String m Char
 char c = satisfy (_ == c) <?> show c
 
+-- | Match a `String` exactly *N* characters long.
+takeN :: forall m. Monad m => Int -> ParserT String m String
+takeN n = do
+  ParseState input position _ <- get
+  let { before, after } = splitAt n input
+  if length before == n then do
+    put $ ParseState after (updatePosString position before) true
+    pure before
+  else fail ("Could not take " <> show n <> " characters")
+
 -- | Match zero or more whitespace characters satisfying
--- | `Data.CodePoint.Unicode.isSpace`.
+-- | `Data.CodePoint.Unicode.isSpace`. Always succeeds.
 whiteSpace :: forall m. Monad m => ParserT String m String
 whiteSpace = fst <$> match skipSpaces
 

src/Text/Parsing/Parser/Token.purs

@@ -4,6 +4,7 @@ module Text.Parsing.Parser.Token
   ( token
   , when
   , match
+  , eof
   , LanguageDef
   , GenLanguageDef(LanguageDef)
   , unGenLanguageDef
@@ -23,7 +24,7 @@ module Text.Parsing.Parser.Token
 import Prelude hiding (between, when)
 
 import Control.Lazy (fix)
-import Control.Monad.State (gets, modify_)
+import Control.Monad.State (get, gets, modify_)
 import Control.MonadPlus (guard, (<|>))
 import Data.Array as Array
 import Data.Char (fromCharCode, toCharCode)
@@ -43,12 +44,12 @@ import Data.String.CodeUnits as SCU
 import Data.String.Unicode as Unicode
 import Data.Tuple (Tuple(..))
 import Math (pow)
-import Text.Parsing.Parser (ParseState(..), ParserT, fail)
+import Text.Parsing.Parser (ParseState(..), ParserT, consume, fail)
 import Text.Parsing.Parser.Combinators (between, choice, notFollowedBy, option, sepBy, sepBy1, skipMany, skipMany1, try, tryRethrow, (<?>), (<??>))
 import Text.Parsing.Parser.Pos (Position)
 import Text.Parsing.Parser.String (char, noneOf, oneOf, satisfy, satisfyCodePoint, string)
 
--- | Create a parser which Returns the first token in the stream.
+-- | A parser which returns the first token in the stream.
 token :: forall m a. Monad m => (a -> Position) -> ParserT (List a) m a
 token tokpos = do
   input <- gets \(ParseState input _ _) -> input
@@ -59,7 +60,7 @@ token tokpos = do
         ParseState tail (tokpos head) true
       pure head
 
--- | Create a parser which matches any token satisfying the predicate.
+-- | 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 = tryRethrow do
   a <- token tokpos
@@ -70,6 +71,15 @@ when tokpos f = tryRethrow do
 match :: forall a m. Monad m => Eq a => (a -> Position) -> a -> ParserT (List a) m a
 match tokpos tok = when tokpos (_ == tok)
 
+-- | Match the “end-of-file,” the end of the input stream.
+eof :: forall a m. Monad m => ParserT (List a) m Unit
+eof = do
+  ParseState input _ _ <- get
+  if (List.null input)
+  -- We must consume so this combines correctly with notFollowedBy
+  then consume
+  else (fail "Expected EOF")
+
 type LanguageDef = GenLanguageDef String Identity
 
 -- | The `GenLanguageDef` type is a record that contains all parameterizable

test/Main.purs

@@ -18,13 +18,14 @@ import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Console (logShow)
 import Test.Assert (assert')
-import Text.Parsing.Parser (ParseError(..), Parser, ParserT, parseErrorMessage, parseErrorPosition, region, runParser)
-import Text.Parsing.Parser.Combinators (between, chainl, chainl1Rec, chainlRec, chainr1Rec, chainrRec, endBy1, endBy1Rec, endByRec, many1Rec, many1TillRec, manyTillRec, optionMaybe, sepBy1, sepBy1Rec, sepByRec, sepEndBy1Rec, sepEndByRec, skipMany1Rec, skipManyRec, try)
+import Text.Parsing.Parser (ParseError(..), Parser, ParserT, parseErrorMessage, parseErrorPosition, position, region, runParser)
+import Text.Parsing.Parser.Combinators (between, chainl, chainl1Rec, chainlRec, chainr1Rec, chainrRec, endBy1, endBy1Rec, endByRec, many1Rec, many1TillRec, manyTillRec, notFollowedBy, optionMaybe, sepBy1, sepBy1Rec, sepByRec, sepEndBy1Rec, sepEndByRec, skipMany1Rec, skipManyRec, try)
 import Text.Parsing.Parser.Expr (Assoc(..), Operator(..), buildExprParser)
 import Text.Parsing.Parser.Language (haskellDef, haskellStyle, javaStyle)
 import Text.Parsing.Parser.Pos (Position(..), initialPos)
-import Text.Parsing.Parser.String (anyChar, anyCodePoint, char, eof, noneOfCodePoints, oneOfCodePoints, satisfy, string, whiteSpace)
+import Text.Parsing.Parser.String (anyChar, anyCodePoint, char, eof, noneOfCodePoints, oneOfCodePoints, rest, satisfy, string, takeN, whiteSpace)
 import Text.Parsing.Parser.Token (TokenParser, letter, makeTokenParser, match, token, when)
+import Text.Parsing.Parser.Token as Parser.Token
 
 parens :: forall m a. Monad m => ParserT String m a -> ParserT String m a
 parens = between (string "(") (string ")")
@@ -574,6 +575,17 @@ main = do
   parseTest "1*2+3/4-5" (-3) exprTest
   parseTest "ab?" "ab" manySatisfyTest
 
+  parseTest "ab" unit (char 'a' *> notFollowedBy (char 'a'))
+
+  parseTest "rest" "rest" rest
+  parseTest "rest" unit (rest *> eof)
+  parseTest "rest\nrest" (Position { line: 2, column: 5 }) (rest *> position)
+
+  parseErrorTestPosition
+    (rest *> notFollowedBy eof)
+    "aa\naa"
+    (Position { column: 3, line: 2 })
+
   parseErrorTestPosition
     anyChar
     "𝅘𝅥𝅯"
@@ -591,6 +603,11 @@ main = do
     one <- Array.many $ oneOfCodePoints $ SCP.toCodePointArray "🤔💯✅"
     pure $ SCP.fromCodePointArray <$> [ none, one ]
 
+  parseTest "abcd" "ab" $ takeN 2
+  parseTest "abcd" "" $ takeN 0
+  parseErrorTestPosition (takeN 10) "abcd" (Position { column: 1, line: 1 })
+  parseErrorTestPosition (takeN (-1)) "abcd" (Position { column: 1, line: 1 })
+
   parseErrorTestMessage
     (noneOfCodePoints $ SCP.toCodePointArray "❓✅")
     "❓"
@@ -617,6 +634,8 @@ main = do
   parseTest (fromFoldable [ B ]) B (match tokpos B)
   parseTest (fromFoldable [ A, B ]) A (match tokpos A)
 
+  parseTest (fromFoldable []) unit Parser.Token.eof
+
   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 })