Add basic spec tests

bench/Main.purs

@@ -5,7 +5,6 @@
 -- | This benchmark suite is intended to guide changes to this package so that
 -- | we can compare the benchmarks of different commits.
 
-
 module Bench.Main where
 
 import Prelude
@@ -45,7 +44,7 @@ parse23RegexPoints :: Parser (List String)
 parse23RegexPoints = manyRec $ StringParser.CodePoints.regex """\d\d"""
 
 parse23RegexUnits :: Parser (List String)
-parse23RegexUnits = manyRec $ StringParser.CodeUnits.string """\d\d"""
+parse23RegexUnits = manyRec $ StringParser.CodeUnits.regex """\d\d"""
 
 main :: Effect Unit
 main = do

spago.dhall

@@ -17,6 +17,7 @@
   , "psci-support"
   , "strings"
   , "tailrec"
+  , "transformers"
   , "unfoldable"
   ]
 , packages = ./packages.dhall

src/Text/Parsing/StringParser/Combinators.purs

@@ -103,14 +103,14 @@ sepEndBy1 p sep = do
       pure (cons' a as)
   ) <|> pure (NEL.singleton a)
 
--- | Parse one or more separated values, ending with a separator.
-endBy1 :: forall a sep. Parser a -> Parser sep -> Parser (NonEmptyList a)
-endBy1 p sep = many1 $ p <* sep
-
 -- | Parse zero or more separated values, ending with a separator.
 endBy :: forall a sep. Parser a -> Parser sep -> Parser (List a)
 endBy p sep = many $ p <* sep
 
+-- | Parse one or more separated values, ending with a separator.
+endBy1 :: forall a sep. Parser a -> Parser sep -> Parser (NonEmptyList a)
+endBy1 p sep = many1 $ p <* sep
+
 -- | Parse zero or more values separated by a right-associative operator.
 chainr :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
 chainr p f a = chainr1 p f <|> pure a
@@ -125,6 +125,8 @@ chainl1 p f = do
   a <- p
   chainl1' p f a
 
+-- TODO: this description is not different from the above
+-- TODO: should we even expose this function?
 -- | Parse one or more values separated by a left-associative operator.
 chainl1' :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
 chainl1' p f a =
@@ -140,6 +142,8 @@ chainr1 p f = do
   a <- p
   chainr1' p f a
 
+-- TODO: this description is not different from the above
+-- TODO: should we even expose this function?
 -- | Parse one or more values separated by a right-associative operator.
 chainr1' :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a
 chainr1' p f a =

test/BasicSpecs.purs

@@ -0,0 +1,147 @@
+module Test.BasicSpecs where
+
+import Prelude hiding (between)
+
+import Test.Utils (AnyParser(..), mkAnyParser)
+import Control.Alt ((<|>))
+import Control.Monad.Writer (Writer, execWriter, tell)
+import Data.Either (isRight)
+import Data.List (List)
+import Data.List as List
+import Data.Traversable (traverse)
+import Effect (Effect)
+import Effect.Class.Console (log)
+import Test.Assert (assert')
+import Text.Parsing.StringParser (Parser, runParser, try)
+import Text.Parsing.StringParser.CodePoints (anyChar, anyDigit, anyLetter, char, eof, skipSpaces, string)
+import Text.Parsing.StringParser.Combinators (between, chainl, chainl1, endBy, endBy1, lookAhead, many, many1, manyTill, sepBy, sepBy1, sepEndBy, sepEndBy1)
+
+type TestInputs = { successes :: Array String, failures :: Array String }
+type TestCase = { name :: String, parser :: AnyParser, inputs :: TestInputs }
+
+testCases :: Array TestCase
+testCases =
+  [ { name: "anyChar"
+    , parser: mkAnyParser anyChar
+    -- TODO: test "🙂" which should fail
+    -- this is an open upstream issue https://github.com/purescript/purescript-strings/issues/153
+    , inputs: { successes: [ "a", "%" ], failures: [ "" ] }
+    }
+  , { name: "anyLetter"
+    , parser: mkAnyParser anyLetter
+    , inputs: { successes: [ "a" ], failures: [ "9" ] }
+    }
+  , { name: "skipSpaces"
+    , parser: mkAnyParser $ skipSpaces *> anyChar
+    , inputs: { successes: [ "  9", "9" ], failures: [ "9 " ] }
+    }
+  , { name: "map"
+    , parser: mkAnyParser $ anyChar <#> const 3
+    , inputs: { successes: [ "9" ], failures: [ "" ] }
+    }
+  , { name: "applicative"
+    , parser: mkAnyParser $ (anyLetter <#> (\c -> (\c2 -> [ c, c2 ]))) <*> anyDigit
+    , inputs: { successes: [ "a9" ], failures: [ "", "-", "a", "9" ] }
+    }
+  , { name: "alt"
+    , parser: mkAnyParser $ anyLetter <|> anyDigit
+    , inputs: { successes: [ "x", "9" ], failures: [ "", "-", "aa" ] }
+    }
+  , { name: "bind"
+    , parser: mkAnyParser $ anyLetter >>= \letter -> char letter
+    , inputs: { successes: [ "xx" ], failures: [ "", "-", "a", "aaa" ] }
+    }
+  , { name: "try"
+    , parser: mkAnyParser $ try (anyLetter *> anyDigit) <|> char 'a'
+    , inputs: { successes: [ "b9", "a6", "a" ], failures: [ "", "b", "-", "6" ] }
+    }
+  , { name: "lookAhead"
+    , parser: mkAnyParser $ lookAhead (char 'a') *> anyLetter
+    , inputs: { successes: [ "a" ], failures: [ "", "b" ] }
+    }
+  , { name: "many"
+    , parser: mkAnyParser $ many (char 'a')
+    , inputs: { successes: [ "", "a", "aaaa" ], failures: [ "b" ] }
+    }
+  , { name: "many1"
+    , parser: mkAnyParser $ many1 (char 'a')
+    , inputs: { successes: [ "a", "aaaa" ], failures: [ "", "b" ] }
+    }
+  , { name: "between"
+    , parser: mkAnyParser $ between (char 'a') (char 'b') (char 'x')
+    , inputs: { successes: [ "axb" ], failures: [ "", "x", "a", "b", "ab" ] }
+    }
+  , { name: "sepBy"
+    , parser: mkAnyParser $ sepBy anyLetter (char ';')
+    , inputs: { successes: [ "", "a", "a;b", "a;b;c" ], failures: [ ";", ";a", "a;", "ab", "a;ab" ] }
+    }
+  , { name: "sepBy1"
+    , parser: mkAnyParser $ sepBy1 anyLetter (char ';')
+    , inputs: { successes: [ "a", "a;b", "a;b;c" ], failures: [ "", ";", ";a", "a;", "ab", "a;ab" ] }
+    }
+  , { name: "sepEndBy"
+    , parser: mkAnyParser $ sepEndBy anyLetter (char ';')
+    -- TODO: ";" should be parsed successfully
+    , inputs: { successes: [ "", "a", "a;b", "a;b;c", "a;" ], failures: [ ";", ";a", "ab", "a;ab" ] }
+    }
+  , { name: "sepEndBy1"
+    , parser: mkAnyParser $ sepEndBy1 anyLetter (char ';')
+    , inputs: { successes: [ "a", "a;b", "a;b;c", "a;" ], failures: [ "", ";", ";a", "ab", "a;ab" ] }
+    }
+  , { name: "endBy"
+    , parser: mkAnyParser $ endBy anyLetter (char ';')
+    -- TODO: ";" should be parsed successfully
+    , inputs: { successes: [ "", "a;", "a;b;", "a;b;c;" ], failures: [ "a", ";", ";a", "ab", "a;b", "a;b;c" ] }
+    }
+  , { name: "endBy1"
+    , parser: mkAnyParser $ endBy1 anyLetter (char ';')
+    , inputs: { successes: [ "a;", "a;b;", "a;b;c;" ], failures: [ "", ";", "a", ";a", "ab", "a;b", "a;b;c" ] }
+    }
+  , { name: "manyTill"
+    , parser: mkAnyParser $ manyTill anyLetter (char ';')
+    , inputs: { successes: [ ";", "a;", "abc;" ], failures: [ "", "a", ";a", "ab", "a;b", "a;b;c" ] }
+    }
+  , { name: "manyTill overlapping"
+    , parser: mkAnyParser $ manyTill anyLetter (char 'z')
+    , inputs: { successes: [ "z", "az", "abcz" ], failures: [ "", "a", "za", "ab", "azb", "azbzc" ] }
+    }
+  , { name: "chainl"
+    , parser: mkAnyParser $ chainl (string "x") (char '+' $> (<>)) ""
+    , inputs: { successes: [ "", "x", "x+x+x+x" ], failures: [ "+", "+x", "x+", "x+x+", "xx", "xx+" ] }
+    }
+  , { name: "chainl1"
+    , parser: mkAnyParser $ chainl1 (string "x") (char '+' $> (<>))
+    , inputs: { successes: [ "x", "x+x+x+x" ], failures: [ "", "+", "+x", "x+", "x+x+", "xx", "xx+" ] }
+    }
+  ]
+
+type TestResult = Writer (List String) Unit
+
+reportError :: String -> TestResult
+reportError = tell <<< List.singleton
+
+runTestCases :: Effect Unit
+runTestCases = do
+  let errors = execWriter $ traverse evalTestCase testCases
+  when (List.length errors > 0) do
+    _ <- traverse log errors
+    assert' "Errors found" false
+
+evalTestCase :: TestCase -> TestResult
+evalTestCase tc = do
+  _ <- traverse assertSuccess tc.inputs.successes
+  _ <- traverse assertFailure tc.inputs.failures
+  pure unit
+  where
+  assertSuccess input =
+    when (not (evalAnyParser tc.parser input)) do
+      reportError ("Expected " <> tc.name <> " to succeed on '" <> input <> "' but it failed")
+  assertFailure input =
+    when (evalAnyParser tc.parser input) do
+      reportError ("Expected " <> tc.name <> " to fail on '" <> input <> "' but it succeeded")
+
+evalAnyParser :: AnyParser -> String -> Boolean
+evalAnyParser (AnyParser anyP) input = anyP canFullyParse input
+
+canFullyParse :: forall a. Parser a -> String -> Boolean
+canFullyParse p input = isRight $ runParser (p *> eof) input

test/Main.purs

@@ -6,10 +6,14 @@ import Effect (Effect)
 import Effect.Console (log)
 import Test.CodePoints (testCodePoints)
 import Test.CodeUnits (testCodeUnits)
+import Test.BasicSpecs (runTestCases)
 
 main :: Effect Unit
 main = do
-  log "Testing CodePoint parsing\n"
+  log "Running basic spec test cases\n"
+  runTestCases
+
+  log "\n\nTesting CodePoint parsing\n"
   testCodePoints
 
   log "\n\nTesting CodeUnit parsing\n"

test/Utils.purs

@@ -0,0 +1,8 @@
+module Test.Utils where
+
+import Text.Parsing.StringParser (Parser)
+
+newtype AnyParser = AnyParser (forall r. (forall a. Parser a -> r) -> r)
+
+mkAnyParser :: forall a. Parser a -> AnyParser
+mkAnyParser p = AnyParser \f -> f p