paripari 0.2.1.0 → 0.3.0.0
raw patch · 12 files changed
+312/−163 lines, 12 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Text.PariPari: elementSatisfy :: ChunkParser k p => (Element k -> Bool) -> p (Element k)
- Text.PariPari: satisfy :: CharParser k p => (Char -> Bool) -> p Char
- Text.PariPari.Internal.Chunk: textToChunk :: CharChunk k => Text -> k
- Text.PariPari.Internal.Class: elementSatisfy :: ChunkParser k p => (Element k -> Bool) -> p (Element k)
- Text.PariPari.Internal.Class: satisfy :: CharParser k p => (Char -> Bool) -> p Char
+ Text.PariPari: elementScan :: ChunkParser k p => (Element k -> Maybe a) -> p a
+ Text.PariPari: scan :: CharParser k p => (Char -> Maybe a) -> p a
+ Text.PariPari.Internal.Acceptor: instance Text.PariPari.Internal.Chunk.CharChunk k => Data.String.IsString (Text.PariPari.Internal.Acceptor.Acceptor k k)
+ Text.PariPari.Internal.CharCombinators: satisfy :: CharParser k p => (Char -> Bool) -> p Char
+ Text.PariPari.Internal.CharCombinators: scanCharsWhile :: CharParser k p => (s -> Char -> Maybe s) -> s -> p s
+ Text.PariPari.Internal.CharCombinators: scanCharsWhile1 :: CharParser k p => (s -> Char -> Maybe s) -> s -> p s
+ Text.PariPari.Internal.CharCombinators: sign :: (CharParser k f, Num a) => f (a -> a)
+ Text.PariPari.Internal.Chunk: stringToChunk :: CharChunk k => String -> k
+ Text.PariPari.Internal.Class: elementScan :: ChunkParser k p => (Element k -> Maybe a) -> p a
+ Text.PariPari.Internal.Class: scan :: CharParser k p => (Char -> Maybe a) -> p a
+ Text.PariPari.Internal.Class: string :: CharParser k p => String -> p k
+ Text.PariPari.Internal.ElementCombinators: elementSatisfy :: ChunkParser k p => (Element k -> Bool) -> p (Element k)
+ Text.PariPari.Internal.ElementCombinators: scanElementsWhile :: ChunkParser k p => (s -> Element k -> Maybe s) -> s -> p s
+ Text.PariPari.Internal.ElementCombinators: scanElementsWhile1 :: ChunkParser k p => (s -> Element k -> Maybe s) -> s -> p s
+ Text.PariPari.Internal.Reporter: instance Text.PariPari.Internal.Chunk.CharChunk k => Data.String.IsString (Text.PariPari.Internal.Reporter.Reporter k k)
+ Text.PariPari.Internal.Tracer: instance Text.PariPari.Internal.Chunk.CharChunk k => Data.String.IsString (Text.PariPari.Internal.Tracer.Tracer k k)
- Text.PariPari: class (ChunkParser k p, CharChunk k) => CharParser k p | p -> k
+ Text.PariPari: class (ChunkParser k p, IsString (p k), CharChunk k) => CharParser k p | p -> k
- Text.PariPari.Internal.CharCombinators: fractionDec :: (Num a, CharParser k p) => p digitSep -> p (a, Int, a)
+ Text.PariPari.Internal.CharCombinators: fractionDec :: (Num a, CharParser k p) => p digitSep -> p (Either a (a, Int, a))
- Text.PariPari.Internal.CharCombinators: fractionHex :: (Num a, CharParser k p) => p digitSep -> p (a, Int, a)
+ Text.PariPari.Internal.CharCombinators: fractionHex :: (Num a, CharParser k p) => p digitSep -> p (Either a (a, Int, a))
- Text.PariPari.Internal.CharCombinators: string :: CharParser k p => Text -> p Text
+ Text.PariPari.Internal.CharCombinators: string :: CharParser k p => String -> p k
- Text.PariPari.Internal.Class: class (ChunkParser k p, CharChunk k) => CharParser k p | p -> k
+ Text.PariPari.Internal.Class: class (ChunkParser k p, IsString (p k), CharChunk k) => CharParser k p | p -> k
Files
- example.hs +5/−3
- paripari.cabal +2/−2
- specialise-all.hs +1/−1
- src/Text/PariPari/Internal/Acceptor.hs +16/−11
- src/Text/PariPari/Internal/CharCombinators.hs +50/−28
- src/Text/PariPari/Internal/Chunk.hs +5/−5
- src/Text/PariPari/Internal/Class.hs +14/−7
- src/Text/PariPari/Internal/ElementCombinators.hs +18/−1
- src/Text/PariPari/Internal/Reporter.hs +21/−15
- src/Text/PariPari/Internal/Run.hs +4/−4
- src/Text/PariPari/Internal/Tracer.hs +4/−2
- test/test.hs +172/−84
example.hs view
@@ -53,9 +53,11 @@ number :: Parser Value number = label "number" $ do- neg <- option id $ negate <$ char '-'- (c, _, e) <- fractionDec (pure ())- pure $ Number (neg c) e+ neg <- sign+ frac <- fractionDec (pure ())+ pure $ case frac of+ Left n -> Number (neg n) 0+ Right (c, _, e) -> Number (neg c) e space :: Parser () space = skipCharsWhile (\c -> c == ' ' || c == '\n' || c == '\t')
paripari.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f7e834d1be86ccea3ebb59239a70a2c711d2713ef3eba70e8000c5551906bc1c+-- hash: 78092995723d296e73be8c5403a8bf6c7b46bece1826eb1e0841683e3252071d name: paripari-version: 0.2.1.0+version: 0.3.0.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
specialise-all.hs view
@@ -55,7 +55,7 @@ typeName :: Parser StringType typeName = asChunk (void $ sepBy1 (identifierAtom C.isUpper) (char '.')) <* space -symbol :: ParserMonad p => StringType -> p StringType+symbol :: ParserMonad p => String -> p StringType symbol s = string s <* space typeTuple :: Parser Type
src/Text/PariPari/Internal/Acceptor.hs view
@@ -15,8 +15,9 @@ ) where import Control.Monad (void)-import Text.PariPari.Internal.Class+import Data.String (IsString(..)) import Text.PariPari.Internal.Chunk+import Text.PariPari.Internal.Class import qualified Control.Monad.Fail as Fail data Env k = Env@@ -154,15 +155,15 @@ err $ ECombinator "element" {-# INLINE element #-} - elementSatisfy f = Acceptor $ \env st@State{_stOff, _stLine, _stCol} ok err ->+ elementScan f = Acceptor $ \env st@State{_stOff, _stLine, _stCol} ok err -> if | _stOff < _envEnd env, (e, w) <- elementAt @k (_envBuf env) _stOff,- f e,+ Just r <- f e, pos <- elementPos @k e (Pos _stLine _stCol) ->- ok e st { _stOff = _stOff + w, _stLine = _posLine pos, _stCol = _posColumn pos }+ ok r st { _stOff = _stOff + w, _stLine = _posLine pos, _stCol = _posColumn pos } | otherwise ->- err $ ECombinator "elementSatisfy"- {-# INLINE elementSatisfy #-}+ err $ ECombinator "elementScan"+ {-# INLINE elementScan #-} chunk k = Acceptor $ \env st@State{_stOff,_stCol} ok err -> let n = chunkWidth @k k@@ -182,18 +183,18 @@ {-# INLINE asChunk #-} instance CharChunk k => CharParser k (Acceptor k) where- satisfy f = Acceptor $ \env st@State{_stOff, _stLine, _stCol} ok err ->+ scan f = Acceptor $ \env st@State{_stOff, _stLine, _stCol} ok err -> if | (c, w) <- charAt @k (_envBuf env) _stOff, c /= '\0',- f c ->- ok c st+ Just r <- f c ->+ ok r st { _stOff = _stOff + w , _stLine = if c == '\n' then _stLine + 1 else _stLine , _stCol = if c == '\n' then 1 else _stCol + 1 } | otherwise ->- err $ ECombinator "satisfy"- {-# INLINE satisfy #-}+ err $ ECombinator "scan"+ {-# INLINE scan #-} -- By inling this combinator, GHC should figure out the `charWidth` -- of the character resulting in an optimised decoder.@@ -238,6 +239,10 @@ else err $ ECombinator "asciiByte" {-# INLINE asciiByte #-}++instance CharChunk k => IsString (Acceptor k k) where+ fromString = string+ {-# INLINE fromString #-} -- | Reader monad, get something from the environment get :: (Env k -> State -> a) -> Acceptor k a
src/Text/PariPari/Internal/CharCombinators.hs view
@@ -8,6 +8,7 @@ , octal , hexadecimal , digit+ , sign , signed , fractionHex , fractionDec@@ -25,12 +26,15 @@ , punctuationChar , spaceChar , asciiChar+ , satisfy , skipChars , takeChars , skipCharsWhile , takeCharsWhile , skipCharsWhile1 , takeCharsWhile1+ , scanCharsWhile+ , scanCharsWhile1 , string ) where @@ -38,7 +42,6 @@ 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@@ -131,46 +134,56 @@ hexadecimal = integer (pure ()) 16 {-# INLINE hexadecimal #-} +-- | Parse plus or minus sign+sign :: (CharParser k f, Num a) => f (a -> a)+sign = (negate <$ asciiByte asc_minus) <|> (id <$ optional (asciiByte asc_plus))+{-# INLINE sign #-}+ -- | Parse a number with a plus or minus sign. signed :: (Num a, CharParser k p) => p a -> p a-signed p = ($) <$> ((id <$ asciiByte asc_plus) <|> (negate <$ asciiByte asc_minus) <|> pure id) <*> p+signed p = ($) <$> sign <*> p {-# INLINE signed #-} --- | Parse a fraction of arbitrary exponent base and coefficient base.+fractionExp :: (Num a, CharParser k p) => p expSep -> p digitSep -> p (Maybe a)+fractionExp expSep digitSep = do+ e <- optional expSep+ case e of+ Nothing{} -> pure Nothing+ Just{} -> Just <$> signed (integer digitSep 10)+{-# INLINE fractionExp #-}++-- | Parse a fraction of arbitrary exponent base and mantissa base. -- 'fractionDec' and 'fractionHex' should be used instead probably.--- Does not parse integers.+-- Returns either an integer in 'Left' or a fraction in 'Right'. -- 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- frac <- optional $ asciiByte asc_point *> option (0, 0) (integer' digitSep coeffBase)- expn <- optional $ expSep *> signed (integer digitSep 10)+fraction :: (Num a, CharParser k p) => p expSep -> Int -> Int -> p digitSep -> p (Either a (a, Int, a))+fraction expSep expBase mantBasePow digitSep = do+ let mantBase = expBase ^ mantBasePow+ mant <- integer digitSep mantBase+ frac <- optional $ asciiByte asc_point *> option (0, 0) (integer' digitSep mantBase)+ expn <- fractionExp expSep digitSep 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))+ pure $ case (frac, expn) of+ (Nothing, Nothing) -> Left mant+ _ -> Right ( mant * fromIntegral mantBase ^ fracLen + fracVal+ , expBase+ , expVal - fromIntegral (fracLen * mantBasePow)) {-# INLINE fraction #-} --- | Parse a decimal fraction, returning (coefficient, 10, exponent),--- corresponding to coefficient * 10^exponent.+-- | Parse a decimal fraction, e.g., 123.456e-78, returning (mantissa, 10, exponent),+-- corresponding to mantissa * 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 :: (Num a, CharParser k p) => p digitSep -> p (Either a (a, Int, a)) fractionDec sep = fraction (asciiSatisfy (\b -> b == asc_E || b == asc_e)) 10 1 sep <?> "fraction" {-# INLINE fractionDec #-} --- | Parse a hexadecimal fraction, returning (coefficient, 2, exponent),--- corresponding to coefficient * 2^exponent.+-- | Parse a hexadecimal fraction, e.g., co.ffeep123, returning (mantissa, 2, exponent),+-- corresponding to mantissa * 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 :: (Num a, CharParser k p) => p digitSep -> p (Either a (a, Int, a)) fractionHex sep = fraction (asciiSatisfy (\b -> b == asc_P || b == asc_p)) 2 4 sep <?> "hexadecimal fraction" {-# INLINE fractionHex #-} @@ -285,7 +298,16 @@ takeCharsWhile1 f = asChunk (skipCharsWhile1 f) {-# INLINE takeCharsWhile1 #-} --- | Parse a string-string :: CharParser k p => Text -> p Text-string t = t <$ chunk (textToChunk t)-{-# INLINE string #-}+-- | Parse a single character with the given predicate+satisfy :: CharParser k p => (Char -> Bool) -> p Char+satisfy f = scan $ \c -> if f c then Just c else Nothing+{-# INLINE satisfy #-}++scanCharsWhile :: CharParser k p => (s -> Char -> Maybe s) -> s -> p s+scanCharsWhile f = go+ where go s = (scan (f s) >>= go) <|> pure s+{-# INLINE scanCharsWhile #-}++scanCharsWhile1 :: CharParser k p => (s -> Char -> Maybe s) -> s -> p s+scanCharsWhile1 f s = scan (f s) >>= scanCharsWhile f+{-# INLINE scanCharsWhile1 #-}
src/Text/PariPari/Internal/Chunk.hs view
@@ -55,7 +55,7 @@ charAt :: Buffer k -> Int -> (Char, Int) charAtFixed :: Int -> Buffer k -> Int -> Char charWidth :: Char -> Int- textToChunk :: Text -> k+ stringToChunk :: String -> k instance Chunk ByteString where type Element ByteString = Word8@@ -99,8 +99,8 @@ charAtFixed = ptrDecodeFixedUtf8 {-# INLINE charAtFixed #-} - textToChunk t = T.encodeUtf8 t- {-# INLINE textToChunk #-}+ stringToChunk t = T.encodeUtf8 $ fromString t+ {-# INLINE stringToChunk #-} instance Chunk Text where type Element Text = Char@@ -144,8 +144,8 @@ charAtFixed n b i = fst $ arrayCharAt n b i {-# INLINE charAtFixed #-} - textToChunk t = t- {-# INLINE textToChunk #-}+ stringToChunk t = fromString t+ {-# INLINE stringToChunk #-} arrayByteAt :: T.Array -> Int -> Word8 arrayByteAt a i
src/Text/PariPari/Internal/Class.hs view
@@ -10,12 +10,14 @@ , showError , expectedEnd , unexpectedEnd+ , string ) where import Control.Applicative (Alternative(empty, (<|>))) import Control.Monad (MonadPlus(..)) import Control.Monad.Fail (MonadFail(..)) import Data.List (intercalate)+import Data.String (IsString) import Data.Word (Word8) import GHC.Generics (Generic) import Text.PariPari.Internal.Chunk@@ -87,8 +89,8 @@ -- | Parse a single element element :: Element k -> p (Element k) - -- | Parse a single byte with the given predicate- elementSatisfy :: (Element k -> Bool) -> p (Element k)+ -- | Scan a single byte+ elementScan :: (Element k -> Maybe a) -> p a -- | Parse a chunk of elements. The chunk must not -- contain multiple lines, otherwise the position information@@ -99,18 +101,18 @@ -- result as buffer asChunk :: p () -> p k -class (ChunkParser k p, CharChunk k) => CharParser k p | p -> k where+class (ChunkParser k p, IsString (p k), CharChunk k) => CharParser k p | p -> k where -- | Parse a single character -- -- __Note__: The character '\0' cannot be parsed using this combinator -- since it is used as decoding sentinel. Use 'element' instead. char :: Char -> p Char - -- | Parse a single character with the given predicate+ -- | Scan a single character -- -- __Note__: The character '\0' cannot be parsed using this combinator- -- since it is used as decoding sentinel. Use 'elementSatisfy' instead.- satisfy :: (Char -> Bool) -> p Char+ -- since it is used as decoding sentinel. Use 'elementScan' instead.+ scan :: (Char -> Maybe a) -> p a -- | Parse a single character within the ASCII charset --@@ -133,10 +135,15 @@ showError (ECombinator name) = "Combinator " <> name <> " failed" showError (EIndentNotAligned rc c) = "Invalid alignment, expected column " <> show rc <> " expected, got " <> show c showError (EIndentOverLine rl l) = "Indentation over line, expected line " <> show rl <> ", got " <> show l-showError (ENotEnoughIndent rc c) = "Not enough indentation, expected column " <> show rc <> ", got " <> show c+showError (ENotEnoughIndent rc c) = "Must be indented deeper than column " <> show rc <> ", got column " <> show c expectedEnd :: Error expectedEnd = EExpected ["end of file"] unexpectedEnd :: Error unexpectedEnd = EUnexpected "end of file"++-- | Parse a string+string :: CharParser k p => String -> p k+string t = chunk (stringToChunk t)+{-# INLINE string #-}
src/Text/PariPari/Internal/ElementCombinators.hs view
@@ -48,12 +48,15 @@ , linefold , notElement , anyElement+ , elementSatisfy , takeElements , skipElements , skipElementsWhile , takeElementsWhile , skipElementsWhile1 , takeElementsWhile1+ , scanElementsWhile+ , scanElementsWhile1 ) where import Control.Applicative ((<|>), empty)@@ -61,8 +64,8 @@ import Control.Monad.Combinators (skipCount, skipMany) import Data.Functor (void) import Prelude hiding (getLine)-import Text.PariPari.Internal.Class import Text.PariPari.Internal.Chunk+import Text.PariPari.Internal.Class import qualified Control.Monad.Combinators as O import qualified Control.Monad.Combinators.NonEmpty as ON @@ -182,3 +185,17 @@ takeElementsWhile1 :: ChunkParser k p => (Element k -> Bool) -> p k takeElementsWhile1 f = asChunk (skipElementsWhile1 f) {-# INLINE takeElementsWhile1 #-}++-- | Parse a single byte with the given predicate+elementSatisfy :: ChunkParser k p => (Element k -> Bool) -> p (Element k)+elementSatisfy f = elementScan $ \e -> if f e then Just e else Nothing+{-# INLINE elementSatisfy #-}++scanElementsWhile :: ChunkParser k p => (s -> Element k -> Maybe s) -> s -> p s+scanElementsWhile f = go+ where go s = (elementScan (f s) >>= go) <|> pure s+{-# INLINE scanElementsWhile #-}++scanElementsWhile1 :: ChunkParser k p => (s -> Element k -> Maybe s) -> s -> p s+scanElementsWhile1 f s = elementScan (f s) >>= scanElementsWhile f+{-# INLINE scanElementsWhile1 #-}
src/Text/PariPari/Internal/Reporter.hs view
@@ -28,6 +28,7 @@ import Data.Function (on) import Data.List (intercalate, sort, group, sortOn) import Data.List.NonEmpty (NonEmpty(..))+import Data.String (IsString(..)) import GHC.Generics (Generic) import Text.PariPari.Internal.Chunk import Text.PariPari.Internal.Class@@ -197,17 +198,17 @@ raiseError env st err $ EExpected [showElement @k e] {-# INLINE element #-} - elementSatisfy f = Reporter $ \env st@State{_stOff, _stLine, _stCol} ok err ->+ elementScan f = Reporter $ \env st@State{_stOff, _stLine, _stCol} ok err -> let (e, w) = elementAt @k (_envBuf env) _stOff in if | _stOff >= _envEnd env -> raiseError env st err unexpectedEnd | _stOff < _envEnd env,- f e,+ Just r <- f e, pos <- elementPos @k e (Pos _stLine _stCol) ->- ok e st { _stOff =_stOff + w, _stLine = _posLine pos, _stCol = _posColumn pos }+ ok r st { _stOff =_stOff + w, _stLine = _posLine pos, _stCol = _posColumn pos } | otherwise -> raiseError env st err $ EUnexpected $ showElement @k e- {-# INLINE elementSatisfy #-}+ {-# INLINE elementScan #-} chunk k = Reporter $ \env st@State{_stOff,_stCol} ok err -> let n = chunkWidth @k k@@ -227,22 +228,23 @@ {-# INLINE asChunk #-} instance CharChunk k => CharParser k (Reporter k) where- satisfy f = Reporter $ \env st@State{_stOff, _stLine, _stCol} ok err ->+ scan f = Reporter $ \env st@State{_stOff, _stLine, _stCol} ok err -> if | (c, w) <- charAt @k (_envBuf env) _stOff, c /= '\0' ->- if f c then- ok c st- { _stOff = _stOff + w- , _stLine = if c == '\n' then _stLine + 1 else _stLine- , _stCol = if c == '\n' then 1 else _stCol + 1- }- else- raiseError env st err $ EUnexpected $ show c+ case f c of+ Just r ->+ ok r st+ { _stOff = _stOff + w+ , _stLine = if c == '\n' then _stLine + 1 else _stLine+ , _stCol = if c == '\n' then 1 else _stCol + 1+ }+ Nothing ->+ raiseError env st err $ EUnexpected $ show c | _stOff >= _envEnd env -> raiseError env st err unexpectedEnd | otherwise -> raiseError env st err EInvalidUtf8- {-# INLINE satisfy #-}+ {-# INLINE scan #-} -- By inling this combinator, GHC should figure out the `charWidth` -- of the character resulting in an optimised decoder.@@ -290,6 +292,10 @@ raiseError env st err $ EExpected [showByte b] {-# INLINE asciiByte #-} +instance CharChunk k => IsString (Reporter k k) where+ fromString = string+ {-# INLINE fromString #-}+ raiseError :: Env k -> State -> (State -> b) -> Error -> b raiseError env st err e = err $ addError env st e {-# INLINE raiseError #-}@@ -391,7 +397,7 @@ let (b, off, len) = unpackChunk k in unReporter p (initialEnv o f b (off + len)) (initialState off) (\x _ -> Right x) (Left . getReport f) --- | Run 'Reporter' on the given 'ByteString', returning either+-- | Run 'Reporter' on the given chunk, returning either -- an error 'Report' or, if successful, the result. runReporter :: Chunk k => Reporter k a -> FilePath -> k -> Either Report a runReporter = runReporterWithOptions defaultReportOptions
src/Text/PariPari/Internal/Run.hs view
@@ -16,7 +16,7 @@ import Text.PariPari.Internal.Reporter import GHC.Conc (par) --- | Run fast 'Acceptor' and slower 'Reporter' on the given 'ByteString' **in parallel**.+-- | Run fast 'Acceptor' and slower 'Reporter' on the given chunk **in parallel**. -- The 'FilePath' is used for error reporting. -- When the acceptor does not return successfully, the result from the reporter -- is awaited.@@ -24,7 +24,7 @@ runCharParser = runCharParserWithOptions defaultReportOptions {-# INLINE runCharParser #-} --- | Run fast 'Acceptor' and slower 'Reporter' on the given 'ByteString' **sequentially**.+-- | Run fast 'Acceptor' and slower 'Reporter' on the given chunk **sequentially**. -- The 'FilePath' is used for error reporting. -- When the acceptor does not return successfully, the result from the reporter -- is awaited.@@ -52,7 +52,7 @@ Right x -> Right x {-# INLINE runSeqCharParserWithOptions #-} --- | Run fast 'Acceptor' and slower 'Reporter' on the given 'ByteString' **in parallel**.+-- | Run fast 'Acceptor' and slower 'Reporter' on the given chunk **in parallel**. -- The 'FilePath' is used for error reporting. -- When the acceptor does not return successfully, the result from the reporter -- is awaited.@@ -60,7 +60,7 @@ runChunkParser = runCharParserWithOptions defaultReportOptions {-# INLINE runChunkParser #-} --- | Run fast 'Acceptor' and slower 'Reporter' on the given 'ByteString' **sequentially**.+-- | Run fast 'Acceptor' and slower 'Reporter' on the given chunk **sequentially**. -- The 'FilePath' is used for error reporting. -- When the acceptor does not return successfully, the result from the reporter -- is awaited.
src/Text/PariPari/Internal/Tracer.hs view
@@ -9,9 +9,10 @@ , runTracer ) where +import Data.String (IsString) import Debug.Trace (trace)-import Text.PariPari.Internal.Class import Text.PariPari.Internal.Chunk+import Text.PariPari.Internal.Class import Text.PariPari.Internal.Reporter import qualified Control.Monad.Fail as Fail @@ -21,6 +22,7 @@ deriving instance CharChunk k => ChunkParser k (Tracer k) deriving instance CharChunk k => CharParser k (Tracer k)+deriving instance CharChunk k => IsString (Tracer k k) instance Chunk k => Alternative (Tracer k) where empty = Tracer empty@@ -37,7 +39,7 @@ next in unReporter (unTracer p1) env st ok err' --- | Run 'Tracer' on the given 'ByteString', returning either+-- | Run 'Tracer' on the given chunk, returning either -- an error 'Report' or, if successful, the result. runTracer :: Chunk k => Tracer k a -> FilePath -> k -> Either Report a runTracer = runReporter . unTracer
test/test.hs view
@@ -15,10 +15,9 @@ import Test.Tasty import Test.Tasty.HUnit import Text.PariPari-import Text.PariPari.Internal.Chunk (textToChunk, asc_a, asc_0, asc_9)+import Text.PariPari.Internal.Chunk (stringToChunk, 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@@ -29,15 +28,25 @@ randomStringLen :: Int randomStringLen = 1000 -randomString :: IO Text+-- Only generate valid Unicode characters+randomChar :: IO Char+randomChar = do+ c <- randomIO+ let n = C.ord c+ if n == 0 || (n >= 0xD800 && n <= 0xDFFF) || n > 0x10FFFF then+ randomChar+ else+ pure c++randomString :: IO String randomString = do n <- randomRIO (1, randomStringLen)- T.pack <$> replicateM n (randomRIO (C.chr 1, maxBound))+ replicateM n randomChar -randomAsciiString :: IO Text+randomAsciiString :: IO String randomAsciiString = do n <- randomRIO (1, randomStringLen)- T.pack <$> replicateM n (randomRIO (C.chr 1, C.chr 127))+ replicateM n (randomRIO (C.chr 1, C.chr 127)) tests :: TestTree tests = testGroup "Tests"@@ -59,25 +68,11 @@ ] ] -charTests :: forall k p e. (CharParser k p, CharChunk k, Eq e, Show e)+charTests :: forall k p e. (CharParser k p, CharChunk k, Eq e, Show e, Show k) => (forall a. p a -> FilePath -> k -> Either e a) -> [TestTree] charTests run = [ testGroup "CharParser" $- [ testCase "satisfy" $ do- ok (satisfy (== 'a')) "abc" 'a'- ok (satisfy (== 'a') <* eof) "a" 'a'- err (satisfy (== 'b')) "abc"- err (satisfy (== 'a')) ""-- -- because of sentinel- 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+ [ testCase "char" $ do ok (char 'a') "abc" 'a' ok (char 'a' <* eof) "a" 'a' err (char 'b') "abc"@@ -85,7 +80,7 @@ , testCase "char-random" $ replicateM_ randomTries $ do s <- randomString- ok (traverse char (T.unpack s) *> eof) s ()+ ok (traverse char s *> eof) s () , testCase "asciiSatisfy" $ do ok (asciiSatisfy (== asc_a)) "abc" asc_a@@ -99,7 +94,7 @@ , testCase "asciiSatisfy-random" $ replicateM_ randomTries $ do s <- randomAsciiString- ok (traverse (asciiSatisfy . (==) . fromIntegral . C.ord) (T.unpack s) *> eof) s ()+ ok (traverse (asciiSatisfy . (==) . fromIntegral . C.ord) s *> eof) s () , testCase "asciiByte" $ do ok (asciiByte asc_a) "abc" asc_a@@ -110,18 +105,32 @@ , testCase "asciiByte-random" $ replicateM_ randomTries $ do s <- randomAsciiString- ok (traverse (asciiByte . fromIntegral . C.ord) (T.unpack s) *> eof) s ()+ ok (traverse (asciiByte . fromIntegral . C.ord) s *> eof) s () ] , testGroup "Char Combinators"- [ testCase "string" $ do- ok (string "ab") "abc" "ab"+ [ testCase "satisfy" $ do+ ok (satisfy (== 'a')) "abc" 'a'+ ok (satisfy (== 'a') <* eof) "a" 'a'+ err (satisfy (== 'b')) "abc"+ err (satisfy (== 'a')) ""++ -- because of sentinel+ err (satisfy (== '\0')) "\0"+ err (satisfy (== '\0')) ""++ , testCase "satisfy-random" $ replicateM_ randomTries $ do+ s <- randomString+ ok (traverse (satisfy . (==)) s *> eof) s ()++ , testCase "string" $ do+ ok (string "ab") "abc" (stringToChunk "ab") err (string "bc") "abc" err (string "ab") "" , testCase "string-random" $ replicateM_ randomTries $ do s <- randomString- ok (string s <* eof) s s+ ok (string s <* eof) s (stringToChunk s) , testCase "anyChar" $ do ok anyChar "abc" 'a'@@ -130,7 +139,7 @@ , testCase "anyChar-random" $ replicateM_ randomTries $ do s <- randomString- ok (traverse (const anyChar) (T.unpack s) *> eof) s ()+ ok (traverse (const anyChar) s *> eof) s () , testCase "anyAsciiByte" $ do ok anyAsciiByte "abc" asc_a@@ -140,7 +149,7 @@ , testCase "anyAsciiByte-random" $ replicateM_ randomTries $ do s <- randomAsciiString- ok (traverse (const anyAsciiByte) (T.unpack s) *> eof) s ()+ ok (traverse (const anyAsciiByte) s *> eof) s () , testCase "notChar" $ do ok (notChar 'b') "abc" 'a'@@ -226,38 +235,77 @@ ok (digitByte 10 <* eof) "9" asc_9 err (digitByte 10) "\0" err (digitByte 10) ""++ , testCase "skipChars" $ do+ ok (skipChars 0) "" ()+ ok (skipChars 3 <* eof) "abc" ()+ ok (skipChars 3 <* char 'b') "aaab" ()+ err (skipChars 1) ""+ err (skipChars 2) "a"++ , testCase "takeChars" $ do+ ok (takeChars 0) "" (stringToChunk "")+ ok (takeChars 3 <* eof) "abc" (stringToChunk "abc")+ ok (takeChars 3 <* char 'b') "aaab" (stringToChunk "aaa")+ err (takeChars 1) ""+ err (takeChars 2) "a"++ , testCase "skipCharsWhile" $ do+ ok (skipCharsWhile (== 'a')) "" ()+ ok (skipCharsWhile (== 'a')) "b" ()+ ok (skipCharsWhile (== 'a') *> eof) "aaa" ()+ ok (skipCharsWhile (== 'a') *> char 'b') "aaab" 'b'++ , testCase "takeCharsWhile" $ do+ ok (takeCharsWhile (== 'a')) "" (stringToChunk "")+ ok (takeCharsWhile (== 'a')) "b" (stringToChunk "")+ ok (takeCharsWhile (== 'a') <* eof) "aaa" (stringToChunk "aaa")+ ok (takeCharsWhile (== 'a') <* char 'b') "aaab" (stringToChunk "aaa")++ , testCase "skipCharsWhile1" $ do+ err (skipCharsWhile1 (== 'a')) ""+ err (skipCharsWhile1 (== 'a')) "b"+ ok (skipCharsWhile1 (== 'a') *> eof) "aaa" ()+ ok (skipCharsWhile1 (== 'a') *> char 'b') "aaab" 'b'++ , testCase "takeCharsWhile1" $ do+ err (takeCharsWhile1 (== 'a')) ""+ err (takeCharsWhile1 (== 'a')) "b"+ ok (takeCharsWhile1 (== 'a') <* eof) "aaa" (stringToChunk "aaa")+ ok (takeCharsWhile1 (== 'a') <* char 'b') "aaab" (stringToChunk "aaa") ] , 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)+ okFraction (fractionDec (pure ()) <* eof) "1.23" (Right (123, 10, -2))+ okFraction (fractionDec (pure ()) <* eof) "99e0" (Right (99, 10, 0))+ okFraction (fractionDec (pure ()) <* eof) "123.45" (Right (12345, 10, -2))+ okFraction (fractionDec (pure ()) <* eof) "00123." (Right (123, 10, 0))+ okFraction (fractionDec (pure ()) <* eof) "456.000" (Right (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)+ okFraction (fractionDec (pure ()) <* eof) "987e-5" (Right (987, 10, -5))+ okFraction (fractionDec (pure ()) <* eof) "987.e-123" (Right (987, 10, -123))+ okFraction (fractionDec (pure ()) <* eof) "987.654e-67" (Right (987654, 10, -70))+ okFraction (fractionDec (pure ()) <* eof) "987.654000e-7" (Right (987654000, 10, -13))+ okFraction (fractionDec (pure ()) <* eof) "000987.654000e-7" (Right (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)+ okFraction (fractionDec (pure ()) <* eof) "987e+5" (Right (987, 10, 5))+ okFraction (fractionDec (pure ()) <* eof) "987.e+123" (Right (987, 10, 123))+ okFraction (fractionDec (pure ()) <* eof) "987.654e+67" (Right (987654, 10, 64))+ okFraction (fractionDec (pure ()) <* eof) "987.654000e+7" (Right (987654000, 10, 1))+ okFraction (fractionDec (pure ()) <* eof) "000987.654000e+7" (Right (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)+ okFraction (fractionDec (pure ()) <* eof) "987e5" (Right (987, 10, 5))+ okFraction (fractionDec (pure ()) <* eof) "987.e123" (Right (987, 10, 123))+ okFraction (fractionDec (pure ()) <* eof) "987.654e67" (Right (987654, 10, 64))+ okFraction (fractionDec (pure ()) <* eof) "987.654000e7" (Right (987654000, 10, 1))+ okFraction (fractionDec (pure ()) <* eof) "000987.654000e7" (Right (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"+ okFraction (fractionDec (pure ())) "123" (Left 123)++ errFraction (fractionDec (pure ())) "123e"+ errFraction (fractionDec (pure ())) ""+ errFraction (fractionDec (pure ())) "abc" ] , testGroup "Integer Combinators"@@ -331,10 +379,14 @@ ] ] where- ok :: (Eq a, Show a, HasCallStack) => p a -> Text -> a -> Assertion- ok p i o = run p "filename" (textToChunk @k i) @?= Right o- err :: (Eq a, Show a, HasCallStack) => p a -> Text -> Assertion- err p i = assertBool "err" $ isLeft $ run p "filename" (textToChunk @k i)+ ok :: (Eq a, Show a, HasCallStack) => p a -> String -> a -> Assertion+ ok p i o = run p "filename" (stringToChunk @k i) @?= Right o+ err :: (Eq a, Show a, HasCallStack) => p a -> String -> Assertion+ err p i = assertBool "err" $ isLeft $ run p "filename" (stringToChunk @k i)+ errFraction :: HasCallStack => p (Either Integer (Integer, Int, Integer)) -> String -> Assertion+ errFraction = err+ okFraction :: HasCallStack => p (Either Integer (Integer, Int, Integer)) -> String -> Either Integer (Integer, Int, Integer) -> Assertion+ okFraction = ok chunkTests :: forall p e. (ChunkParser Text p, Eq e, Show e) => (forall a. p a -> FilePath -> Text -> Either e a) -> [TestTree]@@ -395,17 +447,6 @@ ok (commit $ element 'a') "abc" 'a' err (commit $ element 'b') "abc" - , testCase "elementSatisfy" $ do- ok (elementSatisfy (== 'a')) "abc" 'a'- ok (elementSatisfy (== 'a') <* eof) "a" 'a'- err (elementSatisfy (== 'b')) "abc"- err (elementSatisfy (== 'a')) ""-- -- sentinel- ok (elementSatisfy (== '\0')) "\0" '\0'- ok (elementSatisfy (== '\0') <* eof) "\0" '\0'- err (elementSatisfy (== '\0')) ""- , testCase "element" $ do ok (element 'a') "abc" 'a' ok (element 'a' <* eof) "a" 'a'@@ -469,7 +510,18 @@ ] , testGroup "Element Combinators"- [ testCase "anyElement" $ do+ [ testCase "elementSatisfy" $ do+ ok (elementSatisfy (== 'a')) "abc" 'a'+ ok (elementSatisfy (== 'a') <* eof) "a" 'a'+ err (elementSatisfy (== 'b')) "abc"+ err (elementSatisfy (== 'a')) ""++ -- sentinel+ ok (elementSatisfy (== '\0')) "\0" '\0'+ ok (elementSatisfy (== '\0') <* eof) "\0" '\0'+ err (elementSatisfy (== '\0')) ""++ , testCase "anyElement" $ do ok anyElement "abc" 'a' err anyElement "" @@ -477,6 +529,44 @@ ok (notElement 'b') "abc" 'a' err (notElement 'a') "a" err (notElement 'a') ""++ , testCase "takeElementsWhile" $ do+ ok (takeElementsWhile (== 'a')) "" ""+ ok (takeElementsWhile (== 'a')) "b" ""+ ok (takeElementsWhile (== 'a') <* eof) "aaa" "aaa"+ ok (takeElementsWhile (== 'a') <* element 'b') "aaab" "aaa"++ , testCase "skipElements" $ do+ ok (skipElements 0) "" ()+ ok (skipElements 3 <* eof) "abc" ()+ ok (skipElements 3 <* element 'b') "aaab" ()+ err (skipElements 1) ""+ err (skipElements 2) "a"++ , testCase "takeElements" $ do+ ok (takeElements 0) "" ""+ ok (takeElements 3 <* eof) "abc" "abc"+ ok (takeElements 3 <* element 'b') "aaab" "aaa"+ err (takeElements 1) ""+ err (takeElements 2) "a"++ , testCase "skipElementsWhile" $ do+ ok (skipElementsWhile (== 'a')) "" ()+ ok (skipElementsWhile (== 'a')) "b" ()+ ok (skipElementsWhile (== 'a') *> eof) "aaa" ()+ ok (skipElementsWhile (== 'a') *> element 'b') "aaab" 'b'++ , testCase "skipElementsWhile1" $ do+ err (skipElementsWhile1 (== 'a')) ""+ err (skipElementsWhile1 (== 'a')) "b"+ ok (skipElementsWhile1 (== 'a') *> eof) "aaa" ()+ ok (skipElementsWhile1 (== 'a') *> element 'b') "aaab" 'b'++ , testCase "takeElementsWhile1" $ do+ err (takeElementsWhile1 (== 'a')) ""+ err (takeElementsWhile1 (== 'a')) "b"+ ok (takeElementsWhile1 (== 'a') <* eof) "aaa" "aaa"+ ok (takeElementsWhile1 (== 'a') <* element 'b') "aaab" "aaa" ] , testGroup "MonadFail"@@ -519,7 +609,6 @@ err :: (Eq a, Show a, HasCallStack) => p a -> Text -> Assertion err p i = assertBool "err" $ isLeft $ run p "filename" i - {- TODO: @@ -561,21 +650,20 @@ linefold Fraction:+fraction fractionHex -Char Combinators:-skipChars-takeChars-skipCharsWhile-takeCharsWhile-skipCharsWhile1-takeCharsWhile1+CharParser:+scan +ChunkParser:+elementScan+ Element Combinators:-takeElements-skipElements-skipElementsWhile-takeElementsWhile-skipElementsWhile1-takeElementsWhile1+scanElementsWhile+scanElementsWhile1++Char Combinators:+scanCharsWhile+scanCharsWhile1 -}