paripari 0.4.0.0 → 0.5.0.0

raw patch · 9 files changed

+100/−35 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• example.hs +7/−6
• paripari.cabal +2/−2
• specialise-all.hs +7/−4
• src/Text/PariPari/Internal/Acceptor.hs +3/−0
• src/Text/PariPari/Internal/Class.hs +10/−0
• src/Text/PariPari/Internal/Reporter.hs +21/−7
• src/Text/PariPari/Internal/Run.hs +12/−12
• src/Text/PariPari/Internal/Tracer.hs +1/−1
• test/test.hs +37/−3

@@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} +import Data.Foldable (for_) import System.Environment (getArgs) import Text.PariPari import qualified Data.ByteString as B@@ -67,10 +68,10 @@   args <- getArgs   case args of     [file] -> do-      b <- B.readFile file-      case runCharParser json file b of-        Left report -> do-          putStrLn $ showReport report-          print $ runTracer json file b-        Right val -> print val+      src <- B.readFile file+      let (result, reports) = runCharParser json file src+      for_ reports $ putStrLn . showReport+      case result of+        Just val -> print val+        Nothing  -> print $ runTracer json file src     _ -> error "Usage: paripari-example test.json"

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 9f4767161c726109fa8849cc08f350e49f03eeef59675e9c770da1f6bd959ab8+-- hash: 3476d5605ed3319d3b575839fb866897fc42c60890869a31d03de49938e4d20d  name:           paripari-version:        0.4.0.0+version:        0.5.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. Like Attoparsec, the parser combinators backtrack by default. category:       Text

@@ -3,8 +3,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} -import System.Environment (getArgs)+import Data.Foldable (for_) import Data.Semigroup ((<>))+import System.Environment (getArgs) import Text.PariPari import qualified Data.Char as C import qualified Data.List.NonEmpty as NE@@ -191,9 +192,11 @@   case args of     [src, _, dst] -> do       code <- T.readFile src-      case runCharParser source src code of-        Left report -> putStrLn $ showReport report-        Right ls -> do+      let (result, reports) = runCharParser source src code+      for_ reports $ putStrLn . showReport+      case result of+        Nothing -> pure ()+        Just ls -> do           let specialisers = [(from, to) | SpecialiseAll from to <- ls]               specialisedTypeDecls = concatMap (specialise specialisers) [(n, t) | TypeDecl n t <- ls]           T.writeFile dst $ T.intercalate "\n" $ map showSource ls <> specialisedTypeDecls

@@ -149,6 +149,9 @@   commit p = p   {-# INLINE commit #-} +  recover p _ = p+  {-# INLINE recover #-}+   element e = Acceptor $ \env st@State{_stOff, _stLine, _stCol} ok err ->     if | _stOff < _envEnd env,          (e', w) <- elementAt @k (_envBuf env) _stOff,

@@ -87,6 +87,16 @@   -- of the parser.   commit :: p a -> p a +  -- | Parse with error recovery.+  -- If the parser p fails in `recover p r`+  -- the parser r continues at the position where p failed.+  -- If the recovering parser r fails too, the whole+  -- parser fails. The errors reported by the recovering+  -- parser are ignored in any case.+  -- Error recovery support is only available+  -- in the 'Reporter' instance.+  recover :: p a -> p a -> p a+   -- | Parse a single element   element :: Element k -> p (Element k) 

@@ -75,6 +75,7 @@   , _stErrCol    :: !Int   , _stErrCommit :: !Int   , _stErrors    :: [ErrorContext]+  , _stReports   :: [Report]   }  -- | Parser which is optimised for good error reports.@@ -192,6 +193,13 @@       raiseError env st err expectedEnd   {-# INLINE eof #-} +  recover p r = Reporter $ \env st ok err ->+    let err1 s =+          let err2 _ = err s+          in unReporter r env (addReport env s) ok err2+    in unReporter p env st ok err1+  {-# INLINE recover #-}+   element e = Reporter $ \env st@State{_stOff, _stLine, _stCol} ok err ->     if | _stOff < _envEnd env,          (e', w) <- elementAt @k (_envBuf env) _stOff,@@ -396,18 +404,23 @@   }  -- | Run 'Reporter' with additional 'ReportOptions'.-runReporterWithOptions :: Chunk k => ReportOptions -> Reporter k a -> FilePath -> k -> Either Report a+runReporterWithOptions :: Chunk k => ReportOptions -> Reporter k a -> FilePath -> k -> (Maybe a, [Report]) runReporterWithOptions o p f k =   let (b, off, len) = unpackChunk k-  in unReporter p (initialEnv o f b (off + len)) (initialState off) (\x _ -> Right x) (Left . getReport f)+      env = initialEnv o f b (off + len)+      ok x s = (Just x, reverse $ _stReports s)+      err s = (Nothing, reverse $ _stReports $ addReport env s)+  in unReporter p env (initialState off) ok err --- | 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+-- | Run 'Reporter' on the given chunk, returning the result+-- if successful and reports from error recoveries.+-- In the case of an error, 'Nothing' is returned and the 'report' list+-- is non-empty.+runReporter :: Chunk k => Reporter k a -> FilePath -> k -> (Maybe a, [Report]) runReporter = runReporterWithOptions defaultReportOptions -getReport :: FilePath -> State -> Report-getReport f s = Report f (_stErrLine s) (_stErrCol s) (_stErrors s)+addReport :: Env k -> State -> State+addReport e s = s { _stReports = Report (_envFile e) (_stErrLine s) (_stErrCol s) (_stErrors s) : _stReports s }  initialEnv :: ReportOptions -> FilePath -> Buffer k -> Int -> Env k initialEnv _envOptions _envFile _envBuf _envEnd = Env@@ -432,6 +445,7 @@   , _stErrCol    = 0   , _stErrCommit = 0   , _stErrors    = []+  , _stReports   = []   }  -- | Pretty string representation of 'Report'.

@@ -20,7 +20,7 @@ -- The 'FilePath' is used for error reporting. -- When the acceptor does not return successfully, the result from the reporter -- is awaited.-runCharParser :: CharChunk k => (forall p. CharParser k p => p a) -> FilePath -> k -> Either Report a+runCharParser :: CharChunk k => (forall p. CharParser k p => p a) -> FilePath -> k -> (Maybe a, [Report]) runCharParser = runCharParserWithOptions defaultReportOptions {-# INLINE runCharParser #-} @@ -28,35 +28,35 @@ -- The 'FilePath' is used for error reporting. -- When the acceptor does not return successfully, the result from the reporter -- is awaited.-runSeqCharParser :: CharChunk k => (forall p. CharParser k p => p a) -> FilePath -> k -> Either Report a+runSeqCharParser :: CharChunk k => (forall p. CharParser k p => p a) -> FilePath -> k -> (Maybe a, [Report]) runSeqCharParser = runSeqCharParserWithOptions defaultReportOptions {-# INLINE runSeqCharParser #-}  -- | Run parsers **in parallel** with additional 'ReportOptions'.-runCharParserWithOptions :: CharChunk k => ReportOptions -> (forall p. CharParser k p => p a) -> FilePath -> k -> Either Report a+runCharParserWithOptions :: CharChunk k => ReportOptions -> (forall p. CharParser k p => p a) -> FilePath -> k -> (Maybe a, [Report]) runCharParserWithOptions o p f b =   let a = runAcceptor p f b       r = runReporterWithOptions o p f b   in case r `par` a of        Left _  -> r-       Right x -> Right x+       Right x -> (Just x, []) {-# INLINE runCharParserWithOptions #-}  -- | Run parsers **sequentially** with additional 'ReportOptions'.-runSeqCharParserWithOptions :: CharChunk k => ReportOptions -> (forall p. CharParser k p => p a) -> FilePath -> k -> Either Report a+runSeqCharParserWithOptions :: CharChunk k => ReportOptions -> (forall p. CharParser k p => p a) -> FilePath -> k -> (Maybe a, [Report]) runSeqCharParserWithOptions o p f b =   let a = runAcceptor p f b       r = runReporterWithOptions o p f b   in case a of        Left _  -> r-       Right x -> Right x+       Right x -> (Just x, []) {-# INLINE runSeqCharParserWithOptions #-}  -- | 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.-runChunkParser :: CharChunk k => (forall p. ChunkParser k p => p a) -> FilePath -> k -> Either Report a+runChunkParser :: CharChunk k => (forall p. ChunkParser k p => p a) -> FilePath -> k -> (Maybe a, [Report]) runChunkParser = runCharParserWithOptions defaultReportOptions {-# INLINE runChunkParser #-} @@ -64,26 +64,26 @@ -- The 'FilePath' is used for error reporting. -- When the acceptor does not return successfully, the result from the reporter -- is awaited.-runSeqChunkParser :: Chunk k => (forall p. ChunkParser k p => p a) -> FilePath -> k -> Either Report a+runSeqChunkParser :: Chunk k => (forall p. ChunkParser k p => p a) -> FilePath -> k -> (Maybe a, [Report]) runSeqChunkParser = runSeqChunkParserWithOptions defaultReportOptions {-# INLINE runSeqChunkParser #-}  -- | Run parsers **in parallel** with additional 'ReportOptions'.-runChunkParserWithOptions :: Chunk k => ReportOptions -> (forall p. ChunkParser k p => p a) -> FilePath -> k -> Either Report a+runChunkParserWithOptions :: Chunk k => ReportOptions -> (forall p. ChunkParser k p => p a) -> FilePath -> k -> (Maybe a, [Report]) runChunkParserWithOptions o p f b =   let a = runAcceptor p f b       r = runReporterWithOptions o p f b   in case r `par` a of        Left _  -> r-       Right x -> Right x+       Right x -> (Just x, []) {-# INLINE runChunkParserWithOptions #-}  -- | Run parsers **sequentially** with additional 'ReportOptions'.-runSeqChunkParserWithOptions :: Chunk k => ReportOptions -> (forall p. ChunkParser k p => p a) -> FilePath -> k -> Either Report a+runSeqChunkParserWithOptions :: Chunk k => ReportOptions -> (forall p. ChunkParser k p => p a) -> FilePath -> k -> (Maybe a, [Report]) runSeqChunkParserWithOptions o p f b =   let a = runAcceptor p f b       r = runReporterWithOptions o p f b   in case a of        Left _  -> r-       Right x -> Right x+       Right x -> (Just x, []) {-# INLINE runSeqChunkParserWithOptions #-}

@@ -42,5 +42,5 @@  -- | 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 :: Chunk k => Tracer k a -> FilePath -> k -> (Maybe a, [Report]) runTracer = runReporter . unTracer

@@ -28,6 +28,11 @@ randomStringLen :: Int randomStringLen = 1000 +runReporterEither :: Chunk k => Reporter k a -> FilePath -> k -> Either [Report] a+runReporterEither p f k = case runReporter p f k of+  (Just a, []) -> Right a+  (_,      r)  -> Left r+ -- Only generate valid Unicode characters randomChar :: IO Char randomChar = do@@ -52,7 +57,7 @@ tests = testGroup "Tests"   [ testGroup "Chunk"     [ testGroup "Acceptor" $ chunkTests runAcceptor-    , testGroup "Reporter" $ chunkTests runAcceptor+    , testGroup "Reporter" $ chunkTests runReporterEither     ]    , testGroup "Char"@@ -62,10 +67,12 @@       ]      , testGroup "Reporter"-      [ testGroup "Text"       $ charTests @Text       runReporter-      , testGroup "ByteString" $ charTests @ByteString runReporter+      [ testGroup "Text"       $ charTests @Text       runReporterEither+      , testGroup "ByteString" $ charTests @ByteString runReporterEither       ]     ]++  , testGroup "Reporter specific" reporterTests   ]  charTests :: forall k p e. (CharParser k p, CharChunk k, Eq e, Show e, Show k)@@ -467,6 +474,11 @@         ok (commit $ element 'a') "abc" 'a'         err (commit $ element 'b') "abc" +    , testCase "recover" $ do+        ok (recover (element 'a' <* eof) (element 'b')) "a" 'a'+        err (recover (element 'a') (element 'b')) "c"+        err (recover (element 'a' <* eof) (element 'b')) "c"+     , testCase "element" $ do         ok (element 'a') "abc" 'a'         ok (element 'a' <* eof) "a" 'a'@@ -638,6 +650,28 @@   ok p i o = run p "filename" i @?= Right o   err :: (Eq a, Show a, HasCallStack) => p a -> Text -> Assertion   err p i = assertBool "err" $ isLeft $ run p "filename" i++reporterTests :: [TestTree]+reporterTests =+  [ testCase "recover" $ do+      run (element 'a' <* eof) "a" (Just 'a', 0)+      run (element 'a') "b" (Nothing, 1)+      run (recover (element 'a' <* eof) (element 'b')) "a" (Just 'a', 0)+      run (recover (element 'a') (element 'b')) "b" (Just 'b', 1)+      run ((,)+            <$> recover (element 'a') (element 'b')+            <*> recover (element 'a') (element 'c')) "bc" (Just ('b', 'c'), 2)+      run (recover (element 'a') (element 'b') *>+           recover (element 'a') (element 'c') *>+           element 'a') "bcd" (Nothing, 3)+      run (recover (element 'a' <* eof) (element 'b')) "c" (Nothing, 1)+  ]+  where+  run :: (Eq a, Show a, HasCallStack) => Reporter Text a -> Text -> (Maybe a, Int) -> Assertion+  run p i (o, r) = do+    let (out, rep) = runReporter p "filename" i+    out @?= o+    length rep @?= r  {- TODO: