@@ -1,22 +1,25 @@
11module Main (main) where
22
3+import Control.Exception (SomeException(..), displayException)
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, elements, Property, property, listOf,
12+ vectorOf, counterexample, Gen, chooseAny)
13+import Test.QuickCheck.Monadic (monadicIO, PropertyM, assert, monitor, run)
14+
15+import Prelude hiding (sequence)
16+
317import qualified Streamly.Internal.Data.Parser as P
418import qualified Streamly.Internal.Data.Stream.IsStream as S
519import qualified Streamly.Internal.Data.Fold as FL
6−
7−-- import Data.List (partition)
8−
9−import Test.Hspec(Spec, hspec, describe)
20+import qualified Streamly.Internal.Memory.Array as A
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, Gen)
14−
15−import Test.QuickCheck.Monadic (monadicIO, PropertyM, assert, monitor)
16−import Control.Exception (SomeException(..), displayException)
17−import Control.Monad.IO.Class (MonadIO(..))
18−import Control.Monad (when)
19−import Data.List ((\\))
22+import qualified Prelude
2023
2124maxTestCount :: Int
2225maxTestCount = 100
@@ -451,7 +454,7 @@ sliceSepByMax =
451454-- Left _ -> True)
452455
453456many :: Property
454−many =
457+many =
455458 forAll (listOf (chooseInt (0, 1))) $ \ls ->
456459 let
457460 concatFold = FL.Fold (\concatList curr_list -> return $ concatList ++ curr_list) (return []) return
@@ -462,13 +465,13 @@ many =
462465 Left _ -> property False
463466
464467-- many_empty :: Property
465−-- many_empty =
468+-- many_empty =
466469-- property (case S.parse (P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
467470-- Right res_list -> checkListEqual res_list ([] :: [Int])
468471-- Left _ -> property False)
469472
470473some :: Property
471−some =
474+some =
472475 forAll (listOf (chooseInt (0, 1))) $ \genLs ->
473476 let
474477 ls = 0 : genLs
@@ -480,16 +483,152 @@ some =
480483 Left _ -> False
481484
482485-- someFail :: Property
483−-- someFail =
486+-- someFail =
484487-- property (case S.parse (P.some FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
485488-- Right _ -> False
486489-- Left _ -> True)
487490
491+-------------------------------------------------------------------------------
492+-- Instances
493+-------------------------------------------------------------------------------
494+
495+applicative :: Property
496+applicative =
497+ forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
498+ forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
499+ let parser =
500+ (,)
501+ <$> P.take (length list1) FL.toList
502+ <*> P.take (length list2) FL.toList
503+ in monadicIO $ do
504+ (olist1, olist2) <-
505+ run $ S.parse parser (S.fromList $ list1 ++ list2)
506+ listEquals (==) olist1 list1
507+ listEquals (==) olist2 list2
508+
509+sequence :: Property
510+sequence =
511+ forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->
512+ let parsers = fmap (\xs -> P.take (length xs) FL.toList) ins
513+ in monadicIO $ do
514+ outs <- run $
515+ S.parse
516+ (Prelude.sequence parsers)
517+ (S.fromList $ concat ins)
518+ listEquals (==) outs ins
519+
520+monad :: Property
521+monad =
522+ forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
523+ forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
524+ let parser = do
525+ olist1 <- P.take (length list1) FL.toList
526+ olist2 <- P.take (length list2) FL.toList
527+ return (olist1, olist2)
528+ in monadicIO $ do
529+ (olist1, olist2) <-
530+ run $ S.parse parser (S.fromList $ list1 ++ list2)
531+ listEquals (==) olist1 list1
532+ listEquals (==) olist2 list2
533+
534+-------------------------------------------------------------------------------
535+-- Stream parsing
536+-------------------------------------------------------------------------------
537+
538+parseMany :: Property
539+parseMany =
540+ forAll (chooseInt (1,100)) $ \len ->
541+ forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
542+ monadicIO $ do
543+ outs <-
544+ ( run
545+ $ S.toList
546+ $ S.parseMany
547+ (P.take len FL.toList) (S.fromList $ concat ins)
548+ )
549+ listEquals (==) outs ins
550+
551+-------------------------------------------------------------------------------
552+-- Test for a particular case hit during fs events testing
553+-------------------------------------------------------------------------------
554+
555+evId :: [Word8]
556+evId = [96,238,17,9,0,0,0,0]
557+
558+evFlags :: [Word8]
559+evFlags = [0,4,1,0,0,0,0,0]
560+
561+evPathLen :: [Word8]
562+evPathLen = [71,0,0,0,0,0,0,0]
563+
564+evPath :: [Word8]
565+evPath =
566+ [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109
567+ ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112
568+ ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116
569+ ,114,101,97,109,108,121,47,116,109,112,47,122,122
570+ ]
571+
572+event :: [Word8]
573+event = evId ++ evFlags ++ evPathLen ++ evPath
574+
575+data Event = Event
576+ { eventId :: Word64
577+ , eventFlags :: Word32
578+ , eventAbsPath :: A.Array Word8
579+ } deriving (Show, Ord, Eq)
580+
581+readOneEvent :: P.Parser IO Word8 Event
582+readOneEvent = do
583+ arr <- P.takeEQ 24 (A.writeN 24)
584+ let arr1 = A.unsafeCast arr :: A.Array Word64
585+ eid = A.unsafeIndex arr1 0
586+ eflags = A.unsafeIndex arr1 1
587+ pathLen = fromIntegral $ A.unsafeIndex arr1 2
588+ -- XXX handle if pathLen is 0
589+ path <- P.takeEQ pathLen (A.writeN pathLen)
590+ return $ Event
591+ { eventId = eid
592+ , eventFlags = fromIntegral eflags
593+ , eventAbsPath = path
594+ }
595+
596+parseMany2Events :: Property
597+parseMany2Events =
598+ monadicIO $ do
599+ xs <-
600+ ( run
601+ $ S.toList
602+ $ S.parseMany readOneEvent
603+ $ S.fromList (concat (replicate 2 event))
604+ )
605+ assert (length xs == 2)
606+ -- XXX assuming little endian machine
607+ let ev = Event
608+ { eventId = 152170080
609+ , eventFlags = 66560
610+ , eventAbsPath = A.fromList evPath
611+ }
612+ in listEquals (==) xs (replicate 2 ev)
613+
614+-------------------------------------------------------------------------------
615+-- Main
616+-------------------------------------------------------------------------------
617+
488618main :: IO ()
489619main =
490620 hspec $
491621 H.parallel $
492622 modifyMaxSuccess (const maxTestCount) $ do
623+ describe "Instances" $ do
624+ prop "applicative" applicative
625+ prop "monad" monad
626+ prop "sequence" sequence
627+
628+ describe "Stream parsing" $ do
629+ prop "parseMany" parseMany
630+ prop "parseMany2Events" parseMany2Events
631+
493632 describe "test for accumulator" $ do
494633 prop "P.fromFold FL.sum = FL.sum" fromFold
495634 prop "P.any = Prelude.any" Main.any