diff --git a/paripari.cabal b/paripari.cabal --- a/paripari.cabal +++ b/paripari.cabal @@ -2,11 +2,11 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 2b6dd0a88b444dee67e31d36c8744b234a1ef0a86434d9caacc7196eba7ac3f9 +-- hash: f7e834d1be86ccea3ebb59239a70a2c711d2713ef3eba70e8000c5551906bc1c name: paripari -version: 0.2.0.0 -synopsis: Fast-path parser combinators with fallback for error reporting +version: 0.2.1.0 +synopsis: Parser combinators with fast-path and slower fallback for error reporting description: PariPari offers two parsing strategies. There is a fast Acceptor and a slower Reporter which are evaluated in parallel. If the Acceptor fails, the Reporter returns a report about the parsing errors. Unlike Parsec and like Attoparsec, the parser combinators backtrack by default. category: Text stability: experimental @@ -87,6 +87,7 @@ , bytestring >=0.10 && <0.11 , paripari , parser-combinators >=1.0 && <1.1 + , random , tasty , tasty-hunit , text >=0.11 && <1.3 diff --git a/src/Text/PariPari.hs b/src/Text/PariPari.hs --- a/src/Text/PariPari.hs +++ b/src/Text/PariPari.hs @@ -21,10 +21,14 @@ , A.runAcceptor , R.Reporter + , R.Report(..) + , R.ErrorContext(..) + , R.ReportOptions(..) , R.runReporter , R.showReport , R.showErrors , R.runReporterWithOptions + , R.defaultReportOptions , T.Tracer , T.runTracer diff --git a/src/Text/PariPari/Internal/CharCombinators.hs b/src/Text/PariPari/Internal/CharCombinators.hs --- a/src/Text/PariPari/Internal/CharCombinators.hs +++ b/src/Text/PariPari/Internal/CharCombinators.hs @@ -14,6 +14,7 @@ , char' , notChar , anyChar + , anyAsciiByte , alphaNumChar , digitChar , letterChar @@ -35,12 +36,13 @@ import Control.Applicative ((<|>), optional) import Control.Monad.Combinators (option, skipCount, skipMany) +import Data.Functor (void) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Word (Word8) import Text.PariPari.Internal.Chunk import Text.PariPari.Internal.Class import Text.PariPari.Internal.ElementCombinators (()) -import Data.Text (Text) -import Data.Functor (void) -import Data.Word (Word8) import qualified Data.Char as C type CharP k a = (forall p. CharParser k p => p a) @@ -77,6 +79,7 @@ -- Returns the integer and the number of digits. -- Bases 2 to 36 are supported. -- Digits can be separated by separator, e.g. `optional (char '_')`. +-- Signs are not parsed by this combinator. integer' :: (Num a, CharParser k p) => p sep -> Int -> p (a, Int) integer' sep base = label (integerLabel base) $ do d <- digit base @@ -91,6 +94,7 @@ -- | Parse an integer of the given base. -- Bases 2 to 36 are supported. -- Digits can be separated by separator, e.g. `optional (char '_')`. +-- Signs are not parsed by this combinator. integer :: (Num a, CharParser k p) => p sep -> Int -> p a integer sep base = label (integerLabel base) $ do d <- digit base @@ -109,14 +113,20 @@ integerLabel 16 = "hexadecimal integer" integerLabel b = "integer of base " <> show b +-- | Parses a decimal integer. +-- Signs are not parsed by this combinator. decimal :: Num a => CharP k a decimal = integer (pure ()) 10 {-# INLINE decimal #-} +-- | Parses an octal integer. +-- Signs are not parsed by this combinator. octal :: Num a => CharP k a octal = integer (pure ()) 8 {-# INLINE octal #-} +-- | Parses a hexadecimal integer. +-- Signs are not parsed by this combinator. hexadecimal :: Num a => CharP k a hexadecimal = integer (pure ()) 16 {-# INLINE hexadecimal #-} @@ -128,21 +138,29 @@ -- | Parse a fraction of arbitrary exponent base and coefficient base. -- 'fractionDec' and 'fractionHex' should be used instead probably. +-- Does not parse integers. +-- Signs are not parsed by this combinator. fraction :: (Num a, CharParser k p) => p expSep -> Int -> Int -> p digitSep -> p (a, Int, a) fraction expSep expBase coeffBasePow digitSep = do let coeffBase = expBase ^ coeffBasePow coeff <- integer digitSep coeffBase - void $ optional $ asciiByte asc_point - (frac, fracLen) <- option (0, 0) $ integer' digitSep coeffBase - expVal <- option 0 $ expSep *> signed (integer digitSep 10) - pure (coeff * fromIntegral coeffBase ^ fracLen + frac, - expBase, - expVal - fromIntegral (fracLen * coeffBasePow)) + frac <- optional $ asciiByte asc_point *> option (0, 0) (integer' digitSep coeffBase) + expn <- optional $ expSep *> signed (integer digitSep 10) + let (fracVal, fracLen) = fromMaybe (0, 0) frac + expVal = fromMaybe 0 expn + case (frac, expn) of + (Nothing, Nothing) -> failWith $ EExpected ["fraction"] + _ -> + pure (coeff * fromIntegral coeffBase ^ fracLen + fracVal, + expBase, + expVal - fromIntegral (fracLen * coeffBasePow)) {-# INLINE fraction #-} -- | Parse a decimal fraction, returning (coefficient, 10, exponent), -- corresponding to coefficient * 10^exponent. -- Digits can be separated by separator, e.g. `optional (char '_')`. +-- Does not parse integers. +-- Signs are not parsed by this combinator. fractionDec :: (Num a, CharParser k p) => p digitSep -> p (a, Int, a) fractionDec sep = fraction (asciiSatisfy (\b -> b == asc_E || b == asc_e)) 10 1 sep "fraction" {-# INLINE fractionDec #-} @@ -150,6 +168,8 @@ -- | Parse a hexadecimal fraction, returning (coefficient, 2, exponent), -- corresponding to coefficient * 2^exponent. -- Digits can be separated by separator, e.g. `optional (char '_')`. +-- Does not parse integers. +-- Signs are not parsed by this combinator. fractionHex :: (Num a, CharParser k p) => p digitSep -> p (a, Int, a) fractionHex sep = fraction (asciiSatisfy (\b -> b == asc_P || b == asc_p)) 2 4 sep "hexadecimal fraction" {-# INLINE fractionHex #-} @@ -172,6 +192,11 @@ anyChar = satisfy (const True) {-# INLINE anyChar #-} +-- | Parse an arbitrary ASCII byte. +anyAsciiByte :: CharP k Word8 +anyAsciiByte = asciiSatisfy (const True) +{-# INLINE anyAsciiByte #-} + -- | Parse an alphanumeric character, including Unicode. alphaNumChar :: CharP k Char alphaNumChar = satisfy C.isAlphaNum "alphanumeric character" @@ -215,7 +240,7 @@ -- | Parse a character beloning to the ASCII charset (< 128) asciiChar :: CharP k Char -asciiChar = unsafeAsciiToChar <$> asciiSatisfy (const True) +asciiChar = unsafeAsciiToChar <$> anyAsciiByte {-# INLINE asciiChar #-} -- | Parse a character belonging to the given Unicode category diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -5,21 +5,40 @@ {-# LANGUAGE FlexibleContexts #-} module Main (main) where +import Control.Monad (replicateM, replicateM_) import Data.ByteString (ByteString) import Data.Either (isLeft) import Data.Text (Text) import GHC.Stack (HasCallStack) import Prelude hiding (getLine) +import System.Random import Test.Tasty import Test.Tasty.HUnit import Text.PariPari import Text.PariPari.Internal.Chunk (textToChunk, asc_a, asc_0, asc_9) import qualified Data.Char as C import qualified Data.List.NonEmpty as NE +import qualified Data.Text as T main :: IO () main = defaultMain tests +randomTries :: Int +randomTries = 1000 + +randomStringLen :: Int +randomStringLen = 1000 + +randomString :: IO Text +randomString = do + n <- randomRIO (1, randomStringLen) + T.pack <$> replicateM n (randomRIO (C.chr 1, maxBound)) + +randomAsciiString :: IO Text +randomAsciiString = do + n <- randomRIO (1, randomStringLen) + T.pack <$> replicateM n (randomRIO (C.chr 1, C.chr 127)) + tests :: TestTree tests = testGroup "Tests" [ testGroup "Chunk" @@ -54,12 +73,20 @@ err (satisfy (== '\0')) "\0" err (satisfy (== '\0')) "" + , testCase "satisfy-random" $ replicateM_ randomTries $ do + s <- randomString + ok (traverse (satisfy . (==)) (T.unpack s) *> eof) s () + , testCase "char" $ do ok (char 'a') "abc" 'a' ok (char 'a' <* eof) "a" 'a' err (char 'b') "abc" err (char 'a') "" + , testCase "char-random" $ replicateM_ randomTries $ do + s <- randomString + ok (traverse char (T.unpack s) *> eof) s () + , testCase "asciiSatisfy" $ do ok (asciiSatisfy (== asc_a)) "abc" asc_a ok (asciiSatisfy (== asc_a) <* eof) "a" asc_a @@ -70,12 +97,20 @@ err (asciiSatisfy (== 0)) "\0" err (asciiSatisfy (== 0)) "" + , testCase "asciiSatisfy-random" $ replicateM_ randomTries $ do + s <- randomAsciiString + ok (traverse (asciiSatisfy . (==) . fromIntegral . C.ord) (T.unpack s) *> eof) s () + , testCase "asciiByte" $ do ok (asciiByte asc_a) "abc" asc_a ok (asciiByte asc_a <* eof) "a" asc_a ok (asciiByte 127 <* eof) "\x7F" 127 err (asciiByte asc_0) "abc" err (asciiByte asc_0) "" + + , testCase "asciiByte-random" $ replicateM_ randomTries $ do + s <- randomAsciiString + ok (traverse (asciiByte . fromIntegral . C.ord) (T.unpack s) *> eof) s () ] , testGroup "Char Combinators" @@ -84,11 +119,29 @@ err (string "bc") "abc" err (string "ab") "" + , testCase "string-random" $ replicateM_ randomTries $ do + s <- randomString + ok (string s <* eof) s s + , testCase "anyChar" $ do ok anyChar "abc" 'a' ok (anyChar <* eof) "a" 'a' err anyChar "" + , testCase "anyChar-random" $ replicateM_ randomTries $ do + s <- randomString + ok (traverse (const anyChar) (T.unpack s) *> eof) s () + + , testCase "anyAsciiByte" $ do + ok anyAsciiByte "abc" asc_a + ok (anyAsciiByte <* eof) "a" asc_a + err anyAsciiByte "" + err anyAsciiByte "\x80" + + , testCase "anyAsciiByte-random" $ replicateM_ randomTries $ do + s <- randomAsciiString + ok (traverse (const anyAsciiByte) (T.unpack s) *> eof) s () + , testCase "notChar" $ do ok (notChar 'b') "abc" 'a' ok (notChar 'b' <* eof) "a" 'a' @@ -175,6 +228,38 @@ err (digitByte 10) "" ] + , testGroup "Fraction Combinators" + [ testCase "fractionDec" $ do + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "1.23" (123, 10, -2) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "99e0" (99, 10, 0) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "123.45" (12345, 10, -2) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "00123." (123, 10, 0) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "456.000" (456000, 10, -3) + + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "987e-5" (987, 10, -5) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "987.e-123" (987, 10, -123) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "987.654e-67" (987654, 10, -70) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "987.654000e-7" (987654000, 10, -13) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "000987.654000e-7" (987654000, 10, -13) + + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "987e+5" (987, 10, 5) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "987.e+123" (987, 10, 123) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "987.654e+67" (987654, 10, 64) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "987.654000e+7" (987654000, 10, 1) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "000987.654000e+7" (987654000, 10, 1) + + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "987e5" (987, 10, 5) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "987.e123" (987, 10, 123) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "987.654e67" (987654, 10, 64) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "987.654000e7" (987654000, 10, 1) + ok @(Integer, Int, Integer) (fractionDec (pure ()) <* eof) "000987.654000e7" (987654000, 10, 1) + + err @(Integer, Int, Integer) (fractionDec (pure ())) "" + err @(Integer, Int, Integer) (fractionDec (pure ())) "123" + err @(Integer, Int, Integer) (fractionDec (pure ())) "123e" + err @(Integer, Int, Integer) (fractionDec (pure ())) "abc" + ] + , testGroup "Integer Combinators" [ testCase "decimal" $ do ok @Integer (decimal <* eof) "0123" 123 @@ -201,11 +286,11 @@ err @Integer hexadecimal "" , testCase "integer" $ do - err @Integer (integer (pure ()) 10) "abc" ok @Integer (integer (char '_') 10) "1_2_3" 123 ok @Integer (integer (char '_') 10 <* char '_') "1_2_3_" 123 - err @Integer (integer (char '_') 10) "_1_2_3" ok @Integer (integer (optional $ char '_') 10) "123_456_789" 123456789 + err @Integer (integer (pure ()) 10) "abc" + err @Integer (integer (char '_') 10) "_1_2_3" err @Integer (integer (pure ()) 10) "-1" err @Integer (integer (pure ()) 10) "" @@ -214,14 +299,18 @@ ok @Integer (integer (pure ()) 36) "XyZ" 44027 , testCase "integer'" $ do - err @(Integer, Int) (integer' (pure ()) 10) "abc" ok @(Integer, Int) (integer' (char '_') 10) "1_2_3" (123, 3) ok @(Integer, Int) (integer' (char '_') 10 <* char '_') "1_2_3_" (123, 3) - err @(Integer, Int) (integer' (char '_') 10) "_1_2_3" ok @(Integer, Int) (integer' (optional $ char '_') 10) "123_456_789" (123456789, 9) + err @(Integer, Int) (integer' (pure ()) 10) "abc" + err @(Integer, Int) (integer' (char '_') 10) "_1_2_3" err @(Integer, Int) (integer' (pure ()) 10) "-1" err @(Integer, Int) (integer' (pure ()) 10) "" + ok @(Integer, Int) (integer' (pure ()) 10) "0123" (123, 4) + ok @(Integer, Int) (integer' (pure ()) 10) "01230" (1230, 5) + ok @(Integer, Int) (integer' (pure ()) 10) "000" (0, 3) + ok @(Integer, Int) (integer' (pure ()) 2) "101" (5, 3) ok @(Integer, Int) (integer' (pure ()) 7) "321" (162, 3) ok @(Integer, Int) (integer' (pure ()) 36) "XyZ" (44027, 3) @@ -432,18 +521,19 @@ {- +TODO: +Instances: Semigroup Monoid Functor Applicative Monad MonadPlus -Alternative: - -TODO: +Alternative -Additional combinators: +Additional combinators provided by parser-combinators. +They are also tested by megaparsec: endBy1 someTill sepBy1 @@ -472,7 +562,6 @@ Fraction: fractionHex -fractionDec Char Combinators: skipChars