git.iko.soy/streamly
on 4eaeb10 help sign in
streamly/test/Streamly/Test/Data/Parser/ParserD.hs
819 lines 30 kB history raw
1module Main (main) where
3import Control.Applicative ((<|>))
4import Control.Exception (SomeException(..), try)
5import Data.Word (Word8, Word32, Word64)
6import Streamly.Test.Common (listEquals, checkListEqual, chooseInt, equals)
7import Test.Hspec (Spec, hspec, describe, Expectation, it, shouldReturn)
8import Test.Hspec.QuickCheck
9import Test.QuickCheck
10 (arbitrary, forAll, elements, Property,
11 property, listOf, vectorOf, (.&&.), Gen)
12import Test.QuickCheck.Monadic (monadicIO, assert, run)
14import qualified Data.List as List
15import qualified Prelude
16import qualified Streamly.Internal.Data.Array.Unboxed as A
17import qualified Streamly.Internal.Data.Fold as FL
18import qualified Streamly.Internal.Data.Parser.ParserD as P
19import qualified Streamly.Internal.Data.Producer.Source as Source
20import qualified Streamly.Internal.Data.Producer as Producer
21import qualified Streamly.Internal.Data.Stream as S
22import qualified Streamly.Internal.Data.Stream.StreamD as D
23import qualified Streamly.Internal.Data.Unfold as Unfold
24import qualified Test.Hspec as H
26import Prelude hiding (sequence)
28#if MIN_VERSION_QuickCheck(2,14,0)
30import Test.QuickCheck (chooseAny)
33#else
35import System.Random (Random(random))
36import Test.QuickCheck.Gen (Gen(MkGen))
38-- | Generates a random element over the natural range of `a`.
39chooseAny :: Random a => Gen a
40chooseAny = MkGen (\r _ -> let (x,_) = random r in x)
42#endif
44maxTestCount :: Int
45maxTestCount = 100
47min_value :: Int
48min_value = 0
50mid_value :: Int
51mid_value = 5000
53max_value :: Int
54max_value = 10000
56max_length :: Int
57max_length = 1000
59toList :: Monad m => S.Stream m a -> m [a]
60toList = S.fold FL.toList
62-- Accumulator Tests
64fromFold :: Property
65fromFold =
66 forAll (listOf $ chooseInt (min_value, max_value))
67 $ \ls ->
68 case (==) <$> (S.parseD (P.fromFold FL.sum) (S.fromList ls))
69 <*> (S.fold FL.sum (S.fromList ls)) of
70 Right is_equal -> is_equal
71 Left _ -> False
73fromPure :: Property
74fromPure =
75 forAll (chooseInt (min_value, max_value)) $ \x ->
76 case S.parseD (P.fromPure x) (S.fromList [1 :: Int]) of
77 Right r -> r == x
78 Left _ -> False
80fromEffect :: Property
81fromEffect =
82 forAll (chooseInt (min_value, max_value)) $ \x ->
83 case S.parseD (P.fromEffect $ return x) (S.fromList [1 :: Int]) of
84 Right r -> r == x
85 Left _ -> False
87die :: Property
88die =
89 property $
90 case S.parseD (P.die "die test") (S.fromList [0 :: Int]) of
91 Right _ -> False
92 Left _ -> True
94dieM :: Property
95dieM =
96 property $
97 case S.parseD (P.dieM (Right "die test")) (S.fromList [0 :: Int]) of
98 Right _ -> False
99 Left _ -> True
101-- Element Parser Tests
103peekPass :: Property
104peekPass =
105 forAll (chooseInt (1, max_length)) $ \list_length ->
106 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
107 case S.parseD P.peek (S.fromList ls) of
108 Right head_value -> case ls of
109 head_ls : _ -> head_value == head_ls
110 _ -> False
111 Left _ -> False
113peekFail :: Property
114peekFail =
115 property (case S.parseD P.peek (S.fromList []) of
116 Right _ -> False
117 Left _ -> True)
119eofPass :: Property
120eofPass =
121 property (case S.parseD P.eof (S.fromList []) of
122 Right _ -> True
123 Left _ -> False)
125eofFail :: Property
126eofFail =
127 forAll (chooseInt (1, max_length)) $ \list_length ->
128 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
129 case S.parseD P.eof (S.fromList ls) of
130 Right _ -> False
131 Left _ -> True
133satisfyPass :: Property
134satisfyPass =
135 forAll (chooseInt (mid_value, max_value)) $ \first_element ->
136 forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->
137 let
138 ls = first_element : ls_tail
139 predicate = (>= mid_value)
140 in
141 case S.parseD (P.satisfy predicate) (S.fromList ls) of
142 Right r -> r == first_element
143 Left _ -> False
145satisfy :: Property
146satisfy =
147 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
148 case S.parseD (P.satisfy predicate) (S.fromList ls) of
149 Right r -> case ls of
150 [] -> False
151 (x : _) -> predicate x && (r == x)
152 Left _ -> case ls of
153 [] -> True
154 (x : _) -> not $ predicate x
155 where
156 predicate = (>= mid_value)
158-- Sequence Parsers Tests
159takeBetweenPass :: Property
160takeBetweenPass =
161 forAll (chooseInt (min_value, max_value)) $ \m ->
162 forAll (chooseInt (m, max_value)) $ \n ->
163 forAll (chooseInt (m, max_value)) $ \list_length ->
164 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
165 case S.parseD (P.takeBetween m n FL.toList) (S.fromList ls) of
166 Right parsed_list ->
167 let lpl = Prelude.length parsed_list
168 in checkListEqual parsed_list (Prelude.take lpl ls)
169 Left _ -> property False
172takeBetween :: Property
173takeBetween =
174 forAll (chooseInt (min_value, max_value)) $ \m ->
175 forAll (chooseInt (min_value, max_value)) $ \n ->
176 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
177 let
178 list_length = Prelude.length ls
179 in monadicIO $ do
180 let p = P.takeBetween m n FL.toList
181 r <- run $ try $ S.parseD p (S.fromList ls)
182 return $ case r of
183 Right parsed_list ->
184 if m <= list_length && n >= m
185 then
186 let len = Prelude.length parsed_list
187 in checkListEqual
188 parsed_list (Prelude.take len ls)
189 else property False
190 Left (_ :: SomeException) ->
191 property (m > n || list_length < m)
193take :: Property
194take =
195 forAll (chooseInt (min_value, max_value)) $ \n ->
196 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
197 case S.parseD (P.fromFold $ FL.take n FL.toList) (S.fromList ls) of
198 Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)
199 Left _ -> property False
201takeEQPass :: Property
202takeEQPass =
203 forAll (chooseInt (min_value, max_value)) $ \n ->
204 forAll (chooseInt (n, max_value)) $ \list_length ->
205 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
206 case S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of
207 Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)
208 Left _ -> property False
210takeEQ :: Property
211takeEQ =
212 forAll (chooseInt (min_value, max_value)) $ \n ->
213 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
214 let
215 list_length = Prelude.length ls
216 in
217 case S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of
218 Right parsed_list ->
219 if (n <= list_length) then
220 checkListEqual parsed_list (Prelude.take n ls)
221 else
222 property False
223 Left _ -> property (n > list_length)
225takeGEPass :: Property
226takeGEPass =
227 forAll (chooseInt (min_value, max_value)) $ \n ->
228 forAll (chooseInt (n, max_value)) $ \list_length ->
229 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
230 case S.parseD (P.takeGE n FL.toList) (S.fromList ls) of
231 Right parsed_list -> checkListEqual parsed_list ls
232 Left _ -> property False
234takeGE :: Property
235takeGE =
236 forAll (chooseInt (min_value, max_value)) $ \n ->
237 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
238 let
239 list_length = Prelude.length ls
240 in
241 case S.parseD (P.takeGE n FL.toList) (S.fromList ls) of
242 Right parsed_list ->
243 if (n <= list_length) then
244 checkListEqual parsed_list ls
245 else
246 property False
247 Left _ -> property (n > list_length)
249nLessThanEqual0 ::
250 ( Int
251 -> FL.Fold (Either SomeException) Int [Int]
252 -> P.Parser (Either SomeException) Int [Int]
253 )
254 -> (Int -> [Int] -> [Int])
255 -> Property
256nLessThanEqual0 tk ltk =
257 forAll (elements [0, (-1)]) $ \n ->
258 forAll (listOf arbitrary) $ \ls ->
259 case S.parseD (tk n FL.toList) (S.fromList ls) of
260 Right parsed_list -> checkListEqual parsed_list (ltk n ls)
261 Left _ -> property False
263takeProperties :: Spec
264takeProperties =
265 describe "take combinators when n <= 0/" $ do
266 prop "takeEQ n FL.toList = []" $
267 nLessThanEqual0 P.takeEQ (\_ -> const [])
268 prop "takeGE n FL.toList xs = xs" $
269 nLessThanEqual0 P.takeGE (\_ -> id)
272-- XXX lookAhead can't deal with EOF which in this case means when
273-- n==list_length, this test will fail. So excluding that case for now.
274lookAheadPass :: Property
275lookAheadPass =
276 forAll (chooseInt (min_value, max_value)) $ \n ->
277 let
278 takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList
279 parseTwice = do
280 parsed_list_1 <- takeWithoutConsume
281 parsed_list_2 <- takeWithoutConsume
282 return (parsed_list_1, parsed_list_2)
283 in
284 forAll (chooseInt (n+1, max_value)) $ \list_length ->
285 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
286 case S.parseD parseTwice (S.fromList ls) of
287 Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
288 Left _ -> property $ False
290lookAhead :: Property
291lookAhead =
292 forAll (chooseInt (min_value, max_value)) $ \n ->
293 let
294 takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList
295 parseTwice = do
296 parsed_list_1 <- takeWithoutConsume
297 parsed_list_2 <- takeWithoutConsume
298 return (parsed_list_1, parsed_list_2)
299 in
300 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
301 case S.parseD parseTwice (S.fromList ls) of
302 Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
303 Left _ -> property ((list_length < n) || (list_length == n && n == 0))
304 where
305 list_length = Prelude.length ls
307takeWhile :: Property
308takeWhile =
309 forAll (listOf (chooseInt (0, 1))) $ \ ls ->
310 case S.parseD (P.takeWhile predicate FL.toList) (S.fromList ls) of
311 Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile predicate ls)
312 Left _ -> property False
313 where
314 predicate = (== 0)
316takeWhile1 :: Property
317takeWhile1 =
318 forAll (listOf (chooseInt (0, 1))) $ \ ls ->
319 case S.parseD (P.takeWhile1 predicate FL.toList) (S.fromList ls) of
320 Right parsed_list -> case ls of
321 [] -> property False
322 (x : _) ->
323 if predicate x then
324 checkListEqual parsed_list (Prelude.takeWhile predicate ls)
325 else
326 property False
327 Left _ -> case ls of
328 [] -> property True
329 (x : _) -> property (not $ predicate x)
330 where
331 predicate = (== 0)
333groupBy :: Property
334groupBy =
335 forAll (listOf (chooseInt (0, 1)))
336 $ \ls ->
337 case S.parseD parser (S.fromList ls) of
338 Right parsed -> checkListEqual parsed (groupByLF ls)
339 Left _ -> property False
341 where
343 cmp = (==)
344 parser = P.groupBy cmp FL.toList
345 groupByLF lst
346 | null lst = []
347 | otherwise = head $ List.groupBy cmp lst
349groupByRolling :: Property
350groupByRolling =
351 forAll (listOf (chooseInt (0, 1)))
352 $ \ls ->
353 case S.parseD parser (S.fromList ls) of
354 Right parsed -> checkListEqual parsed (groupByLF Nothing ls)
355 Left _ -> property False
357 where
359 cmp = (==)
360 parser = P.groupBy cmp FL.toList
361 groupByLF _ [] = []
362 groupByLF Nothing (x:xs) = x : groupByLF (Just x) xs
363 groupByLF (Just y) (x:xs) =
364 if cmp y x
365 then x : groupByLF (Just x) xs
366 else []
368takeEndByOrMax :: Property
369takeEndByOrMax =
370 forAll (chooseInt (min_value, max_value)) $ \n ->
371 forAll (listOf (chooseInt (0, 1))) $ \ls ->
372 case S.parseD (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) (S.fromList ls) of
373 Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))
374 Left _ -> property False
375 where
376 predicate = (== 1)
378wordBy :: Property
379wordBy =
380 forAll (listOf (elements [' ', 's']))
381 $ \ls ->
382 case S.parseD parser (S.fromList ls) of
383 Right parsed -> checkListEqual parsed (words' ls)
384 Left _ -> property False
386 where
388 predicate = (== ' ')
389 parser = P.many (P.wordBy predicate FL.toList) FL.toList
390 words' lst =
391 let wrds = words lst
392 in if wrds == [] && length lst > 0 then [""] else wrds
395serialWith :: Property
396serialWith =
397 forAll (listOf (chooseInt (0, 1))) $ \ls ->
398 case S.parseD (P.serialWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of
399 Right (result_first, result_second) -> case ls of
400 0 : 1 : _ -> (result_first == 0) && (result_second == 1)
401 _ -> False
402 Left _ -> case ls of
403 0 : 1 : _ -> False
404 _ -> True
406splitWithFailLeft :: Property
407splitWithFailLeft =
408 property (case S.parseD (P.serialWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
409 Right _ -> False
410 Left _ -> True)
412splitWithFailRight :: Property
413splitWithFailRight =
414 property (case S.parseD (P.serialWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
415 Right _ -> False
416 Left _ -> True)
418splitWithFailBoth :: Property
419splitWithFailBoth =
420 property (case S.parseD (P.serialWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
421 Right _ -> False
422 Left _ -> True)
424{-
425teeWithPass :: Property
426teeWithPass =
427 forAll (chooseInt (min_value, max_value)) $ \n ->
428 forAll (listOf (chooseInt (0, 1))) $ \ls ->
429 let
430 prsr = P.fromFold $ FL.take n FL.toList
431 in
432 case S.parseD (P.teeWith (,) prsr prsr) (S.fromList ls) of
433 Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
434 Left _ -> property False
436teeWithFailLeft :: Property
437teeWithFailLeft =
438 property (case S.parseD (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
439 Right _ -> False
440 Left _ -> True)
442teeWithFailRight :: Property
443teeWithFailRight =
444 property (case S.parseD (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
445 Right _ -> False
446 Left _ -> True)
448teeWithFailBoth :: Property
449teeWithFailBoth =
450 property (case S.parseD (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
451 Right _ -> False
452 Left _ -> True)
454shortestPass :: Property
455shortestPass =
456 forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->
457 let
458 half_mid_value = mid_value `Prelude.div` 2
459 prsr_1 = P.takeWhile (<= half_mid_value) FL.toList
460 prsr_2 = P.takeWhile (<= mid_value) FL.toList
461 prsr_shortest = P.shortest prsr_1 prsr_2
462 in
463 case S.parseD prsr_shortest (S.fromList ls) of
464 Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= half_mid_value) ls)
465 Left _ -> property False
467shortestPassLeft :: Property
468shortestPassLeft =
469 property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
470 Right r -> r == 1
471 Left _ -> False)
473shortestPassRight :: Property
474shortestPassRight =
475 property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
476 Right r -> r == 1
477 Left _ -> False)
479shortestFailBoth :: Property
480shortestFailBoth =
481 property
482 (case S.parseD
483 (P.shortest (P.die "die") (P.die "die"))
484 (S.fromList [1 :: Int]) of
485 Right _ -> False
486 Left _ -> True)
488longestPass :: Property
489longestPass =
490 forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->
491 let
492 half_mid_value = mid_value `Prelude.div` 2
493 prsr_1 = P.takeWhile (<= half_mid_value) FL.toList
494 prsr_2 = P.takeWhile (<= mid_value) FL.toList
495 prsr_longest = P.longest prsr_1 prsr_2
496 in
497 case S.parseD prsr_longest (S.fromList ls) of
498 Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls
499 Left _ -> False
501longestPassLeft :: Property
502longestPassLeft =
503 property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
504 Right r -> r == 1
505 Left _ -> False)
507longestPassRight :: Property
508longestPassRight =
509 property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
510 Right r -> r == 1
511 Left _ -> False)
513longestFailBoth :: Property
514longestFailBoth =
515 property
516 (case S.parseD (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
517 Right _ -> False
518 Left _ -> True)
519-}
521many :: Property
522many =
523 forAll (listOf (chooseInt (0, 1)))
524 $ \ls ->
525 let fldstp conL currL = return $ FL.Partial (conL ++ currL)
526 concatFold =
527 FL.Fold fldstp (return (FL.Partial [])) return
528 prsr =
529 flip P.many concatFold
530 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
531 in case S.parseD prsr (S.fromList ls) of
532 Right res_list ->
533 checkListEqual res_list (Prelude.filter (== 0) ls)
534 Left _ -> property False
536many_empty :: Property
537many_empty =
538 property (case S.parseD (flip P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
539 Right res_list -> checkListEqual res_list ([] :: [Int])
540 Left _ -> property False)
542some :: Property
543some =
544 forAll (listOf (chooseInt (0, 1)))
545 $ \ls ->
546 let fldstp conL currL = return $ FL.Partial $ conL ++ currL
547 concatFold = FL.Fold fldstp (return (FL.Partial [])) return
548 prsr =
549 flip P.some concatFold
550 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
551 in case S.parseD prsr (S.fromList ls) of
552 Right res_list -> res_list == Prelude.filter (== 0) ls
553 Left _ -> False
555someFail :: Property
556someFail =
557 property (case S.parseD (P.some (P.die "die") FL.toList) (S.fromList [1 :: Int]) of
558 Right _ -> False
559 Left _ -> True)
561-------------------------------------------------------------------------------
562-- Instances
563-------------------------------------------------------------------------------
565applicative :: Property
566applicative =
567 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
568 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
569 let parser =
570 (,)
571 <$> P.fromFold (FL.take (length list1) FL.toList)
572 <*> P.fromFold (FL.take (length list2) FL.toList)
573 in monadicIO $ do
574 (olist1, olist2) <-
575 run $ S.parseD parser (S.fromList $ list1 ++ list2)
576 listEquals (==) olist1 list1
577 listEquals (==) olist2 list2
579sequence :: Property
580sequence =
581 forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->
582 let parsers = fmap (\xs -> P.fromFold $ FL.take (length xs) FL.toList) ins
583 in monadicIO $ do
584 outs <- run $
585 S.parseD
586 (Prelude.sequence parsers)
587 (S.fromList $ concat ins)
588 listEquals (==) outs ins
590altEOF1 :: Expectation
591altEOF1 =
592 S.parseD
593 (P.satisfy (> 0) <|> return 66)
594 (S.fromList ([]::[Int]))
595 `shouldReturn` 66
597altEOF2 :: Expectation
598altEOF2 =
599 S.parseD
600 ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList))
601 (S.fromList ([51]::[Int]))
602 `shouldReturn` [51]
604monad :: Property
605monad =
606 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
607 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
608 let parser = do
609 olist1 <- P.fromFold (FL.take (length list1) FL.toList)
610 olist2 <- P.fromFold (FL.take (length list2) FL.toList)
611 return (olist1, olist2)
612 in monadicIO $ do
613 (olist1, olist2) <-
614 run $ S.parseD parser (S.fromList $ list1 ++ list2)
615 listEquals (==) olist1 list1
616 listEquals (==) olist2 list2
618-------------------------------------------------------------------------------
619-- Stream parsing
620-------------------------------------------------------------------------------
622parseMany :: Property
623parseMany =
624 forAll (chooseInt (1,100)) $ \len ->
625 forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
626 monadicIO $ do
627 outs <-
628 ( run
629 $ toList
630 $ S.parseManyD
631 (P.fromFold $ FL.take len FL.toList) (S.fromList $ concat ins)
632 )
633 listEquals (==) outs ins
635-- basic sanity test for parsing from arrays
636parseUnfold :: Property
637parseUnfold = do
638 let len = 200
639 -- ls = input list (stream)
640 -- clen = chunk size
641 -- tlen = parser take size
642 forAll
643 ((,,)
644 <$> vectorOf len (chooseAny :: Gen Int)
645 <*> chooseInt (1, len)
646 <*> chooseInt (1, len)) $ \(ls, clen, tlen) ->
647 monadicIO $ do
648 arrays <- toList $ S.arraysOf clen (S.fromList ls)
649 let src = Source.source (Just (Producer.OuterLoop arrays))
650 let parser = P.fromFold (FL.take tlen FL.toList)
651 let readSrc =
652 Source.producer
653 $ Producer.concat Producer.fromList A.producer
654 let streamParser =
655 Producer.simplify (Source.parseManyD parser readSrc)
656 xs <- run
657 $ toList
658 $ S.unfoldMany Unfold.fromList
659 $ S.unfold streamParser src
661 listEquals (==) xs ls
663parserSequence :: Property
664parserSequence =
665 forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ins ->
666 monadicIO $ do
667 let parsers = D.fromList
668 $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins
669 let sequencedParser = P.sequence parsers FL.sum
670 outs <-
671 run $
672 S.parseD sequencedParser $ S.concatMap S.fromList (S.fromList ins)
673 equals (==) outs (sum $ map sum ins)
675-------------------------------------------------------------------------------
676-- Test for a particular case hit during fs events testing
677-------------------------------------------------------------------------------
679evId :: [Word8]
680evId = [96,238,17,9,0,0,0,0]
682evFlags :: [Word8]
683evFlags = [0,4,1,0,0,0,0,0]
685evPathLen :: [Word8]
686evPathLen = [71,0,0,0,0,0,0,0]
688evPath :: [Word8]
689evPath =
690 [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109
691 ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112
692 ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116
693 ,114,101,97,109,108,121,47,116,109,112,47,122,122
694 ]
696event :: [Word8]
697event = evId ++ evFlags ++ evPathLen ++ evPath
699data Event = Event
700 { eventId :: Word64
701 , eventFlags :: Word32
702 , eventAbsPath :: A.Array Word8
703 } deriving (Show, Ord, Eq)
705readOneEvent :: P.Parser IO Word8 Event
706readOneEvent = do
707 arr <- P.takeEQ 24 (A.writeN 24)
708 let arr1 = A.castUnsafe arr :: A.Array Word64
709 eid = A.unsafeIndex 0 arr1
710 eflags = A.unsafeIndex 1 arr1
711 pathLen = fromIntegral $ A.unsafeIndex 2 arr1
712 path <- P.takeEQ pathLen (A.writeN pathLen)
713 return $ Event
714 { eventId = eid
715 , eventFlags = fromIntegral eflags
716 , eventAbsPath = path
717 }
719parseMany2Events :: Property
720parseMany2Events =
721 monadicIO $ do
722 xs <-
723 ( run
724 $ toList
725 $ S.parseManyD readOneEvent
726 $ S.fromList (concat (replicate 2 event))
727 )
728 assert (length xs == 2)
729 -- XXX assuming little endian machine
730 let ev = Event
731 { eventId = 152170080
732 , eventFlags = 66560
733 , eventAbsPath = A.fromList evPath
734 }
735 in listEquals (==) xs (replicate 2 ev)
737-------------------------------------------------------------------------------
738-- Main
739-------------------------------------------------------------------------------
741moduleName :: String
742moduleName = "Data.Parser.ParserD"
744main :: IO ()
745main =
746 hspec $
747 H.parallel $
748 modifyMaxSuccess (const maxTestCount) $ do
749 describe moduleName $ do
751 describe "Instances" $ do
752 prop "applicative" applicative
753 it "Alternative: end of input 1" altEOF1
754 it "Alternative: end of input 2" altEOF2
755 prop "monad" monad
756 prop "sequence" sequence
758 describe "Stream parsing" $ do
759 prop "parseMany" parseMany
760 prop "parseMany2Events" parseMany2Events
761 prop "parseUnfold" parseUnfold
762 prop "parserSequence" parserSequence
764 describe "test for accumulator" $ do
765 prop "P.fromFold FL.sum = FL.sum" fromFold
766 prop "fromPure value provided" fromPure
767 prop "fromPure monadic value provided" fromEffect
768 prop "always fail" die
769 prop "always fail but monadic" dieM
771 describe "test for element parser" $ do
772 prop "peek = head with list length > 0" peekPass
773 prop "peek fail on []" peekFail
774 prop "eof pass on []" eofPass
775 prop "eof fail on non-empty list" eofFail
776 prop "first element exists and >= mid_value" satisfyPass
777 prop "check first element exists and satisfies predicate" satisfy
779 describe "test for sequence parser" $ do
780 prop "P.takeBetween m n = Prelude.take when len >= m and len <= n"
781 takeBetweenPass
782 prop ("P.takeBetween m n = Prelude.take when len >= m and len <= n and"
783 ++ " fail otherwise") takeBetween
784 prop "P.take = Prelude.take" Main.take
785 prop "P.takeEQ = Prelude.take when len >= n" takeEQPass
786 prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" Main.takeEQ
787 prop "P.takeGE n ls = ls when len >= n" takeGEPass
788 prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE
789 prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass
790 prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
791 prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
792 prop "P.takeWhile1 = Prelude.takeWhile if taken something, else check why failed" takeWhile1
793 prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy
794 prop "groupByRolling" groupByRolling
795 prop "P.takeEndByOrMax = Prelude.take n (Prelude.takeWhile (not . predicate)" takeEndByOrMax
796 prop "many (P.wordBy ' ') = words'" wordBy
797 prop "parse 0, then 1, else fail" serialWith
798 prop "fail due to die as left parser" splitWithFailLeft
799 prop "fail due to die as right parser" splitWithFailRight
800 prop "fail due to die as both parsers" splitWithFailBoth
801 {-
802 prop "parsed two lists should be equal" teeWithPass
803 prop "fail due to die as left parser" teeWithFailLeft
804 prop "fail due to die as right parser" teeWithFailRight
805 prop "fail due to die as both parsers" teeWithFailBoth
806 prop "P.takeWhile (<= half_mid_value) = Prelude.takeWhile half_mid_value" shortestPass
807 prop "pass even if die is left parser" shortestPassLeft
808 prop "pass even if die is right parser" shortestPassRight
809 prop "fail due to die as both parsers" shortestFailBoth
810 prop "P.takeWhile (<= mid_value) = Prelude.takeWhile (<= mid_value)" longestPass
811 prop "pass even if die is left parser" longestPassLeft
812 prop "pass even if die is right parser" longestPassRight
813 prop "fail due to die as both parsers" longestFailBoth
814 -}
815 prop "P.many concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" many
816 prop "[] due to parser being die" many_empty
817 prop "P.some concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" some
818 prop "fail due to parser being die" someFail
819 takeProperties