diff --git a/test/Streamly/Test/Data/Parser.hs b/test/Streamly/Test/Data/Parser.hs index 25190943e6..58c38baabe 100644 --- a/test/Streamly/Test/Data/Parser.hs +++ b/test/Streamly/Test/Data/Parser.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Main (main) where import Control.Applicative ((<|>)) @@ -25,6 +27,11 @@ import qualified Streamly.Internal.Data.Producer as Producer import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Test.Hspec as H +#ifdef PARSER_K +import qualified Streamly.Internal.Data.StreamK as SK +import qualified Streamly.Data.ParserK as PR +#endif + #if MIN_VERSION_QuickCheck(2,14,0) import Test.QuickCheck (chooseAny) @@ -59,11 +66,26 @@ max_length = 1000 -- Accumulator Tests +#ifdef PARSER_K +streamOfArray :: [Int] -> SK.StreamK m (A.Array Int) +streamOfArray = SK.fromPure . A.fromList + +#define INPUT_FROM_LIST streamOfArray +#define PARSER_RUNNER SK.parseChunks +#define FROM_PARSER_D PR.adaptC +#else +#define INPUT_FROM_LIST S.fromList +#define PARSER_RUNNER S.parse +#define FROM_PARSER_D +#endif + fromFold :: Property fromFold = forAll (listOf $ chooseInt (min_value, max_value)) $ \ls -> monadicIO $ do - s1 <- S.parse (P.fromFold FL.sum) (S.fromList ls) + s1 <- PARSER_RUNNER + (FROM_PARSER_D (P.fromFold FL.sum)) + (INPUT_FROM_LIST ls) o2 <- S.fold FL.sum (S.fromList ls) return $ case s1 of @@ -73,35 +95,45 @@ fromFold = fromPure :: Property fromPure = forAll (chooseInt (min_value, max_value)) $ \x -> - case runIdentity $ S.parse (P.fromPure x) (S.fromList [1 :: Int]) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.fromPure x)) + (INPUT_FROM_LIST [1 :: Int]) of Right r -> r == x Left _ -> False fromEffect :: Property fromEffect = forAll (chooseInt (min_value, max_value)) $ \x -> - case runIdentity $ S.parse (P.fromEffect $ return x) (S.fromList [1 :: Int]) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.fromEffect $ return x)) + (INPUT_FROM_LIST [1 :: Int]) of Right r -> r == x Left _ -> False die :: Property die = property $ - case runIdentity $ S.parse (P.die "die test") (S.fromList [0 :: Int]) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.die "die test")) + (INPUT_FROM_LIST [0 :: Int]) of Right _ -> False Left _ -> True dieM :: Property dieM = property $ - case runIdentity $ S.parse (P.dieM (Identity "die test")) (S.fromList [0 :: Int]) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.dieM (Identity "die test"))) + (INPUT_FROM_LIST [0 :: Int]) of Right _ -> False Left _ -> True parserFail :: Property parserFail = property $ - case runIdentity $ S.parse (Fail.fail err) (S.fromList [0 :: Int]) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (Fail.fail err)) + (INPUT_FROM_LIST [0 :: Int]) of Right _ -> False Left (ParseError e) -> err == e where @@ -113,7 +145,9 @@ peekPass :: Property peekPass = forAll (chooseInt (1, max_length)) $ \list_length -> forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parse P.peek (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D P.peek) + (INPUT_FROM_LIST ls) of Right head_value -> case ls of head_ls : _ -> head_value == head_ls _ -> False @@ -121,13 +155,17 @@ peekPass = peekFail :: Property peekFail = - property (case runIdentity $ S.parse P.peek (S.fromList []) of + property (case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D P.peek) + (INPUT_FROM_LIST []) of Right _ -> False Left _ -> True) eofPass :: Property eofPass = - property (case runIdentity $ S.parse P.eof (S.fromList []) of + property (case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D P.eof) + (INPUT_FROM_LIST []) of Right _ -> True Left _ -> False) @@ -135,7 +173,9 @@ eofFail :: Property eofFail = forAll (chooseInt (1, max_length)) $ \list_length -> forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parse P.eof (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D P.eof) + (INPUT_FROM_LIST ls) of Right _ -> False Left _ -> True @@ -147,14 +187,18 @@ satisfyPass = ls = first_element : ls_tail predicate = (>= mid_value) in - case runIdentity $ S.parse (P.satisfy predicate) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.satisfy predicate)) + (INPUT_FROM_LIST ls) of Right r -> r == first_element Left _ -> False satisfy :: Property satisfy = forAll (listOf (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parse (P.satisfy predicate) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.satisfy predicate)) + (INPUT_FROM_LIST ls) of Right r -> case ls of [] -> False (x : _) -> predicate x && (r == x) @@ -167,14 +211,16 @@ satisfy = onePass :: Property onePass = forAll (chooseInt (1, max_value)) $ \int -> - property (case runIdentity $ S.parse P.one (S.fromList [int]) of + property (case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D P.one) (INPUT_FROM_LIST [int]) of Right i -> i == int Left _ -> False) one :: Property one = property $ - case runIdentity $ S.parse P.one (S.fromList []) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D P.one) (INPUT_FROM_LIST []) of Left _ -> True Right _ -> False @@ -186,8 +232,9 @@ takeBetweenPass = forAll (chooseInt (m, max_value)) $ \list_length -> forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parse (P.takeBetween m n FL.toList) - (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.takeBetween m n FL.toList)) + (INPUT_FROM_LIST ls) of Right parsed_list -> let lpl = Prelude.length parsed_list in checkListEqual parsed_list @@ -207,7 +254,9 @@ takeBetween = let inputLen = Prelude.length ls in do let p = P.takeBetween m n FL.toList - case runIdentity $ S.parse p (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D p) + (INPUT_FROM_LIST ls) of Right xs -> let parsedLen = Prelude.length xs in if inputLen >= m && parsedLen >= m && parsedLen <= n @@ -220,7 +269,9 @@ take :: Property take = forAll (chooseInt (min_value, max_value)) $ \n -> forAll (listOf (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parse (P.fromFold $ FL.take n FL.toList) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.fromFold $ FL.take n FL.toList)) + (INPUT_FROM_LIST ls) of Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls) Left _ -> property False @@ -230,7 +281,9 @@ takeEQPass = forAll (chooseInt (n, max_value)) $ \list_length -> forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parse (P.takeEQ n FL.toList) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.takeEQ n FL.toList)) + (INPUT_FROM_LIST ls) of Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls) Left _ -> property False @@ -242,7 +295,9 @@ takeEQ = let list_length = Prelude.length ls in - case runIdentity $ S.parse (P.takeEQ n FL.toList) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.takeEQ n FL.toList)) + (INPUT_FROM_LIST ls) of Right parsed_list -> if n <= list_length then checkListEqual parsed_list (Prelude.take n ls) @@ -255,7 +310,9 @@ takeGEPass = forAll (chooseInt (n, max_value)) $ \list_length -> forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parse (P.takeGE n FL.toList) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.takeGE n FL.toList)) + (INPUT_FROM_LIST ls) of Right parsed_list -> checkListEqual parsed_list ls Left _ -> property False @@ -266,7 +323,9 @@ takeGE = let list_length = Prelude.length ls in - case runIdentity $ S.parse (P.takeGE n FL.toList) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.takeGE n FL.toList)) + (INPUT_FROM_LIST ls) of Right parsed_list -> if n <= list_length then checkListEqual parsed_list ls @@ -283,7 +342,8 @@ nLessThanEqual0 :: nLessThanEqual0 tk ltk = forAll (elements [0, (-1)]) $ \n -> forAll (listOf arbitrary) $ \ls -> - case runIdentity $ S.parse (tk n FL.toList) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (tk n FL.toList)) (INPUT_FROM_LIST ls) of Right parsed_list -> checkListEqual parsed_list (ltk n ls) Left _ -> property False @@ -309,7 +369,8 @@ lookAheadPass = in forAll (chooseInt (n+1, max_value)) $ \list_length -> forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parse parseTwice (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D parseTwice) (INPUT_FROM_LIST ls) of Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls) Left _ -> property $ False @@ -325,7 +386,7 @@ lookAheadPass = -- in -- forAll (chooseInt (min_value, n - 1)) $ \list_length -> -- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls -> --- case S.parse parseTwice (S.fromList ls) of +-- case PARSER_RUNNER parseTwice (INPUT_FROM_LIST ls) of -- Right _ -> False -- Left _ -> True @@ -340,7 +401,8 @@ lookAhead = return (parsed_list_1, parsed_list_2) in forAll (listOf (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parse parseTwice (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D parseTwice) (INPUT_FROM_LIST ls) of Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls) Left _ -> property ((list_length < n) || (list_length == n && n == 0)) where @@ -349,7 +411,8 @@ lookAhead = takeEndBy_ :: Property takeEndBy_ = forAll (listOf (chooseInt (min_value, max_value ))) $ \ls -> - case runIdentity $ S.parse (P.takeEndBy_ predicate prsr) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.takeEndBy_ predicate prsr)) (INPUT_FROM_LIST ls) of Right parsed_list -> checkListEqual parsed_list (tkwhl ls) Left _ -> property False @@ -362,7 +425,9 @@ takeEndByOrMax_ :: Property takeEndByOrMax_ = forAll (chooseInt (min_value, max_value)) $ \n -> forAll (listOf (chooseInt (0, 1))) $ \ls -> - case runIdentity $ S.parse (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList))) + (INPUT_FROM_LIST ls) of Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls)) Left _ -> property False where @@ -373,7 +438,8 @@ takeStartBy = forAll (listOf (chooseInt (min_value, max_value))) $ \ls -> let ls1 = 1:ls in - case runIdentity $ S.parse parser (S.fromList ls1) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D parser) (INPUT_FROM_LIST ls1) of Right parsed_list -> if not $ Prelude.null ls1 then @@ -391,7 +457,8 @@ takeStartBy = takeWhile :: Property takeWhile = forAll (listOf (chooseInt (0, 1))) $ \ ls -> - case runIdentity $ S.parse (P.takeWhile predicate FL.toList) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.takeWhile predicate FL.toList)) (INPUT_FROM_LIST ls) of Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile predicate ls) Left _ -> property False @@ -404,9 +471,10 @@ takeP = ((,) <$> chooseInt (min_value, max_value) <*> listOf (chooseInt (0, 1))) $ \(takeNum, ls) -> - case runIdentity $ S.parse - (P.takeP takeNum (P.fromFold FL.toList)) - (S.fromList ls) of + case runIdentity $ + PARSER_RUNNER + (FROM_PARSER_D (P.takeP takeNum (P.fromFold FL.toList))) + (INPUT_FROM_LIST ls) of Right parsed_list -> checkListEqual parsed_list (Prelude.take takeNum ls) Left _ -> property False @@ -414,7 +482,8 @@ takeP = takeWhile1 :: Property takeWhile1 = forAll (listOf (chooseInt (0, 1))) $ \ ls -> - case runIdentity $ S.parse (P.takeWhile1 predicate FL.toList) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.takeWhile1 predicate FL.toList)) (INPUT_FROM_LIST ls) of Right parsed_list -> case ls of [] -> property False (x : _) -> @@ -444,7 +513,8 @@ takeWhileP = takeWhileTillLen maxLen prd list = Prelude.take maxLen $ Prelude.takeWhile prd list in - case runIdentity $ S.parse prsr (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D prsr) (INPUT_FROM_LIST ls) of Right parsed_list -> checkListEqual parsed_list @@ -459,7 +529,7 @@ choice = <*> chooseInt (min_value, max_value) <*> listOf (chooseInt (0, 1))) $ \(i, j, ls) -> - case S.parse (P.choice [parser i, parser j]) (S.fromList ls) of + case PARSER_RUNNER (FROM_PARSER_D (P.choice [parser i, parser j])) (INPUT_FROM_LIST ls) of Right parsed_list -> checkListEqual parsed_list $ take (min i j) ls Left _ -> property False @@ -473,7 +543,8 @@ groupBy :: Property groupBy = forAll (listOf (chooseInt (0, 1))) $ \ls -> - case runIdentity $ S.parse parser (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D parser) (INPUT_FROM_LIST ls) of Right parsed -> checkListEqual parsed (groupByLF ls) Left _ -> property False @@ -489,7 +560,8 @@ groupByRolling :: Property groupByRolling = forAll (listOf (chooseInt (0, 1))) $ \ls -> - case runIdentity $ S.parse parser (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D parser) (INPUT_FROM_LIST ls) of Right parsed -> checkListEqual parsed (groupByLF Nothing ls) Left _ -> property False @@ -508,12 +580,18 @@ wordBy :: Property wordBy = forAll (listOf (elements [' ', 's'])) $ \ls -> - case runIdentity $ S.parse parser (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D parser) (strm ls) of Right parsed -> checkListEqual parsed (words' ls) Left _ -> property False where +#ifdef PARSER_K + strm = SK.fromPure . A.fromList +#else + strm = S.fromList +#endif predicate = (== ' ') parser = P.many (P.wordBy predicate FL.toList) FL.toList words' lst = @@ -573,7 +651,9 @@ parseManyWordQuotedBy = splitWith :: Property splitWith = forAll (listOf (chooseInt (0, 1))) $ \ls -> - case runIdentity $ S.parse (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1)))) + (INPUT_FROM_LIST ls) of Right (result_first, result_second) -> case ls of 0 : 1 : _ -> (result_first == 0) && (result_second == 1) _ -> False @@ -583,19 +663,25 @@ splitWith = splitWithFailLeft :: Property splitWithFailLeft = - property (case runIdentity $ S.parse (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of + property (case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int)))) + (INPUT_FROM_LIST [1 :: Int]) of Right _ -> False Left _ -> True) splitWithFailRight :: Property splitWithFailRight = - property (case runIdentity $ S.parse (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of + property (case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die"))) + (INPUT_FROM_LIST [1 :: Int]) of Right _ -> False Left _ -> True) splitWithFailBoth :: Property splitWithFailBoth = - property (case runIdentity $ S.parse (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of + property (case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.splitWith (,) (P.die "die") (P.die "die"))) + (INPUT_FROM_LIST [1 :: Int]) of Right _ -> False Left _ -> True) @@ -606,25 +692,25 @@ splitWithFailBoth = -- let -- prsr = P.fromFold $ FL.take n FL.toList -- in --- case S.parse (P.teeWith (,) prsr prsr) (S.fromList ls) of +-- case PARSER_RUNNER (FROM_PARSER_D (P.teeWith (,) prsr prsr)) (INPUT_FROM_LIST ls) of -- Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2 -- Left _ -> property False -- teeWithFailLeft :: Property -- teeWithFailLeft = --- property (case S.parse (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of +-- property (case PARSER_RUNNER (FROM_PARSER_D (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int)))) (INPUT_FROM_LIST [1 :: Int]) of -- Right _ -> False -- Left _ -> True) -- teeWithFailRight :: Property -- teeWithFailRight = --- property (case S.parse (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of +-- property (case PARSER_RUNNER (FROM_PARSER_D (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die"))) (INPUT_FROM_LIST [1 :: Int]) of -- Right _ -> False -- Left _ -> True) -- teeWithFailBoth :: Property -- teeWithFailBoth = --- property (case S.parse (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of +-- property (case PARSER_RUNNER (FROM_PARSER_D (P.teeWith (,) (P.die "die") (P.die "die"))) (INPUT_FROM_LIST [1 :: Int]) of -- Right _ -> False -- Left _ -> True) @@ -632,7 +718,7 @@ splitWithFailBoth = deintercalate :: Property deintercalate = forAll (listOf (chooseAny :: Gen Int)) $ \ls -> - case runIdentity $ S.parse p (S.fromList ls) of + case runIdentity $ PARSER_RUNNER p (INPUT_FROM_LIST ls) of Right evenOdd -> evenOdd == List.partition even ls Left _ -> False @@ -654,28 +740,28 @@ deintercalate = -- prsr_2 = P.takeWhile (<= mid_value) FL.toList -- prsr_shortest = P.shortest prsr_1 prsr_2 -- in --- case S.parse prsr_shortest (S.fromList ls) of +-- case PARSER_RUNNER prsr_shortest (INPUT_FROM_LIST ls) of -- Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= half_mid_value) ls) -- Left _ -> property False -- shortestPassLeft :: Property -- shortestPassLeft = --- property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of +-- property (case PARSER_RUNNER (FROM_PARSER_D (P.shortest (P.die "die") (P.fromPure (1 :: Int)))) (INPUT_FROM_LIST [1 :: Int]) of -- Right r -> r == 1 -- Left _ -> False) -- -- shortestPassRight :: Property -- shortestPassRight = --- property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of +-- property (case PARSER_RUNNER (FROM_PARSER_D (P.shortest (P.fromPure (1 :: Int)) (P.die "die"))) (INPUT_FROM_LIST [1 :: Int]) of -- Right r -> r == 1 -- Left _ -> False) -- shortestFailBoth :: Property -- shortestFailBoth = -- property --- (case S.parse +-- (case PARSER_RUNNER -- (P.shortest (P.die "die") (P.die "die")) --- (S.fromList [1 :: Int]) of +-- (INPUT_FROM_LIST [1 :: Int]) of -- Right _ -> False -- Left _ -> True) -- @@ -688,26 +774,26 @@ deintercalate = -- prsr_2 = P.takeWhile (<= mid_value) FL.toList -- prsr_longest = P.longest prsr_1 prsr_2 -- in --- case S.parse prsr_longest (S.fromList ls) of +-- case PARSER_RUNNER prsr_longest (INPUT_FROM_LIST ls) of -- Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls -- Left _ -> False -- -- longestPassLeft :: Property -- longestPassLeft = --- property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of +-- property (case PARSER_RUNNER (FROM_PARSER_D (P.shortest (P.die "die") (P.fromPure (1 :: Int)))) (INPUT_FROM_LIST [1 :: Int]) of -- Right r -> r == 1 -- Left _ -> False) -- -- longestPassRight :: Property -- longestPassRight = --- property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of +-- property (case PARSER_RUNNER (FROM_PARSER_D (P.shortest (P.fromPure (1 :: Int)) (P.die "die"))) (INPUT_FROM_LIST [1 :: Int]) of -- Right r -> r == 1 -- Left _ -> False) -- -- longestFailBoth :: Property -- longestFailBoth = -- property --- (case S.parse (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of +-- (case PARSER_RUNNER (FROM_PARSER_D (P.shortest (P.die "die") (P.die "die"))) (INPUT_FROM_LIST [1 :: Int]) of -- Right _ -> False -- Left _ -> True) @@ -719,14 +805,17 @@ many = prsr = flip P.many concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList - in case runIdentity $ S.parse prsr (S.fromList ls) of + in case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D prsr) (INPUT_FROM_LIST ls) of Right res_list -> checkListEqual res_list (Prelude.filter (== 0) ls) Left _ -> property False many_empty :: Property many_empty = - property (case runIdentity $ S.parse (flip P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of + property (case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (flip P.many FL.toList (P.die "die"))) + (INPUT_FROM_LIST [1 :: Int]) of Right res_list -> checkListEqual res_list ([] :: [Int]) Left _ -> property False) @@ -740,13 +829,16 @@ some = prsr = flip P.some concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList - in case runIdentity $ S.parse prsr (S.fromList ls) of + in case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D prsr) (INPUT_FROM_LIST ls) of Right res_list -> res_list == Prelude.filter (== 0) ls Left _ -> False someFail :: Property someFail = - property (case runIdentity $ S.parse (P.some (P.die "die") FL.toList) (S.fromList [1 :: Int]) of + property (case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D (P.some (P.die "die") FL.toList)) + (INPUT_FROM_LIST [1 :: Int]) of Right _ -> False Left _ -> True) @@ -763,7 +855,9 @@ applicative = <$> P.fromFold (FL.take (length list1) FL.toList) <*> P.fromFold (FL.take (length list2) FL.toList) in - case runIdentity $ S.parse parser (S.fromList $ list1 ++ list2) of + case runIdentity $ PARSER_RUNNER + (FROM_PARSER_D parser) + (INPUT_FROM_LIST $ list1 ++ list2) of Right (olist1, olist2) -> olist1 == list1 && olist2 == list2 Left _ -> False @@ -773,9 +867,9 @@ sequence = let p xs = P.fromFold (FL.take (length xs) FL.toList) in monadicIO $ do outs <- run $ - S.parse - (Prelude.sequence $ fmap p ins) - (S.fromList $ concat ins) + PARSER_RUNNER + (FROM_PARSER_D (Prelude.sequence $ fmap p ins)) + (INPUT_FROM_LIST $ concat ins) return $ case outs of Right ls -> ls == ins @@ -784,9 +878,9 @@ sequence = altEOF1 :: Property altEOF1 = monadicIO $ do - s1 <- S.parse - (P.satisfy (> 0) <|> return 66) - (S.fromList ([]::[Int])) + s1 <- PARSER_RUNNER + (FROM_PARSER_D (P.satisfy (> 0) <|> return 66)) + (INPUT_FROM_LIST ([]::[Int])) return $ case s1 of Right x -> x == 66 @@ -795,9 +889,9 @@ altEOF1 = altEOF2 :: Property altEOF2 = monadicIO $ do - s1 <- S.parse - ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList)) - (S.fromList ([51]::[Int])) + s1 <- PARSER_RUNNER + (FROM_PARSER_D ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList))) + (INPUT_FROM_LIST ([51]::[Int])) return $ case s1 of Right x -> x == [51] @@ -812,7 +906,9 @@ monad = olist2 <- P.fromFold (FL.take (length list2) FL.toList) return (olist1, olist2) in monadicIO $ do - s <- S.parse parser (S.fromList $ list1 ++ list2) + s <- PARSER_RUNNER + (FROM_PARSER_D parser) + (INPUT_FROM_LIST $ list1 ++ list2) return $ case s of Right (olist1, olist2) -> olist1 == list1 && olist2 == list2 @@ -868,15 +964,19 @@ parserSequence :: Property parserSequence = forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ins -> monadicIO $ do - let parsers = S.fromList - $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins - let sequencedParser = P.sequence parsers FL.sum - outs <- - S.parse sequencedParser $ S.concatMap S.fromList (S.fromList ins) - return $ - case outs of - Right x -> x == sum (map sum ins) - Left _ -> False + let parsers = S.fromList + $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins + let sequencedParser = FROM_PARSER_D (P.sequence parsers FL.sum) +#ifdef PARSER_K + strm = SK.map A.fromList (SK.fromList ins) +#else + strm = S.concatMap S.fromList (S.fromList ins) +#endif + outs <- PARSER_RUNNER sequencedParser strm + return $ + case outs of + Right x -> x == sum (map sum ins) + Left _ -> False ------------------------------------------------------------------------------- -- Test for a particular case hit during fs events testing @@ -947,9 +1047,9 @@ manyEqParseMany = forAll (listOf (chooseInt (0, 100))) $ \lst -> forAll (chooseInt (1, 100)) $ \i -> monadicIO $ do - let strm = S.fromList lst - r1 <- run $ S.parse (P.many (split i) FL.toList) strm - r2 <- run $ S.fold FL.toList $ S.catRights $ S.parseMany (split i) strm + let strm = INPUT_FROM_LIST lst + r1 <- run $ PARSER_RUNNER (FROM_PARSER_D (P.many (split i) FL.toList)) strm + r2 <- run $ S.fold FL.toList $ S.catRights $ S.parseMany (split i) (S.fromList lst) return $ case r1 of Right o1 -> o1 == r2 @@ -963,7 +1063,7 @@ manyEqParseMany = takeEndBy1 :: Property takeEndBy1 = forAll (listOf (chooseInt (0, 1))) $ \ls -> - case runIdentity $ S.parse (P.takeEndBy predicate prsr) (S.fromList ls) of + case runIdentity $ PARSER_RUNNER (FROM_PARSER_D (P.takeEndBy predicate prsr)) (INPUT_FROM_LIST ls) of Right parsed_list -> checkListEqual parsed_list @@ -1053,7 +1153,7 @@ takeEndByEsc = Just _ -> x : escapeSep Nothing xs in - case runIdentity $ S.parse prsr (S.fromList ls) of + case runIdentity $ PARSER_RUNNER (FROM_PARSER_D prsr) (INPUT_FROM_LIST ls) of Right parsed_list -> checkListEqual parsed_list $ escapeSep Nothing ls Left err -> property (displayException err == msg) @@ -1129,7 +1229,7 @@ takeFramedByEsc_ = in helper l Nothing (0 :: Int) in - case runIdentity $ S.parse prsr (S.fromList ls) of + case runIdentity $ PARSER_RUNNER (FROM_PARSER_D prsr) (INPUT_FROM_LIST ls) of Right parsed_list -> if checkPassBeg ls then checkListEqual parsed_list $ @@ -1186,7 +1286,7 @@ takeFramedByEsc_Pass = in helper l Nothing (0 :: Int) in - case runIdentity $ S.parse prsr (S.fromList ls) of + case runIdentity $ PARSER_RUNNER (FROM_PARSER_D prsr) (INPUT_FROM_LIST ls) of Right parsed_list -> checkListEqual parsed_list $ escapeFrame isBegin isEnd isEsc ls _ -> property False @@ -1205,7 +1305,7 @@ takeFramedByEsc_Fail1 = ls = [0 :: Int] in - case runIdentity $ S.parse prsr (S.fromList ls) of + case runIdentity $ PARSER_RUNNER (FROM_PARSER_D prsr) (INPUT_FROM_LIST ls) of Right _ -> property False Left err -> property (displayException err == msg) @@ -1224,7 +1324,7 @@ takeFramedByEsc_Fail2 = ls = [1 :: Int] in - case runIdentity $ S.parse prsr (S.fromList ls) of + case runIdentity $ PARSER_RUNNER (FROM_PARSER_D prsr) (INPUT_FROM_LIST ls) of Right _ -> property False Left err -> property (displayException err == msg) @@ -1243,7 +1343,7 @@ takeFramedByEsc_Fail3 = ls = [2 :: Int] in - case runIdentity $ S.parse prsr (S.fromList ls) of + case runIdentity $ PARSER_RUNNER (FROM_PARSER_D prsr) (INPUT_FROM_LIST ls) of Right _ -> property False Left err -> property $ (displayException err == msg) @@ -1253,7 +1353,7 @@ takeStartBy_ = let ls1 = 1:ls msg = "takeFramedByGeneric: empty token" in - case runIdentity $ S.parse parser (S.fromList ls1) of + case runIdentity $ PARSER_RUNNER (FROM_PARSER_D parser) (INPUT_FROM_LIST ls1) of Right parsed_list -> if not $ Prelude.null ls1 then diff --git a/test/Streamly/Test/Data/ParserK.hs b/test/Streamly/Test/Data/ParserK.hs deleted file mode 100644 index ae75a648a6..0000000000 --- a/test/Streamly/Test/Data/ParserK.hs +++ /dev/null @@ -1,836 +0,0 @@ -module Main (main) where - -import Control.Applicative ((<|>)) -import Control.Exception (SomeException(..), try) -import Data.Word (Word8, Word32, Word64) -import Streamly.Test.Common (listEquals, checkListEqual, chooseInt) -import Test.Hspec (Spec, hspec, describe) -import Test.Hspec.QuickCheck -import Test.QuickCheck - (arbitrary, forAll, elements, Property, - property, listOf, vectorOf, (.&&.), Gen) -import Test.QuickCheck.Monadic (monadicIO, assert, run) - -import qualified Data.List as List -import qualified Prelude -import qualified Streamly.Data.Stream as S -import qualified Streamly.Internal.Data.Array as A -import qualified Streamly.Internal.Data.Fold as FL -import qualified Streamly.Internal.Data.Parser as P -import qualified Streamly.Internal.Data.Producer as Producer -import qualified Streamly.Internal.Data.Stream as S -import qualified Streamly.Internal.Data.Stream as D -import qualified Streamly.Internal.Data.Unfold as Unfold -import qualified Test.Hspec as H - -import Prelude hiding (sequence) - -#if MIN_VERSION_QuickCheck(2,14,0) - -import Test.QuickCheck (chooseAny) -import Control.Monad.Identity (runIdentity, Identity (Identity)) - -#else - -import System.Random (Random(random)) -import Test.QuickCheck.Gen (Gen(MkGen)) - --- | Generates a random element over the natural range of `a`. -chooseAny :: Random a => Gen a -chooseAny = MkGen (\r _ -> let (x,_) = random r in x) - -#endif - -maxTestCount :: Int -maxTestCount = 100 - -min_value :: Int -min_value = 0 - -mid_value :: Int -mid_value = 5000 - -max_value :: Int -max_value = 10000 - -max_length :: Int -max_length = 1000 - -toList :: Monad m => S.Stream m a -> m [a] -toList = S.fold FL.toList - --- Accumulator Tests - -fromFold :: Property -fromFold = - forAll (listOf $ chooseInt (min_value, max_value)) - $ \ls -> - case (==) <$> runIdentity (S.parseD (P.fromFold FL.sum) (S.fromList ls)) - <*> (S.fold FL.sum (S.fromList ls)) of - Right is_equal -> is_equal - Left _ -> False - -fromPure :: Property -fromPure = - forAll (chooseInt (min_value, max_value)) $ \x -> - case runIdentity $ S.parseD (P.fromPure x) (S.fromList [1 :: Int]) of - Right r -> r == x - Left _ -> False - -fromEffect :: Property -fromEffect = - forAll (chooseInt (min_value, max_value)) $ \x -> - case runIdentity $ S.parseD (P.fromEffect $ return x) (S.fromList [1 :: Int]) of - Right r -> r == x - Left _ -> False - -die :: Property -die = - property $ - case runIdentity (S.parseD (P.die "die test") (S.fromList [0 :: Int])) of - Right _ -> False - Left _ -> True - -dieM :: Property -dieM = - property $ - case runIdentity (S.parseD (P.dieM (Identity "die test")) (S.fromList [0 :: Int])) of - Right _ -> False - Left _ -> True - --- Element Parser Tests - -peekPass :: Property -peekPass = - forAll (chooseInt (1, max_length)) $ \list_length -> - forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parseD P.peek (S.fromList ls) of - Right head_value -> case ls of - head_ls : _ -> head_value == head_ls - _ -> False - Left _ -> False - -peekFail :: Property -peekFail = - property (case runIdentity $ S.parseD P.peek (S.fromList []) of - Right _ -> False - Left _ -> True) - -eofPass :: Property -eofPass = - property (case S.parseD P.eof (S.fromList []) of - Right _ -> True - Left _ -> False) - -eofFail :: Property -eofFail = - forAll (chooseInt (1, max_length)) $ \list_length -> - forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parseD P.eof (S.fromList ls) of - Right _ -> False - Left _ -> True - -satisfyPass :: Property -satisfyPass = - forAll (chooseInt (mid_value, max_value)) $ \first_element -> - forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail -> - let - ls = first_element : ls_tail - predicate = (>= mid_value) - in - case runIdentity $ S.parseD (P.satisfy predicate) (S.fromList ls) of - Right r -> r == first_element - Left _ -> False - -satisfy :: Property -satisfy = - forAll (listOf (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parseD (P.satisfy predicate) (S.fromList ls) of - Right r -> case ls of - [] -> False - (x : _) -> predicate x && (r == x) - Left _ -> case ls of - [] -> True - (x : _) -> not $ predicate x - where - predicate = (>= mid_value) - --- Sequence Parsers Tests -takeBetweenPass :: Property -takeBetweenPass = - forAll (chooseInt (min_value, max_value)) $ \m -> - forAll (chooseInt (m, max_value)) $ \n -> - forAll (chooseInt (m, max_value)) $ \list_length -> - forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parseD (P.takeBetween m n FL.toList) (S.fromList ls) of - Right parsed_list -> - let lpl = Prelude.length parsed_list - in checkListEqual parsed_list (Prelude.take lpl ls) - Left _ -> property False - - -takeBetween :: Property -takeBetween = - forAll (chooseInt (min_value, max_value)) $ \m -> - forAll (chooseInt (min_value, max_value)) $ \n -> - forAll (listOf (chooseInt (min_value, max_value))) $ \ls -> - let - list_length = Prelude.length ls - in monadicIO $ do - let p = P.takeBetween m n FL.toList - r <- run $ try $ S.parseD p (S.fromList ls) - return $ case r of - Right x -> case x of - Right parsed_list -> - if m <= list_length && n >= m - then - let len = Prelude.length parsed_list - in checkListEqual - parsed_list (Prelude.take len ls) - else property False - Left _ -> - property (m > n || list_length < m) - Left (_ :: SomeException) -> - property (m > n || list_length < m) - -take :: Property -take = - forAll (chooseInt (min_value, max_value)) $ \n -> - forAll (listOf (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parseD (P.fromFold $ FL.take n FL.toList) (S.fromList ls) of - Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls) - Left _ -> property False - -takeEQPass :: Property -takeEQPass = - forAll (chooseInt (min_value, max_value)) $ \n -> - forAll (chooseInt (n, max_value)) $ \list_length -> - forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of - Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls) - Left _ -> property False - -takeEQ :: Property -takeEQ = - forAll (chooseInt (min_value, max_value)) $ \n -> - forAll (listOf (chooseInt (min_value, max_value))) $ \ls -> - let - list_length = Prelude.length ls - in - case runIdentity $ S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of - Right parsed_list -> - if (n <= list_length) then - checkListEqual parsed_list (Prelude.take n ls) - else - property False - Left _ -> property (n > list_length) - -takeGEPass :: Property -takeGEPass = - forAll (chooseInt (min_value, max_value)) $ \n -> - forAll (chooseInt (n, max_value)) $ \list_length -> - forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parseD (P.takeGE n FL.toList) (S.fromList ls) of - Right parsed_list -> checkListEqual parsed_list ls - Left _ -> property False - -takeGE :: Property -takeGE = - forAll (chooseInt (min_value, max_value)) $ \n -> - forAll (listOf (chooseInt (min_value, max_value))) $ \ls -> - let - list_length = Prelude.length ls - in - case runIdentity $ S.parseD (P.takeGE n FL.toList) (S.fromList ls) of - Right parsed_list -> - if (n <= list_length) then - checkListEqual parsed_list ls - else - property False - Left _ -> property (n > list_length) - -nLessThanEqual0 :: - ( Int - -> FL.Fold Identity Int [Int] - -> P.Parser Int Identity [Int] - ) - -> (Int -> [Int] -> [Int]) - -> Property -nLessThanEqual0 tk ltk = - forAll (elements [0, (-1)]) $ \n -> - forAll (listOf arbitrary) $ \ls -> - case runIdentity $ S.parseD (tk n FL.toList) (S.fromList ls) of - Right parsed_list -> checkListEqual parsed_list (ltk n ls) - Left _ -> property False - -takeProperties :: Spec -takeProperties = - describe "take combinators when n <= 0/" $ do - prop "takeEQ n FL.toList = []" $ - nLessThanEqual0 P.takeEQ (\_ -> const []) - prop "takeGE n FL.toList xs = xs" $ - nLessThanEqual0 P.takeGE (\_ -> id) - - --- XXX lookAhead can't deal with EOF which in this case means when --- n==list_length, this test will fail. So excluding that case for now. -lookAheadPass :: Property -lookAheadPass = - forAll (chooseInt (min_value, max_value)) $ \n -> - let - takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList - parseTwice = do - parsed_list_1 <- takeWithoutConsume - parsed_list_2 <- takeWithoutConsume - return (parsed_list_1, parsed_list_2) - in - forAll (chooseInt (n+1, max_value)) $ \list_length -> - forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parseD parseTwice (S.fromList ls) of - Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls) - Left _ -> property $ False - -lookAhead :: Property -lookAhead = - forAll (chooseInt (min_value, max_value)) $ \n -> - let - takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList - parseTwice = do - parsed_list_1 <- takeWithoutConsume - parsed_list_2 <- takeWithoutConsume - return (parsed_list_1, parsed_list_2) - in - forAll (listOf (chooseInt (min_value, max_value))) $ \ls -> - case runIdentity $ S.parseD parseTwice (S.fromList ls) of - Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls) - Left _ -> property ((list_length < n) || (list_length == n && n == 0)) - where - list_length = Prelude.length ls - -takeWhile :: Property -takeWhile = - forAll (listOf (chooseInt (0, 1))) $ \ ls -> - case runIdentity $ S.parseD (P.takeWhile predicate FL.toList) (S.fromList ls) of - Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile predicate ls) - Left _ -> property False - where - predicate = (== 0) - -takeWhile1 :: Property -takeWhile1 = - forAll (listOf (chooseInt (0, 1))) $ \ ls -> - case runIdentity $ S.parseD (P.takeWhile1 predicate FL.toList) (S.fromList ls) of - Right parsed_list -> case ls of - [] -> property False - (x : _) -> - if predicate x then - checkListEqual parsed_list (Prelude.takeWhile predicate ls) - else - property False - Left _ -> case ls of - [] -> property True - (x : _) -> property (not $ predicate x) - where - predicate = (== 0) - -groupBy :: Property -groupBy = - forAll (listOf (chooseInt (0, 1))) - $ \ls -> - case runIdentity $ S.parseD parser (S.fromList ls) of - Right parsed -> checkListEqual parsed (groupByLF ls) - Left _ -> property False - - where - - cmp = (==) - parser = P.groupBy cmp FL.toList - groupByLF lst - | null lst = [] - | otherwise = head $ List.groupBy cmp lst - -groupByRolling :: Property -groupByRolling = - forAll (listOf (chooseInt (0, 1))) - $ \ls -> - case runIdentity $ S.parseD parser (S.fromList ls) of - Right parsed -> checkListEqual parsed (groupByLF Nothing ls) - Left _ -> property False - - where - - cmp = (==) - parser = P.groupBy cmp FL.toList - groupByLF _ [] = [] - groupByLF Nothing (x:xs) = x : groupByLF (Just x) xs - groupByLF (Just y) (x:xs) = - if cmp y x - then x : groupByLF (Just x) xs - else [] - -takeEndByOrMax :: Property -takeEndByOrMax = - forAll (chooseInt (min_value, max_value)) $ \n -> - forAll (listOf (chooseInt (0, 1))) $ \ls -> - case runIdentity $ S.parseD (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) (S.fromList ls) of - Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls)) - Left _ -> property False - where - predicate = (== 1) - -wordBy :: Property -wordBy = - forAll (listOf (elements [' ', 's'])) - $ \ls -> - case runIdentity $ S.parseD parser (S.fromList ls) of - Right parsed -> checkListEqual parsed (words' ls) - Left _ -> property False - - where - - predicate = (== ' ') - parser = P.many (P.wordBy predicate FL.toList) FL.toList - words' lst = - let wrds = words lst - in if wrds == [] && length lst > 0 then [""] else wrds - - -splitWith :: Property -splitWith = - forAll (listOf (chooseInt (0, 1))) $ \ls -> - case runIdentity $ S.parseD (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of - Right (result_first, result_second) -> case ls of - 0 : 1 : _ -> (result_first == 0) && (result_second == 1) - _ -> False - Left _ -> case ls of - 0 : 1 : _ -> False - _ -> True - -splitWithFailLeft :: Property -splitWithFailLeft = - property (case runIdentity $ S.parseD (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of - Right _ -> False - Left _ -> True) - -splitWithFailRight :: Property -splitWithFailRight = - property (case runIdentity $ S.parseD (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of - Right _ -> False - Left _ -> True) - -splitWithFailBoth :: Property -splitWithFailBoth = - property (case runIdentity $ S.parseD (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of - Right _ -> False - Left _ -> True) - -{- -teeWithPass :: Property -teeWithPass = - forAll (chooseInt (min_value, max_value)) $ \n -> - forAll (listOf (chooseInt (0, 1))) $ \ls -> - let - prsr = P.fromFold $ FL.take n FL.toList - in - case S.parseD (P.teeWith (,) prsr prsr) (S.fromList ls) of - Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2 - Left _ -> property False - -teeWithFailLeft :: Property -teeWithFailLeft = - property (case S.parseD (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of - Right _ -> False - Left _ -> True) - -teeWithFailRight :: Property -teeWithFailRight = - property (case S.parseD (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of - Right _ -> False - Left _ -> True) - -teeWithFailBoth :: Property -teeWithFailBoth = - property (case S.parseD (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of - Right _ -> False - Left _ -> True) - -shortestPass :: Property -shortestPass = - forAll (listOf (chooseInt(min_value, max_value))) $ \ls -> - let - half_mid_value = mid_value `Prelude.div` 2 - prsr_1 = P.takeWhile (<= half_mid_value) FL.toList - prsr_2 = P.takeWhile (<= mid_value) FL.toList - prsr_shortest = P.shortest prsr_1 prsr_2 - in - case S.parseD prsr_shortest (S.fromList ls) of - Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= half_mid_value) ls) - Left _ -> property False - -shortestPassLeft :: Property -shortestPassLeft = - property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of - Right r -> r == 1 - Left _ -> False) - -shortestPassRight :: Property -shortestPassRight = - property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of - Right r -> r == 1 - Left _ -> False) - -shortestFailBoth :: Property -shortestFailBoth = - property - (case S.parseD - (P.shortest (P.die "die") (P.die "die")) - (S.fromList [1 :: Int]) of - Right _ -> False - Left _ -> True) - -longestPass :: Property -longestPass = - forAll (listOf (chooseInt(min_value, max_value))) $ \ls -> - let - half_mid_value = mid_value `Prelude.div` 2 - prsr_1 = P.takeWhile (<= half_mid_value) FL.toList - prsr_2 = P.takeWhile (<= mid_value) FL.toList - prsr_longest = P.longest prsr_1 prsr_2 - in - case S.parseD prsr_longest (S.fromList ls) of - Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls - Left _ -> False - -longestPassLeft :: Property -longestPassLeft = - property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of - Right r -> r == 1 - Left _ -> False) - -longestPassRight :: Property -longestPassRight = - property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of - Right r -> r == 1 - Left _ -> False) - -longestFailBoth :: Property -longestFailBoth = - property - (case S.parseD (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of - Right _ -> False - Left _ -> True) --} - -many :: Property -many = - forAll (listOf (chooseInt (0, 1))) - $ \ls -> - let fldstp conL currL = return $ FL.Partial (conL ++ currL) - concatFold = - FL.Fold fldstp (return (FL.Partial [])) return - prsr = - flip P.many concatFold - $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList - in case runIdentity $ S.parseD prsr (S.fromList ls) of - Right res_list -> - checkListEqual res_list (Prelude.filter (== 0) ls) - Left _ -> property False - -many_empty :: Property -many_empty = - property (case runIdentity $ S.parseD (flip P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of - Right res_list -> checkListEqual res_list ([] :: [Int]) - Left _ -> property False) - -some :: Property -some = - forAll (listOf (chooseInt (0, 1))) - $ \ls -> - let fldstp conL currL = return $ FL.Partial $ conL ++ currL - concatFold = FL.Fold fldstp (return (FL.Partial [])) return - prsr = - flip P.some concatFold - $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList - in case runIdentity $ S.parseD prsr (S.fromList ls) of - Right res_list -> res_list == Prelude.filter (== 0) ls - Left _ -> False - -someFail :: Property -someFail = - property (case runIdentity $ S.parseD (P.some (P.die "die") FL.toList) (S.fromList [1 :: Int]) of - Right _ -> False - Left _ -> True) - -------------------------------------------------------------------------------- --- Instances -------------------------------------------------------------------------------- - -applicative :: Property -applicative = - forAll (listOf (chooseAny :: Gen Int)) $ \ list1 -> - forAll (listOf (chooseAny :: Gen Int)) $ \ list2 -> - monadicIO $ do - let parser = - (,) - <$> P.fromFold (FL.take (length list1) FL.toList) - <*> P.fromFold (FL.take (length list2) FL.toList) - - return $ - case runIdentity $ S.parseD parser (S.fromList $ list1 ++ list2) of - Right (olist1, olist2) -> olist1 == list1 && olist2 == list2 - Left _ -> False - -sequence :: Property -sequence = - forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins -> - monadicIO $ do - let parsers = fmap (\xs -> P.fromFold $ FL.take (length xs) FL.toList) ins - outs <- S.parseD - (Prelude.sequence parsers) - (S.fromList $ concat ins) - return $ - case outs of - Right x -> x == ins - Left _ -> False - -altEOF1 :: Property -altEOF1 = - monadicIO $ do - s1 <- S.parseD - (P.satisfy (> 0) <|> return 66) - (S.fromList ([]::[Int])) - return $ - case s1 of - Right x -> x == 66 - Left _ -> False - -altEOF2 :: Property -altEOF2 = - monadicIO $ do - s1 <- S.parseD - ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList)) - (S.fromList ([51]::[Int])) - return $ - case s1 of - Right x -> x == [51] - Left _ -> False - -monad :: Property -monad = - forAll (listOf (chooseAny :: Gen Int)) $ \ list1 -> - forAll (listOf (chooseAny :: Gen Int)) $ \ list2 -> - monadicIO $ do - let parser = do - olist1 <- P.fromFold (FL.take (length list1) FL.toList) - olist2 <- P.fromFold (FL.take (length list2) FL.toList) - return (olist1, olist2) - s1 <- S.parseD parser (S.fromList $ list1 ++ list2) - return $ - case s1 of - Right (olist1, olist2) -> olist1 == list1 && olist2 == list2 - Left _ -> False - -------------------------------------------------------------------------------- --- Stream parsing -------------------------------------------------------------------------------- - -parseMany :: Property -parseMany = - forAll (chooseInt (1,100)) $ \len -> - forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins -> - monadicIO $ do - outs <- - (toList $ S.catRights $ S.parseManyD - (P.fromFold $ FL.take len FL.toList) (S.fromList $ concat ins) - ) - return $ outs == ins - --- basic sanity test for parsing from arrays -parseUnfold :: Property -parseUnfold = do - let len = 200 - -- ls = input list (stream) - -- clen = chunk size - -- tlen = parser take size - forAll - ((,,) - <$> vectorOf len (chooseAny :: Gen Int) - <*> chooseInt (1, len) - <*> chooseInt (1, len)) $ \(ls, clen, tlen) -> - monadicIO $ do - arrays <- toList $ S.chunksOf clen (S.fromList ls) - let src = Producer.source (Just (Producer.OuterLoop arrays)) - let parser = P.fromFold (FL.take tlen FL.toList) - let readSrc = - Producer.producer - $ Producer.concat Producer.fromList A.producer - let streamParser = - Producer.simplify (Producer.parseManyD parser readSrc) - xs <- run - $ toList - $ S.unfoldMany Unfold.fromList - $ S.catRights - $ S.unfold streamParser src - - listEquals (==) xs ls - -parserSequence :: Property -parserSequence = - forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ins -> - monadicIO $ do - let parsers = D.fromList - $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins - let sequencedParser = P.sequence parsers FL.sum - outs <- - S.parseD sequencedParser $ S.concatMap S.fromList (S.fromList ins) - return $ - case outs of - Right x -> x == sum (map sum ins) - Left _ -> False - -------------------------------------------------------------------------------- --- Test for a particular case hit during fs events testing -------------------------------------------------------------------------------- - -evId :: [Word8] -evId = [96,238,17,9,0,0,0,0] - -evFlags :: [Word8] -evFlags = [0,4,1,0,0,0,0,0] - -evPathLen :: [Word8] -evPathLen = [71,0,0,0,0,0,0,0] - -evPath :: [Word8] -evPath = - [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109 - ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112 - ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116 - ,114,101,97,109,108,121,47,116,109,112,47,122,122 - ] - -event :: [Word8] -event = evId ++ evFlags ++ evPathLen ++ evPath - -data Event = Event - { eventId :: Word64 - , eventFlags :: Word32 - , eventAbsPath :: A.Array Word8 - } deriving (Show, Ord, Eq) - -readOneEvent :: P.Parser Word8 IO Event -readOneEvent = do - arr <- P.takeEQ 24 (A.writeN 24) - let arr1 = A.castUnsafe arr :: A.Array Word64 - eid = A.getIndexUnsafe 0 arr1 - eflags = A.getIndexUnsafe 1 arr1 - pathLen = fromIntegral $ A.getIndexUnsafe 2 arr1 - path <- P.takeEQ pathLen (A.writeN pathLen) - return $ Event - { eventId = eid - , eventFlags = fromIntegral eflags - , eventAbsPath = path - } - -parseMany2Events :: Property -parseMany2Events = - monadicIO $ do - xs <- - ( run - $ toList - $ S.catRights - $ S.parseManyD readOneEvent - $ S.fromList (concat (replicate 2 event)) - ) - assert (length xs == 2) - -- XXX assuming little endian machine - let ev = Event - { eventId = 152170080 - , eventFlags = 66560 - , eventAbsPath = A.fromList evPath - } - in listEquals (==) xs (replicate 2 ev) - -------------------------------------------------------------------------------- --- Main -------------------------------------------------------------------------------- - -moduleName :: String -moduleName = "Data.ParserK" - -main :: IO () -main = - hspec $ - H.parallel $ - modifyMaxSuccess (const maxTestCount) $ do - describe moduleName $ do - - describe "Instances" $ do - prop "applicative" applicative - prop "Alternative: end of input 1" altEOF1 - prop "Alternative: end of input 2" altEOF2 - prop "monad" monad - prop "sequence" sequence - - describe "Stream parsing" $ do - prop "parseMany" parseMany - prop "parseMany2Events" parseMany2Events - prop "parseUnfold" parseUnfold - prop "parserSequence" parserSequence - - describe "test for accumulator" $ do - prop "P.fromFold FL.sum = FL.sum" fromFold - prop "fromPure value provided" fromPure - prop "fromPure monadic value provided" fromEffect - prop "always fail" die - prop "always fail but monadic" dieM - - describe "test for element parser" $ do - prop "peek = head with list length > 0" peekPass - prop "peek fail on []" peekFail - prop "eof pass on []" eofPass - prop "eof fail on non-empty list" eofFail - prop "first element exists and >= mid_value" satisfyPass - prop "check first element exists and satisfies predicate" satisfy - - describe "test for sequence parser" $ do - prop "P.takeBetween m n = Prelude.take when len >= m and len <= n" - takeBetweenPass - prop ("P.takeBetween m n = Prelude.take when len >= m and len <= n and" - ++ " fail otherwise") takeBetween - prop "P.take = Prelude.take" Main.take - prop "P.takeEQ = Prelude.take when len >= n" takeEQPass - prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" Main.takeEQ - prop "P.takeGE n ls = ls when len >= n" takeGEPass - prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE - prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass - prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead - prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile - prop "P.takeWhile1 = Prelude.takeWhile if taken something, else check why failed" takeWhile1 - prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy - prop "groupByRolling" groupByRolling - prop "P.takeEndByOrMax = Prelude.take n (Prelude.takeWhile (not . predicate)" takeEndByOrMax - prop "many (P.wordBy ' ') = words'" wordBy - prop "parse 0, then 1, else fail" splitWith - prop "fail due to die as left parser" splitWithFailLeft - prop "fail due to die as right parser" splitWithFailRight - prop "fail due to die as both parsers" splitWithFailBoth - {- - prop "parsed two lists should be equal" teeWithPass - prop "fail due to die as left parser" teeWithFailLeft - prop "fail due to die as right parser" teeWithFailRight - prop "fail due to die as both parsers" teeWithFailBoth - prop "P.takeWhile (<= half_mid_value) = Prelude.takeWhile half_mid_value" shortestPass - prop "pass even if die is left parser" shortestPassLeft - prop "pass even if die is right parser" shortestPassRight - prop "fail due to die as both parsers" shortestFailBoth - prop "P.takeWhile (<= mid_value) = Prelude.takeWhile (<= mid_value)" longestPass - prop "pass even if die is left parser" longestPassLeft - prop "pass even if die is right parser" longestPassRight - prop "fail due to die as both parsers" longestFailBoth - -} - prop "P.many concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" many - prop "[] due to parser being die" many_empty - prop "P.some concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" some - prop "fail due to parser being die" someFail - takeProperties diff --git a/test/streamly-tests.cabal b/test/streamly-tests.cabal index 80e0cc307d..20171e8406 100644 --- a/test/streamly-tests.cabal +++ b/test/streamly-tests.cabal @@ -326,7 +326,8 @@ test-suite Data.Parser test-suite Data.ParserK import: test-options type: exitcode-stdio-1.0 - main-is: Streamly/Test/Data/ParserK.hs + main-is: Streamly/Test/Data/Parser.hs + cpp-options: -DPARSER_K if flag(limit-build-mem) ghc-options: +RTS -M1500M -RTS