@@ -1,23 +1,26 @@
11module Main (main) where
22
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+
316import qualified Streamly.Internal.Data.Parser.ParserD as P
417import qualified Streamly.Internal.Data.Stream.IsStream as S
518import qualified Streamly.Internal.Data.Fold as FL
6−
7−-- import Data.List (partition)
8−
9−import Test.Hspec(Spec, hspec, describe)
19+import qualified Streamly.Internal.Memory.Array as A
20+import qualified Prelude
1021import 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)
1522
16−import Test.QuickCheck.Monadic (monadicIO, PropertyM, assert, monitor)
17−import Control.Exception (SomeException(..))
18−import Control.Monad.IO.Class (MonadIO(..))
19−import Control.Monad (when)
20−import Data.List ((\\))
23+import Prelude hiding (sequence)
2124
2225maxTestCount :: Int
2326maxTestCount = 100
@@ -467,7 +470,7 @@ many_empty =
467470 Left _ -> property False)
468471
469472some :: Property
470−some =
473+some =
471474 forAll (listOf (chooseInt (0, 1))) $ \genLs ->
472475 let
473476 ls = 0 : genLs
@@ -479,16 +482,151 @@ some =
479482 Left _ -> False
480483
481484someFail :: Property
482−someFail =
485+someFail =
483486 property (case S.parseD (P.some FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
484487 Right _ -> False
485488 Left _ -> True)
486489
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+
487616main :: IO ()
488617main =
489618 hspec $
490619 H.parallel $
491620 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+
492630 describe "test for accumulator" $ do
493631 prop "P.fromFold FL.sum = FL.sum" fromFold
494632 prop "P.any = Prelude.any" Main.any