proof of concept

Author: chtenb

src/Text/Parsing/StringParser.purs

@@ -15,15 +15,14 @@ import Data.Either (Either(..))
 -- | A position in an input string.
 type Pos = Int
 
--- | Strings are represented as a string with an index from the
+-- | Strings are represented as a substring with an index from the
 -- | start of the string.
 -- |
--- | `{ str: s, pos: n }` is interpreted as the substring of `s`
--- | starting at index n.
+-- | `{ str: s, pos: n }` is interpreted as the substring `s`
+-- | starting at index n of the original string.
 -- |
--- | This allows us to avoid repeatedly finding substrings
--- | every time we match a character.
-type PosString = { str :: String, pos :: Pos }
+-- | The pos is only kept for error messaging.
+type PosString = { substr :: String, posFromStart :: Pos }
 
 -- | The type of parsing errors.
 type ParseError = { error :: String, pos :: Pos }
@@ -43,7 +42,7 @@ unParser (Parser p) = p
 -- | Run a parser for an input string. See also `printParserError`
 -- | and `unParser` for more flexible usages.
 runParser :: forall a. Parser a -> String -> Either ParseError a
-runParser (Parser p) s = map _.result (p { str: s, pos: 0 })
+runParser (Parser p) s = map _.result (p { substr: s, posFromStart: 0 })
 
 -- | Prints a ParseError's the error message and the position of the error.
 printParserError :: ParseError -> String
@@ -65,7 +64,7 @@ instance altParser :: Alt Parser where
   alt (Parser p1) (Parser p2) = Parser \s ->
     case p1 s of
       Left { error, pos }
-        | s.pos == pos -> p2 s
+        | s.posFromStart == pos -> p2 s
         | otherwise -> Left { error, pos }
       right -> right
 
@@ -92,17 +91,28 @@ instance monadRecParser :: MonadRec Parser where
     split { result: Done b, suffix } = Done { result: b, suffix }
 
 instance lazyParser :: Lazy (Parser a) where
-  defer f = Parser $ \str -> unParser (f unit) str
+  defer f = Parser \str -> unParser (f unit) str
 
 -- | Fail with the specified message.
 fail :: forall a. String -> Parser a
-fail error = Parser \{ pos } -> Left { pos, error }
+fail error = Parser \{ posFromStart } -> Left { pos: posFromStart, error }
 
 -- | In case of error, the default behavior is to backtrack if no input was consumed.
 -- |
 -- | `try p` backtracks even if input was consumed.
 try :: forall a. Parser a -> Parser a
-try (Parser p) = Parser \(s@{ pos }) -> lmap (_ { pos = pos }) (p s)
+-- try (Parser p) = Parser \(s@{ pos }) -> lmap (_ { pos = pos }) (p s)
+try (Parser p) = Parser \s ->
+  case p s of
+    Left { error } -> Left { pos: s.posFromStart, error }
+    right -> right
+
+-- | Read ahead without consuming input.
+lookAhead :: forall a. Parser a -> Parser a
+lookAhead (Parser p) = Parser \s ->
+  case p s of
+    Right { result } -> Right { result, suffix: s }
+    left -> left
 
 instance semigroupParser :: Semigroup a => Semigroup (Parser a) where
   append = lift2 append

src/Text/Parsing/StringParser/CodePoints.purs

@@ -31,7 +31,7 @@ import Data.Either (Either(..))
 import Data.Enum (fromEnum)
 import Data.Foldable (class Foldable, foldMap, elem, notElem)
 import Data.Maybe (Maybe(..))
-import Data.String.CodePoints (codePointAt, drop, indexOf', length)
+import Data.String.CodePoints (codePointAt, drop, indexOf, length)
 import Data.String.CodeUnits (singleton)
 import Data.String.Pattern (Pattern(..))
 import Data.String.Regex as Regex
@@ -43,17 +43,17 @@ import Text.Parsing.StringParser.Combinators (many, (<?>))
 eof :: Parser Unit
 eof = Parser \s ->
   case s of
-    { str, pos } | pos < length str -> Left { pos, error: "Expected EOF" }
+    { substr, posFromStart } | 0 < length substr -> Left { pos: posFromStart, error: "Expected EOF" }
     _ -> Right { result: unit, suffix: s }
 
 -- | Match any character.
 anyChar :: Parser Char
-anyChar = Parser \{ str, pos } ->
-  case codePointAt pos str of
+anyChar = Parser \{ substr, posFromStart } ->
+  case codePointAt 0 substr of
     Just cp -> case toChar cp of
-      Just chr -> Right { result: chr, suffix: { str, pos: pos + 1 } }
-      Nothing -> Left { pos, error: "CodePoint " <> show cp <> " is not a character" }
-    Nothing -> Left { pos, error: "Unexpected EOF" }
+      Just chr -> Right { result: chr, suffix: { substr: drop 1 substr, posFromStart: posFromStart + 1 } }
+      Nothing -> Left { pos: posFromStart, error: "CodePoint " <> show cp <> " is not a character" }
+    Nothing -> Left { pos: posFromStart, error: "Unexpected EOF" }
   where
   toChar = fromCharCode <<< fromEnum
 
@@ -68,8 +68,8 @@ anyDigit = try do
 string :: String -> Parser String
 string nt = Parser \s ->
   case s of
-    { str, pos } | indexOf' (Pattern nt) pos str == Just pos -> Right { result: nt, suffix: { str, pos: pos + length nt } }
-    { pos } -> Left { pos, error: "Expected '" <> nt <> "'." }
+    { substr, posFromStart } | indexOf (Pattern nt) substr == Just 0 -> Right { result: nt, suffix: { substr: drop (length nt) substr, posFromStart: posFromStart + length nt } }
+    { posFromStart } -> Left { pos: posFromStart, error: "Expected '" <> nt <> "'." }
 
 -- | Match a character satisfying the given predicate.
 satisfy :: (Char -> Boolean) -> Parser Char
@@ -135,10 +135,9 @@ regex pat =
   pattern = "^(" <> pat <> ")"
 
   matchRegex :: Regex.Regex -> Parser String
-  matchRegex r = Parser \{ str, pos } -> do
-    let remainder = drop pos str
-    case NEA.head <$> Regex.match r remainder of
+  matchRegex r = Parser \{ substr, posFromStart } -> do
+    case NEA.head <$> Regex.match r substr of
       Just (Just matched) ->
-        Right { result: matched, suffix: { str, pos: pos + length matched } }
+        Right { result: matched, suffix: { substr: drop (length matched) substr, posFromStart: posFromStart + length matched } }
       _ ->
-        Left { pos, error: "no match" }
+        Left { pos: posFromStart, error: "no match" }

src/Text/Parsing/StringParser/CodeUnits.purs

@@ -42,15 +42,15 @@ import Text.Parsing.StringParser.Combinators (many, (<?>))
 eof :: Parser Unit
 eof = Parser \s ->
   case s of
-    { str, pos } | pos < SCU.length str -> Left { pos, error: "Expected EOF" }
+    { substr, posFromStart } | 0 < SCU.length substr -> Left { pos: posFromStart, error: "Expected EOF" }
     _ -> Right { result: unit, suffix: s }
 
 -- | Match any character.
 anyChar :: Parser Char
-anyChar = Parser \{ str, pos } ->
-  case charAt pos str of
-    Just chr -> Right { result: chr, suffix: { str, pos: pos + 1 } }
-    Nothing -> Left { pos, error: "Unexpected EOF" }
+anyChar = Parser \{ substr, posFromStart } ->
+  case charAt 0 substr of
+    Just chr -> Right { result: chr, suffix: { substr: SCU.drop 1 substr, posFromStart: posFromStart + 1 } }
+    Nothing -> Left { pos: posFromStart, error: "Unexpected EOF" }
 
 -- | Match any digit.
 anyDigit :: Parser Char
@@ -63,8 +63,8 @@ anyDigit = try do
 string :: String -> Parser String
 string nt = Parser \s ->
   case s of
-    { str, pos } | SCU.indexOf' (Pattern nt) pos str == Just pos -> Right { result: nt, suffix: { str, pos: pos + SCU.length nt } }
-    { pos } -> Left { pos, error: "Expected '" <> nt <> "'." }
+    { substr, posFromStart } | SCU.indexOf (Pattern nt) substr == Just 0 -> Right { result: nt, suffix: { substr: SCU.drop (SCU.length nt) substr, posFromStart: posFromStart + SCU.length nt } }
+    { posFromStart } -> Left { pos: posFromStart, error: "Expected '" <> nt <> "'." }
 
 -- | Match a character satisfying the given predicate.
 satisfy :: (Char -> Boolean) -> Parser Char
@@ -130,10 +130,9 @@ regex pat =
   pattern = "^(" <> pat <> ")"
 
   matchRegex :: Regex.Regex -> Parser String
-  matchRegex r = Parser \{ str, pos } -> do
-    let remainder = SCU.drop pos str
-    case NEA.head <$> Regex.match r remainder of
+  matchRegex r = Parser \{ substr, posFromStart } -> do
+    case NEA.head <$> Regex.match r substr of
       Just (Just matched) ->
-        Right { result: matched, suffix: { str, pos: pos + SCU.length matched } }
+        Right { result: matched, suffix: { substr: SCU.drop (SCU.length matched) substr, posFromStart: posFromStart + SCU.length matched } }
       _ ->
-        Left { pos, error: "no match" }
+        Left { pos: posFromStart, error: "no match" }

src/Text/Parsing/StringParser/Combinators.purs

@@ -1,7 +1,6 @@
 -- | This module defines combinators for building string parsers.
 module Text.Parsing.StringParser.Combinators
-  ( lookAhead
-  , many
+  ( many
   , many1
   , withError
   , (<?>)
@@ -32,21 +31,13 @@ import Prelude
 import Control.Alt ((<|>))
 import Control.Lazy (fix)
 import Control.Monad.Rec.Class (Step(..), tailRecM)
-import Data.Either (Either(..))
 import Data.Foldable (class Foldable, foldl)
 import Data.List (List(..), manyRec)
 import Data.List.NonEmpty (NonEmptyList(..))
 import Data.List.NonEmpty as NEL
 import Data.Maybe (Maybe(..))
 import Data.NonEmpty ((:|))
-import Text.Parsing.StringParser (Parser(..), fail)
-
--- | Read ahead without consuming input.
-lookAhead :: forall a. Parser a -> Parser a
-lookAhead (Parser p) = Parser \s ->
-  case p s of
-    Right { result } -> Right { result, suffix: s }
-    left -> left
+import Text.Parsing.StringParser (Parser, fail)
 
 -- | Match zero or more times.
 many :: forall a. Parser a -> Parser (List a)

test/CodePoints.purs

@@ -15,7 +15,7 @@ import Data.Unfoldable (replicate)
 import Effect (Effect)
 import Effect.Class.Console (log)
 import Test.Assert (assert', assert)
-import Text.Parsing.StringParser (Parser, runParser, try)
+import Text.Parsing.StringParser (ParseError, Parser(..), PosString, runParser, try)
 import Text.Parsing.StringParser.CodePoints (anyDigit, char, eof, string, anyChar, regex)
 import Text.Parsing.StringParser.Combinators (many1, endBy1, sepBy1, optionMaybe, many, manyTill, many1Till, chainl, fix, between)
 import Text.Parsing.StringParser.Expr (Assoc(..), Operator(..), buildExprParser)
@@ -60,6 +60,9 @@ tryTest =
   try (string "aa" <> string "bb") <|>
     (string "aa" <> string "cc")
 
+testParser :: forall a. Parser a -> String -> Either ParseError { result :: a, suffix :: PosString }
+testParser (Parser p) s = p { substr: s, posFromStart: 0 }
+
 canParse :: forall a. Parser a -> String -> Boolean
 canParse p input = isRight $ runParser p input
 

test/Examples.purs

@@ -8,9 +8,9 @@ import Data.Foldable (fold, foldl, sum)
 import Data.List.Types (NonEmptyList)
 import Effect (Effect)
 import Effect.Console (log, logShow)
-import Text.Parsing.StringParser (Parser, fail, runParser, unParser)
+import Text.Parsing.StringParser (Parser, fail, lookAhead, runParser, unParser)
 import Text.Parsing.StringParser.CodePoints (anyChar, char, eof, regex, skipSpaces, string)
-import Text.Parsing.StringParser.Combinators (between, endBy1, lookAhead, many, many1, sepBy1, (<?>))
+import Text.Parsing.StringParser.Combinators (between, endBy1, many, many1, sepBy1, (<?>))
 
 -- Serves only to make this file runnable
 main :: Effect Unit
@@ -234,7 +234,7 @@ doBoth parserName parser content = do
 doUnParser :: forall a. Show a => String -> Parser a -> String -> Effect Unit
 doUnParser parserName parser content = do
   log $ "(unParser) Parsing content with '" <> parserName <> "'"
-  case unParser parser { str: content, pos: 0 } of
+  case unParser parser { substr: content, posFromStart: 0 } of
     Left rec -> log $ "Position: " <> show rec.pos
       <>
         "\n\

test/Main.purs

@@ -9,8 +9,9 @@ import Test.CodeUnits (testCodeUnits)
 
 main :: Effect Unit
 main = do
-  log "Testing CodePoint parsing\n"
-  testCodePoints
 
-  log "\n\nTesting CodeUnit parsing\n"
+  log "Testing CodeUnit parsing\n"
   testCodeUnits
+
+  log "\n\nTesting CodePoint parsing\n"
+  testCodePoints