Add basic spec tests

CHANGELOG.md

@@ -9,6 +9,8 @@ Breaking changes:
 New features:
 
 Bugfixes:
+- Do not export `chainl'` and `chainr'` helper functions (#84 by @chtenb)
+- Fix semantics of endBy and sepEndBy parser combinators (#84 by @chtenb)
 - Issue #69: Fix regex parser to always wrap pattern inside `^(..)` (#80 by @chtenb)
 
 Other improvements:

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
@@ -20,14 +19,17 @@ import Text.Parsing.StringParser (Parser, runParser)
 import Text.Parsing.StringParser.CodePoints as StringParser.CodePoints
 import Text.Parsing.StringParser.CodeUnits as StringParser.CodeUnits
 
-string23 :: String
-string23 = "23"
-
-string23_2 :: String
-string23_2 = fold $ replicate 2 string23
+string23_100 :: String
+string23_100 = fold $ replicate 100 "23"
 
 string23_10000 :: String
-string23_10000 = fold $ replicate 10000 string23
+string23_10000 = fold $ replicate 100 string23_100
+
+parse23AnyCharPoints :: Parser (List Char)
+parse23AnyCharPoints = manyRec StringParser.CodePoints.anyChar
+
+parse23AnyCharUnits :: Parser (List Char)
+parse23AnyCharUnits = manyRec StringParser.CodeUnits.anyChar
 
 parse23DigitPoints :: Parser (List Char)
 parse23DigitPoints = manyRec StringParser.CodePoints.anyDigit
@@ -45,14 +47,17 @@ 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
-  -- log $ show $ runParser string23_2 parse23
-  -- log $ show $ Regex.match pattern23 string23_2
-  -- log $ show $ runParser stringSkidoo_2 parseSkidoo
-  -- log $ show $ Regex.match patternSkidoo stringSkidoo_2
+  log "StringParser.runParser parse23AnyCharPoints"
+  benchWith 20
+    $ \_ -> runParser parse23AnyCharPoints string23_10000
+  log "StringParser.runParser parse23AnyCharUnits"
+  benchWith 200
+    $ \_ -> runParser parse23AnyCharUnits string23_10000
+
   log "StringParser.runParser parse23DigitPoints"
   benchWith 20
     $ \_ -> runParser parse23DigitPoints string23_10000

spago.dhall

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

src/Text/Parsing/StringParser/Combinators.purs

@@ -18,9 +18,7 @@ module Text.Parsing.StringParser.Combinators
   , chainr
   , chainl
   , chainl1
-  , chainl1'
   , chainr1
-  , chainr1'
   , choice
   , manyTill
   , many1Till
@@ -91,7 +89,7 @@ sepBy1 p sep = do
 
 -- | Parse zero or more separated values, optionally ending with a separator.
 sepEndBy :: forall a sep. Parser a -> Parser sep -> Parser (List a)
-sepEndBy p sep = map NEL.toList (sepEndBy1 p sep) <|> pure Nil
+sepEndBy p sep = (sepEndBy1 p sep <#> NEL.toList) <|> (sep $> Nil) <|> pure Nil
 
 -- | Parse one or more separated values, optionally ending with a separator.
 sepEndBy1 :: forall a sep. Parser a -> Parser sep -> Parser (NonEmptyList a)
@@ -103,14 +101,14 @@ sepEndBy1 p sep = do
       pure (cons' a as)
   ) <|> pure (NEL.singleton a)
 
+-- | Parse zero or more separated values, ending with a separator.
+endBy :: forall a sep. Parser a -> Parser sep -> Parser (List a)
+endBy p sep = (endBy1 p sep <#> NEL.toList) <|> (sep $> Nil)
+
 -- | 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 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,7 +123,6 @@ chainl1 p f = do
   a <- p
   chainl1' p f a
 
--- | 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 =
   ( do
@@ -140,7 +137,6 @@ chainr1 p f = do
   a <- p
   chainr1' p f a
 
--- | 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 =
   ( do

test/BasicSpecs.purs

@@ -0,0 +1,145 @@
+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 ';')
+    , 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 ';')
+    , 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