diff --git a/README.md b/README.md index 33b2e9e..bf6e7d1 100644 --- a/README.md +++ b/README.md @@ -7,7 +7,7 @@ A parsing library for parsing strings. -This library is a simpler, faster alternative to `purescript-parsing`, for when you know your input will be a string. +This library is a simpler alternative to `purescript-parsing`, for when you know your input will be a string. ## Installation diff --git a/spago.dhall b/spago.dhall index eb70145..649e992 100644 --- a/spago.dhall +++ b/spago.dhall @@ -2,7 +2,6 @@ , dependencies = [ "arrays" , "assert" - , "bifunctors" , "console" , "control" , "effect" diff --git a/test/BasicSpecs.purs b/test/BasicSpecs.purs index 051c089..cc4bb26 100644 --- a/test/BasicSpecs.purs +++ b/test/BasicSpecs.purs @@ -4,150 +4,157 @@ import Prelude hiding (between) import Control.Alt ((<|>)) import Control.Monad.Writer (Writer, execWriter, tell) -import Data.Either (isRight) +import Data.Either (Either(..), isLeft, isRight) import Data.List (List) import Data.List as List import Data.Maybe (fromJust) import Data.String (CodePoint, codePointAt) +import Data.String.CodePoints (drop) import Data.Traversable (traverse) import Effect (Effect) import Effect.Class.Console (log) import Partial.Unsafe (unsafePartial) +import StringParser (Parser, anyChar, anyCodePoint, anyDigit, anyLetter, between, chainl, chainl1, char, codePoint, endBy, endBy1, eof, lookAhead, many, many1, many1Till, manyTill, optionMaybe, runParser, sepBy, sepBy1, sepEndBy, sepEndBy1, skipSpaces, string, try, tryAhead) import Test.Assert (assert') import Test.Utils (AnyParser(..), mkAnyParser) -import StringParser (Parser, anyChar, anyCodePoint, anyDigit, anyLetter, between, chainl, chainl1, char, codePoint, endBy, endBy1, eof, lookAhead, many, many1, many1Till, manyTill, optionMaybe, runParser, sepBy, sepBy1, sepEndBy, sepEndBy1, skipSpaces, string, try, tryAhead) -type TestInputs = { successes :: Array String, failures :: Array String } -type TestCase = { name :: String, parser :: AnyParser, inputs :: TestInputs } +data PartialSuccessTestCase = P String String -- input unconsumed +type TestCases = + { successes :: Array String -- Assert string fully consumed and parser returned success + , failures :: Array String -- Assert nothing consumed and parser returned failure + , partials :: Array PartialSuccessTestCase -- Assert unconsumed substring and parser returned failure + } + +type ParserSpec = { name :: String, parser :: AnyParser, inputs :: TestCases } codePointLiteral :: String -> CodePoint codePointLiteral s = unsafePartial $ fromJust $ codePointAt 0 s -testCases :: Array TestCase +testCases :: Array ParserSpec testCases = [ { name: "anyChar" , parser: mkAnyParser anyChar - , inputs: { successes: [ "a", "%" ], failures: [ "", "aa", "🙂" ] } + , inputs: { successes: [ "a", "%" ], failures: [ "", "🙂" ], partials: [ P "aa" "a" ] } } , { name: "many anyChar" , parser: mkAnyParser $ many anyChar - , inputs: { successes: [ "", "a", "%", "aa" ], failures: [ "🙂" ] } + , inputs: { successes: [ "", "a", "%", "aa" ], failures: [ "🙂" ], partials: [] } } , { name: "anyCodePoint" , parser: mkAnyParser anyCodePoint - , inputs: { successes: [ "a", "%", "🙂" ], failures: [ "", "aa" ] } + , inputs: { successes: [ "a", "%", "🙂" ], failures: [ "" ], partials: [ P "aa" "a" ] } } , { name: "codePoint" , parser: mkAnyParser $ codePoint $ codePointLiteral "🙂" - , inputs: { successes: [ "🙂" ], failures: [ "", "a", "aa" ] } + , inputs: { successes: [ "🙂" ], failures: [ "", "a", "aa" ], partials: [] } } , { name: "anyLetter" , parser: mkAnyParser anyLetter - , inputs: { successes: [ "a" ], failures: [ "9" ] } + , inputs: { successes: [ "a" ], failures: [ "9" ], partials: [ P "aa" "a" ] } } , { name: "skipSpaces" , parser: mkAnyParser $ skipSpaces *> anyChar - , inputs: { successes: [ " 9", "9" ], failures: [ "9 " ] } + , inputs: { successes: [ " 9", "9" ], failures: [], partials: [ P "9 " " " ] } } , { name: "map" , parser: mkAnyParser $ anyChar <#> const 3 - , inputs: { successes: [ "9" ], failures: [ "" ] } + , inputs: { successes: [ "9" ], failures: [ "" ], partials: [] } } , { name: "applicative" , parser: mkAnyParser $ (anyLetter <#> (\c -> (\c2 -> [ c, c2 ]))) <*> anyDigit - , inputs: { successes: [ "a9" ], failures: [ "", "-", "a", "9" ] } + , inputs: { successes: [ "a9" ], failures: [ "", "-", "a", "9" ], partials: [] } } , { name: "alt" , parser: mkAnyParser $ anyLetter <|> anyDigit - , inputs: { successes: [ "x", "9" ], failures: [ "", "-", "aa" ] } + , inputs: { successes: [ "x", "9" ], failures: [ "", "-" ], partials: [ P "aa" "a", P "a6" "6" ] } } , { name: "bind" , parser: mkAnyParser $ anyLetter >>= \letter -> char letter - , inputs: { successes: [ "xx" ], failures: [ "", "-", "a", "aaa" ] } + , inputs: { successes: [ "xx" ], failures: [ "", "-", "a" ], partials: [ P "aaa" "a" ] } } , { name: "try" , parser: mkAnyParser $ try (anyLetter *> anyDigit) <|> char 'a' - , inputs: { successes: [ "b9", "a6", "a" ], failures: [ "", "b", "-", "6" ] } + , inputs: { successes: [ "b9", "a6", "a" ], failures: [ "", "b", "-", "6" ], partials: [] } } , { name: "lookAhead" , parser: mkAnyParser $ lookAhead (char 'a') *> anyLetter - , inputs: { successes: [ "a" ], failures: [ "", "b", "ab" ] } + , inputs: { successes: [ "a" ], failures: [ "", "b" ], partials: [ P "ab" "b" ] } } , { name: "tryAhead" , parser: mkAnyParser $ tryAhead (char 'a' *> anyDigit) *> (anyChar *> anyChar) <|> (anyDigit *> anyDigit) - , inputs: { successes: [ "a6", "66" ], failures: [ "", "b", "-", "6", "aa", "a6aa", "aa66" ] } + , inputs: { successes: [ "a6", "66" ], failures: [ "", "b", "-", "6", "aa", "aa66" ], partials: [ P "a6aa" "aa" ] } } , { name: "many" , parser: mkAnyParser $ many (char 'a') - , inputs: { successes: [ "", "a", "aaaa" ], failures: [ "b" ] } + , inputs: { successes: [ "", "a", "aaaa" ], failures: [ "b" ], partials: [] } } , { name: "many no consumption" , parser: mkAnyParser $ many (eof) - , inputs: { successes: [ "" ], failures: [ "b" ] } + , inputs: { successes: [ "" ], failures: [ "b" ], partials: [] } } , { name: "many1" , parser: mkAnyParser $ many1 (char 'a') - , inputs: { successes: [ "a", "aaaa" ], failures: [ "", "b" ] } + , inputs: { successes: [ "a", "aaaa" ], failures: [ "", "b" ], partials: [] } } , { name: "many1 no consumption" , parser: mkAnyParser $ many1 (eof) - , inputs: { successes: [ "" ], failures: [ "b" ] } + , inputs: { successes: [ "" ], failures: [ "b" ], partials: [] } } , { name: "manyTill" , parser: mkAnyParser $ manyTill anyLetter (char ';') - , inputs: { successes: [ ";", "a;", "abc;" ], failures: [ "", "a", ";a", "ab", "a;b", "a;b;c" ] } + , inputs: { successes: [ ";", "a;", "abc;" ], failures: [ "", "a", "ab" ], partials: [ P ";a" "a", P "a;b" "b", P "a;b;c" "b;c" ] } } , { name: "manyTill no consumption" , parser: mkAnyParser $ manyTill (optionMaybe (char 'a')) (char ';') - , inputs: { successes: [ ";", "a;", "aaa;" ], failures: [ "", "a", ";a", "ab", "a;b", "a;b;c" ] } + , inputs: { successes: [ ";", "a;", "aaa;" ], failures: [ "", "a", "aa" ], partials: [ P ";a" "a", P "a;a" "a", P "a;a;a" "a;a" ] } } , { name: "manyTill overlapping" , parser: mkAnyParser $ manyTill anyLetter (char 'z') - , inputs: { successes: [ "z", "az", "abcz" ], failures: [ "", "a", "za", "ab", "azb", "azbzc" ] } + , inputs: { successes: [ "z", "az", "abcz" ], failures: [ "", "a", "za", "ab" ], partials: [ P "azb" "b", P "azbzc" "bzc" ] } } , { name: "many1Till" , parser: mkAnyParser $ many1Till anyLetter (char ';') - , inputs: { successes: [ "a;", "abc;" ], failures: [ "", ";", "a", ";a", "ab", "a;b", "a;b;c" ] } + , inputs: { successes: [ "a;", "abc;" ], failures: [ "", ";", "a", ";a", "ab" ], partials: [ P "a;b" "b", P "a;b;c" "b;c" ] } } , { name: "many1Till overlapping" , parser: mkAnyParser $ many1Till anyLetter (char 'z') - , inputs: { successes: [ "az", "abcz" ], failures: [ "", "z", "a", "za", "ab", "azb", "azbzc" ] } + , inputs: { successes: [ "az", "abcz" ], failures: [ "", "z", "a", "za", "ab" ], partials: [ P "azb" "b", P "azbzc" "bzc" ] } } , { name: "between" , parser: mkAnyParser $ between (char 'a') (char 'b') (char 'x') - , inputs: { successes: [ "axb" ], failures: [ "", "x", "a", "b", "ab" ] } + , inputs: { successes: [ "axb" ], failures: [ "", "x", "a", "b", "ab" ], partials: [] } } , { name: "sepBy" , parser: mkAnyParser $ sepBy anyLetter (char ';') - , inputs: { successes: [ "", "a", "a;b", "a;b;c" ], failures: [ ";", ";a", "a;", "ab", "a;ab" ] } + , inputs: { successes: [ "", "a", "a;b", "a;b;c" ], failures: [ ";", ";a", "a;", "ab", "a;ab" ], partials: [] } } , { name: "sepBy1" , parser: mkAnyParser $ sepBy1 anyLetter (char ';') - , inputs: { successes: [ "a", "a;b", "a;b;c" ], failures: [ "", ";", ";a", "a;", "ab", "a;ab" ] } + , inputs: { successes: [ "a", "a;b", "a;b;c" ], failures: [ "", ";", ";a", "a;", "ab", "a;ab" ], partials: [] } } , { name: "sepEndBy" , parser: mkAnyParser $ sepEndBy anyLetter (char ';') - , inputs: { successes: [ "", ";", "a", "a;b", "a;b;c", "a;" ], failures: [ ";a", "ab", "a;ab" ] } + , inputs: { successes: [ "", ";", "a", "a;b", "a;b;c", "a;" ], failures: [ ";a", "ab", "a;ab" ], partials: [] } } , { name: "sepEndBy1" , parser: mkAnyParser $ sepEndBy1 anyLetter (char ';') - , inputs: { successes: [ "a", "a;b", "a;b;c", "a;" ], failures: [ "", ";", ";a", "ab", "a;ab" ] } + , inputs: { successes: [ "a", "a;b", "a;b;c", "a;" ], failures: [ "", ";", ";a", "ab", "a;ab" ], partials: [] } } , { name: "endBy" , parser: mkAnyParser $ endBy anyLetter (char ';') - , inputs: { successes: [ ";", "a;", "a;b;", "a;b;c;" ], failures: [ "", "a", ";a", "ab", "a;b", "a;b;c" ] } + , inputs: { successes: [ ";", "a;", "a;b;", "a;b;c;" ], failures: [ "", "a", ";a", "ab", "a;b", "a;b;c" ], partials: [] } } , { name: "endBy1" , parser: mkAnyParser $ endBy1 anyLetter (char ';') - , inputs: { successes: [ "a;", "a;b;", "a;b;c;" ], failures: [ "", ";", "a", ";a", "ab", "a;b", "a;b;c" ] } + , inputs: { successes: [ "a;", "a;b;", "a;b;c;" ], failures: [ "", ";", "a", ";a", "ab", "a;b", "a;b;c" ], partials: [] } } , { name: "chainl" , parser: mkAnyParser $ chainl (string "x") (char '+' $> (<>)) "" - , inputs: { successes: [ "", "x", "x+x+x+x" ], failures: [ "+", "+x", "x+", "x+x+", "xx", "xx+" ] } + , inputs: { successes: [ "", "x", "x+x+x+x" ], failures: [ "+", "+x", "x+", "x+x+", "xx", "xx+" ], partials: [] } } , { name: "chainl1" , parser: mkAnyParser $ chainl1 (string "x") (char '+' $> (<>)) - , inputs: { successes: [ "x", "x+x+x+x" ], failures: [ "", "+", "+x", "x+", "x+x+", "xx", "xx+" ] } + , inputs: { successes: [ "x", "x+x+x+x" ], failures: [ "", "+", "+x", "x+", "x+x+", "xx", "xx+" ], partials: [] } } ] @@ -163,21 +170,30 @@ runTestCases = do _ <- traverse log errors assert' "Errors found" false -evalTestCase :: TestCase -> TestResult +evalTestCase :: ParserSpec -> TestResult evalTestCase tc = do _ <- traverse assertSuccess tc.inputs.successes _ <- traverse assertFailure tc.inputs.failures + _ <- traverse assertPartial tc.inputs.partials 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") + when (isLeft (evalAnyParser tc.parser input)) do + reportError ("Expected " <> tc.name <> " to succeed on " <> input <> " but it failed") + assertFailure input = assertPartial (P input input) + assertPartial (P input expectedUnconsumed) = + case evalAnyParser tc.parser input of + Left unconsumed -> when (unconsumed /= expectedUnconsumed) do + reportError ("Expected " <> tc.name <> " to fail on " <> input <> " and consume " <> showUnconsumed expectedUnconsumed <> " but it consumed " <> showUnconsumed unconsumed) + where + showUnconsumed s = if s == "" then "everything" else if s == input then "nothing" else "until " <> s <> " " + Right _ -> + reportError ("Expected " <> tc.name <> " to fail on " <> input <> " but it succeeded") -evalAnyParser :: AnyParser -> String -> Boolean +evalAnyParser :: AnyParser -> String -> Either String Unit evalAnyParser (AnyParser anyP) input = anyP canFullyParse input -canFullyParse :: forall a. Parser a -> String -> Boolean -canFullyParse p input = isRight $ runParser (p *> eof) input +canFullyParse :: forall a. Parser a -> String -> Either String Unit +canFullyParse p input = case runParser (p *> eof) input of + Left { pos } -> Left $ drop pos input + Right _ -> Right unit