c3dcabc · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add instances and parseMany tests for ParserD

c3dcabcHarendra Kumar6 years ago

src/Streamly/Internal/Data/Stream/IsStream.hs+10

compare with master

unifiedsplit

@@ -276,6 +276,7 @@ module Streamly.Internal.Data.Stream.IsStream

276

277 -- ** Parsing

278 , parseMany

279+ , parseManyD

279 , parseManyTill

280 , parseManyTill

280 , parseIterate

281 , parseIterate

281

282

@@ -3487,6 +3488,15 @@ parseMany

3487parseMany p m =

3488parseMany p m =

3488 D.fromStreamD $ D.parseMany (PRK.fromParserK p) (D.toStreamD m)

3489 D.fromStreamD $ D.parseMany (PRK.fromParserK p) (D.toStreamD m)

3489

3490

3491+{-# INLINE parseManyD #-}

3492+parseManyD

3493+ :: (IsStream t, MonadThrow m)

3494+ => PRD.Parser m a b

3495+ -> t m a

3496+ -> t m b

3497+parseManyD p m =

3498+ D.fromStreamD $ D.parseMany p (D.toStreamD m)

3499+

3490-- | @parseManyTill collect test stream@ tries the parser @test@ on the input,

3500-- | @parseManyTill collect test stream@ tries the parser @test@ on the input,

3491-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds

3501-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds

3492-- @test@ is tried again and so on. The parser stops when @test@ succeeds. The

3502-- @test@ is tried again and so on. The parser stops when @test@ succeeds. The

test/Streamly/Test/Internal/Data/Parser/ParserD.hs+153−15

@@ -1,23 +1,26 @@

1module Main (main) where

3+import Control.Exception (SomeException(..))

4+import Control.Monad (when)

5+import Control.Monad.IO.Class (MonadIO(..))

6+import Data.List ((\\))

7+import Data.Word (Word8, Word32, Word64)

8+import Test.Hspec (Spec, hspec, describe)

9+import Test.Hspec.QuickCheck

10+import Test.QuickCheck

11+ (arbitrary, forAll, choose, chooseAny, elements, Property,

12+ property, listOf, vectorOf, counterexample, (.&&.), Gen)

13+import Test.QuickCheck.Monadic

14+ (monadicIO, PropertyM, assert, monitor, run)

15+

3import qualified Streamly.Internal.Data.Parser.ParserD as P

16import qualified Streamly.Internal.Data.Parser.ParserD as P

4import qualified Streamly.Internal.Data.Stream.IsStream as S

17import qualified Streamly.Internal.Data.Stream.IsStream as S

5import qualified Streamly.Internal.Data.Fold as FL

18import qualified Streamly.Internal.Data.Fold as FL

6−

19+import qualified Streamly.Internal.Memory.Array as A

7−-- import Data.List (partition)

20+import qualified Prelude

8−

9−import Test.Hspec(Spec, hspec, describe)

10import qualified Test.Hspec as H

21import qualified Test.Hspec as H

11−import Test.Hspec.QuickCheck

12−import Test.QuickCheck (arbitrary, forAll, choose, elements, Property,

13− property, listOf, vectorOf, counterexample,

14− (.&&.), Gen)

16−import Test.QuickCheck.Monadic (monadicIO, PropertyM, assert, monitor)

23+import Prelude hiding (sequence)

17−import Control.Exception (SomeException(..))

18−import Control.Monad.IO.Class (MonadIO(..))

19−import Control.Monad (when)

20−import Data.List ((\\))

22maxTestCount :: Int

25maxTestCount :: Int

23maxTestCount = 100

26maxTestCount = 100

@@ -467,7 +470,7 @@ many_empty =

467 Left _ -> property False)

470 Left _ -> property False)

468

471

469some :: Property

472some :: Property

470−some =

473+some =

471 forAll (listOf (chooseInt (0, 1))) $ \genLs ->

474 forAll (listOf (chooseInt (0, 1))) $ \genLs ->

472 let

475 let

473 ls = 0 : genLs

476 ls = 0 : genLs

@@ -479,16 +482,151 @@ some =

479 Left _ -> False

482 Left _ -> False

480

483

481someFail :: Property

484someFail :: Property

482−someFail =

485+someFail =

483 property (case S.parseD (P.some FL.toList (P.die "die")) (S.fromList [1 :: Int]) of

486 property (case S.parseD (P.some FL.toList (P.die "die")) (S.fromList [1 :: Int]) of

484 Right _ -> False

487 Right _ -> False

485 Left _ -> True)

488 Left _ -> True)

486

489

490+-------------------------------------------------------------------------------

491+-- Instances

492+-------------------------------------------------------------------------------

493+

494+applicative :: Property

495+applicative =

496+ forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->

497+ forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->

498+ let parser =

499+ (,)

500+ <$> P.take (length list1) FL.toList

501+ <*> P.take (length list2) FL.toList

502+ in monadicIO $ do

503+ (olist1, olist2) <-

504+ run $ S.parseD parser (S.fromList $ list1 ++ list2)

505+ listEquals (==) olist1 list1

506+ listEquals (==) olist2 list2

507+

508+sequence :: Property

509+sequence =

510+ forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->

511+ let parsers = fmap (\xs -> P.take (length xs) FL.toList) ins

512+ in monadicIO $ do

513+ outs <- run $

514+ S.parseD

515+ (Prelude.sequence parsers)

516+ (S.fromList $ concat ins)

517+ listEquals (==) outs ins

518+

519+monad :: Property

520+monad =

521+ forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->

522+ forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->

523+ let parser = do

524+ olist1 <- P.take (length list1) FL.toList

525+ olist2 <- P.take (length list2) FL.toList

526+ return (olist1, olist2)

527+ in monadicIO $ do

528+ (olist1, olist2) <-

529+ run $ S.parseD parser (S.fromList $ list1 ++ list2)

530+ listEquals (==) olist1 list1

531+ listEquals (==) olist2 list2

532+

533+-------------------------------------------------------------------------------

534+-- Stream parsing

535+-------------------------------------------------------------------------------

536+

537+parseMany :: Property

538+parseMany =

539+ forAll (chooseInt (1,100)) $ \len ->

540+ forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->

541+ monadicIO $ do

542+ outs <-

543+ ( run

544+ $ S.toList

545+ $ S.parseManyD

546+ (P.take len FL.toList) (S.fromList $ concat ins)

547+ )

548+ listEquals (==) outs ins

549+

550+-------------------------------------------------------------------------------

551+-- Test for a particular case hit during fs events testing

552+-------------------------------------------------------------------------------

553+

554+evId :: [Word8]

555+evId = [96,238,17,9,0,0,0,0]

556+

557+evFlags :: [Word8]

558+evFlags = [0,4,1,0,0,0,0,0]

559+

560+evPathLen :: [Word8]

561+evPathLen = [71,0,0,0,0,0,0,0]

562+

563+evPath :: [Word8]

564+evPath =

565+ [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109

566+ ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112

567+ ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116

568+ ,114,101,97,109,108,121,47,116,109,112,47,122,122

569+ ]

570+

571+event :: [Word8]

572+event = evId ++ evFlags ++ evPathLen ++ evPath

573+

574+data Event = Event

575+ { eventId :: Word64

576+ , eventFlags :: Word32

577+ , eventAbsPath :: A.Array Word8

578+ } deriving (Show, Ord, Eq)

579+

580+readOneEvent :: P.Parser IO Word8 Event

581+readOneEvent = do

582+ arr <- P.takeEQ 24 (A.writeN 24)

583+ let arr1 = A.unsafeCast arr :: A.Array Word64

584+ eid = A.unsafeIndex arr1 0

585+ eflags = A.unsafeIndex arr1 1

586+ pathLen = fromIntegral $ A.unsafeIndex arr1 2

587+ path <- P.takeEQ pathLen (A.writeN pathLen)

588+ return $ Event

589+ { eventId = eid

590+ , eventFlags = fromIntegral eflags

591+ , eventAbsPath = path

592+ }

593+

594+parseMany2Events :: Property

595+parseMany2Events =

596+ monadicIO $ do

597+ xs <-

598+ ( run

599+ $ S.toList

600+ $ S.parseManyD readOneEvent

601+ $ S.fromList (concat (replicate 2 event))

602+ )

603+ assert (length xs == 2)

604+ -- XXX assuming little endian machine

605+ let ev = Event

606+ { eventId = 152170080

607+ , eventFlags = 66560

608+ , eventAbsPath = A.fromList evPath

609+ }

610+ in listEquals (==) xs (replicate 2 ev)

611+

612+-------------------------------------------------------------------------------

613+-- Main

614+-------------------------------------------------------------------------------

615+

487main :: IO ()

616main :: IO ()

488main =

617main =

489 hspec $

618 hspec $

490 H.parallel $

619 H.parallel $

491 modifyMaxSuccess (const maxTestCount) $ do

620 modifyMaxSuccess (const maxTestCount) $ do

621+ describe "Instances" $ do

622+ prop "applicative" applicative

623+ prop "monad" monad

624+ prop "sequence" sequence

625+

626+ describe "Stream parsing" $ do

627+ prop "parseMany" parseMany

628+ prop "parseMany2Events" parseMany2Events

629+

492 describe "test for accumulator" $ do

630 describe "test for accumulator" $ do

493 prop "P.fromFold FL.sum = FL.sum" fromFold

631 prop "P.fromFold FL.sum = FL.sum" fromFold

494 prop "P.any = Prelude.any" Main.any

632 prop "P.any = Prelude.any" Main.any