packages feed

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 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 -}