git.iko.soy/streamly
on ffcb268 help sign in
streamly/test/Streamly/Test/Data/Parser/ParserD.hs
836 lines 31 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)
7import Test.Hspec (Spec, hspec, describe)
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 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)
31import Control.Monad.Identity (runIdentity, Identity (Identity))
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 (==) <$> runIdentity (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 runIdentity $ 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 runIdentity $ 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 runIdentity (S.parseD (P.die "die test") (S.fromList [0 :: Int])) of
91 Right _ -> False
92 Left _ -> True
94dieM :: Property
95dieM =
96 property $
97 case runIdentity (S.parseD (P.dieM (Identity "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 runIdentity $ 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 runIdentity $ 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 runIdentity $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 runIdentity $ 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 runIdentity $ 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 runIdentity $ 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 x -> case x of
184 Right parsed_list ->
185 if m <= list_length && n >= m
186 then
187 let len = Prelude.length parsed_list
188 in checkListEqual
189 parsed_list (Prelude.take len ls)
190 else property False
191 Left _ ->
192 property (m > n || list_length < m)
193 Left (_ :: SomeException) ->
194 property (m > n || list_length < m)
196take :: Property
197take =
198 forAll (chooseInt (min_value, max_value)) $ \n ->
199 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
200 case runIdentity $ S.parseD (P.fromFold $ FL.take n FL.toList) (S.fromList ls) of
201 Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)
202 Left _ -> property False
204takeEQPass :: Property
205takeEQPass =
206 forAll (chooseInt (min_value, max_value)) $ \n ->
207 forAll (chooseInt (n, max_value)) $ \list_length ->
208 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
209 case runIdentity $ S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of
210 Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)
211 Left _ -> property False
213takeEQ :: Property
214takeEQ =
215 forAll (chooseInt (min_value, max_value)) $ \n ->
216 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
217 let
218 list_length = Prelude.length ls
219 in
220 case runIdentity $ S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of
221 Right parsed_list ->
222 if (n <= list_length) then
223 checkListEqual parsed_list (Prelude.take n ls)
224 else
225 property False
226 Left _ -> property (n > list_length)
228takeGEPass :: Property
229takeGEPass =
230 forAll (chooseInt (min_value, max_value)) $ \n ->
231 forAll (chooseInt (n, max_value)) $ \list_length ->
232 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
233 case runIdentity $ S.parseD (P.takeGE n FL.toList) (S.fromList ls) of
234 Right parsed_list -> checkListEqual parsed_list ls
235 Left _ -> property False
237takeGE :: Property
238takeGE =
239 forAll (chooseInt (min_value, max_value)) $ \n ->
240 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
241 let
242 list_length = Prelude.length ls
243 in
244 case runIdentity $ S.parseD (P.takeGE n FL.toList) (S.fromList ls) of
245 Right parsed_list ->
246 if (n <= list_length) then
247 checkListEqual parsed_list ls
248 else
249 property False
250 Left _ -> property (n > list_length)
252nLessThanEqual0 ::
253 ( Int
254 -> FL.Fold Identity Int [Int]
255 -> P.Parser Int Identity [Int]
256 )
257 -> (Int -> [Int] -> [Int])
258 -> Property
259nLessThanEqual0 tk ltk =
260 forAll (elements [0, (-1)]) $ \n ->
261 forAll (listOf arbitrary) $ \ls ->
262 case runIdentity $ S.parseD (tk n FL.toList) (S.fromList ls) of
263 Right parsed_list -> checkListEqual parsed_list (ltk n ls)
264 Left _ -> property False
266takeProperties :: Spec
267takeProperties =
268 describe "take combinators when n <= 0/" $ do
269 prop "takeEQ n FL.toList = []" $
270 nLessThanEqual0 P.takeEQ (\_ -> const [])
271 prop "takeGE n FL.toList xs = xs" $
272 nLessThanEqual0 P.takeGE (\_ -> id)
275-- XXX lookAhead can't deal with EOF which in this case means when
276-- n==list_length, this test will fail. So excluding that case for now.
277lookAheadPass :: Property
278lookAheadPass =
279 forAll (chooseInt (min_value, max_value)) $ \n ->
280 let
281 takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList
282 parseTwice = do
283 parsed_list_1 <- takeWithoutConsume
284 parsed_list_2 <- takeWithoutConsume
285 return (parsed_list_1, parsed_list_2)
286 in
287 forAll (chooseInt (n+1, max_value)) $ \list_length ->
288 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
289 case runIdentity $ S.parseD parseTwice (S.fromList ls) of
290 Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
291 Left _ -> property $ False
293lookAhead :: Property
294lookAhead =
295 forAll (chooseInt (min_value, max_value)) $ \n ->
296 let
297 takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList
298 parseTwice = do
299 parsed_list_1 <- takeWithoutConsume
300 parsed_list_2 <- takeWithoutConsume
301 return (parsed_list_1, parsed_list_2)
302 in
303 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
304 case runIdentity $ S.parseD parseTwice (S.fromList ls) of
305 Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
306 Left _ -> property ((list_length < n) || (list_length == n && n == 0))
307 where
308 list_length = Prelude.length ls
310takeWhile :: Property
311takeWhile =
312 forAll (listOf (chooseInt (0, 1))) $ \ ls ->
313 case runIdentity $ S.parseD (P.takeWhile predicate FL.toList) (S.fromList ls) of
314 Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile predicate ls)
315 Left _ -> property False
316 where
317 predicate = (== 0)
319takeWhile1 :: Property
320takeWhile1 =
321 forAll (listOf (chooseInt (0, 1))) $ \ ls ->
322 case runIdentity $ S.parseD (P.takeWhile1 predicate FL.toList) (S.fromList ls) of
323 Right parsed_list -> case ls of
324 [] -> property False
325 (x : _) ->
326 if predicate x then
327 checkListEqual parsed_list (Prelude.takeWhile predicate ls)
328 else
329 property False
330 Left _ -> case ls of
331 [] -> property True
332 (x : _) -> property (not $ predicate x)
333 where
334 predicate = (== 0)
336groupBy :: Property
337groupBy =
338 forAll (listOf (chooseInt (0, 1)))
339 $ \ls ->
340 case runIdentity $ S.parseD parser (S.fromList ls) of
341 Right parsed -> checkListEqual parsed (groupByLF ls)
342 Left _ -> property False
344 where
346 cmp = (==)
347 parser = P.groupBy cmp FL.toList
348 groupByLF lst
349 | null lst = []
350 | otherwise = head $ List.groupBy cmp lst
352groupByRolling :: Property
353groupByRolling =
354 forAll (listOf (chooseInt (0, 1)))
355 $ \ls ->
356 case runIdentity $ S.parseD parser (S.fromList ls) of
357 Right parsed -> checkListEqual parsed (groupByLF Nothing ls)
358 Left _ -> property False
360 where
362 cmp = (==)
363 parser = P.groupBy cmp FL.toList
364 groupByLF _ [] = []
365 groupByLF Nothing (x:xs) = x : groupByLF (Just x) xs
366 groupByLF (Just y) (x:xs) =
367 if cmp y x
368 then x : groupByLF (Just x) xs
369 else []
371takeEndByOrMax :: Property
372takeEndByOrMax =
373 forAll (chooseInt (min_value, max_value)) $ \n ->
374 forAll (listOf (chooseInt (0, 1))) $ \ls ->
375 case runIdentity $ S.parseD (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) (S.fromList ls) of
376 Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))
377 Left _ -> property False
378 where
379 predicate = (== 1)
381wordBy :: Property
382wordBy =
383 forAll (listOf (elements [' ', 's']))
384 $ \ls ->
385 case runIdentity $ S.parseD parser (S.fromList ls) of
386 Right parsed -> checkListEqual parsed (words' ls)
387 Left _ -> property False
389 where
391 predicate = (== ' ')
392 parser = P.many (P.wordBy predicate FL.toList) FL.toList
393 words' lst =
394 let wrds = words lst
395 in if wrds == [] && length lst > 0 then [""] else wrds
398splitWith :: Property
399splitWith =
400 forAll (listOf (chooseInt (0, 1))) $ \ls ->
401 case runIdentity $ S.parseD (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of
402 Right (result_first, result_second) -> case ls of
403 0 : 1 : _ -> (result_first == 0) && (result_second == 1)
404 _ -> False
405 Left _ -> case ls of
406 0 : 1 : _ -> False
407 _ -> True
409splitWithFailLeft :: Property
410splitWithFailLeft =
411 property (case runIdentity $ S.parseD (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
412 Right _ -> False
413 Left _ -> True)
415splitWithFailRight :: Property
416splitWithFailRight =
417 property (case runIdentity $ S.parseD (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
418 Right _ -> False
419 Left _ -> True)
421splitWithFailBoth :: Property
422splitWithFailBoth =
423 property (case runIdentity $ S.parseD (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
424 Right _ -> False
425 Left _ -> True)
427{-
428teeWithPass :: Property
429teeWithPass =
430 forAll (chooseInt (min_value, max_value)) $ \n ->
431 forAll (listOf (chooseInt (0, 1))) $ \ls ->
432 let
433 prsr = P.fromFold $ FL.take n FL.toList
434 in
435 case S.parseD (P.teeWith (,) prsr prsr) (S.fromList ls) of
436 Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
437 Left _ -> property False
439teeWithFailLeft :: Property
440teeWithFailLeft =
441 property (case S.parseD (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
442 Right _ -> False
443 Left _ -> True)
445teeWithFailRight :: Property
446teeWithFailRight =
447 property (case S.parseD (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
448 Right _ -> False
449 Left _ -> True)
451teeWithFailBoth :: Property
452teeWithFailBoth =
453 property (case S.parseD (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
454 Right _ -> False
455 Left _ -> True)
457shortestPass :: Property
458shortestPass =
459 forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->
460 let
461 half_mid_value = mid_value `Prelude.div` 2
462 prsr_1 = P.takeWhile (<= half_mid_value) FL.toList
463 prsr_2 = P.takeWhile (<= mid_value) FL.toList
464 prsr_shortest = P.shortest prsr_1 prsr_2
465 in
466 case S.parseD prsr_shortest (S.fromList ls) of
467 Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= half_mid_value) ls)
468 Left _ -> property False
470shortestPassLeft :: Property
471shortestPassLeft =
472 property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
473 Right r -> r == 1
474 Left _ -> False)
476shortestPassRight :: Property
477shortestPassRight =
478 property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
479 Right r -> r == 1
480 Left _ -> False)
482shortestFailBoth :: Property
483shortestFailBoth =
484 property
485 (case S.parseD
486 (P.shortest (P.die "die") (P.die "die"))
487 (S.fromList [1 :: Int]) of
488 Right _ -> False
489 Left _ -> True)
491longestPass :: Property
492longestPass =
493 forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->
494 let
495 half_mid_value = mid_value `Prelude.div` 2
496 prsr_1 = P.takeWhile (<= half_mid_value) FL.toList
497 prsr_2 = P.takeWhile (<= mid_value) FL.toList
498 prsr_longest = P.longest prsr_1 prsr_2
499 in
500 case S.parseD prsr_longest (S.fromList ls) of
501 Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls
502 Left _ -> False
504longestPassLeft :: Property
505longestPassLeft =
506 property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
507 Right r -> r == 1
508 Left _ -> False)
510longestPassRight :: Property
511longestPassRight =
512 property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
513 Right r -> r == 1
514 Left _ -> False)
516longestFailBoth :: Property
517longestFailBoth =
518 property
519 (case S.parseD (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
520 Right _ -> False
521 Left _ -> True)
522-}
524many :: Property
525many =
526 forAll (listOf (chooseInt (0, 1)))
527 $ \ls ->
528 let fldstp conL currL = return $ FL.Partial (conL ++ currL)
529 concatFold =
530 FL.Fold fldstp (return (FL.Partial [])) return
531 prsr =
532 flip P.many concatFold
533 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
534 in case runIdentity $ S.parseD prsr (S.fromList ls) of
535 Right res_list ->
536 checkListEqual res_list (Prelude.filter (== 0) ls)
537 Left _ -> property False
539many_empty :: Property
540many_empty =
541 property (case runIdentity $ S.parseD (flip P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
542 Right res_list -> checkListEqual res_list ([] :: [Int])
543 Left _ -> property False)
545some :: Property
546some =
547 forAll (listOf (chooseInt (0, 1)))
548 $ \ls ->
549 let fldstp conL currL = return $ FL.Partial $ conL ++ currL
550 concatFold = FL.Fold fldstp (return (FL.Partial [])) return
551 prsr =
552 flip P.some concatFold
553 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
554 in case runIdentity $ S.parseD prsr (S.fromList ls) of
555 Right res_list -> res_list == Prelude.filter (== 0) ls
556 Left _ -> False
558someFail :: Property
559someFail =
560 property (case runIdentity $ S.parseD (P.some (P.die "die") FL.toList) (S.fromList [1 :: Int]) of
561 Right _ -> False
562 Left _ -> True)
564-------------------------------------------------------------------------------
565-- Instances
566-------------------------------------------------------------------------------
568applicative :: Property
569applicative =
570 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
571 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
572 monadicIO $ do
573 let parser =
574 (,)
575 <$> P.fromFold (FL.take (length list1) FL.toList)
576 <*> P.fromFold (FL.take (length list2) FL.toList)
578 return $
579 case runIdentity $ S.parseD parser (S.fromList $ list1 ++ list2) of
580 Right (olist1, olist2) -> olist1 == list1 && olist2 == list2
581 Left _ -> False
583sequence :: Property
584sequence =
585 forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->
586 monadicIO $ do
587 let parsers = fmap (\xs -> P.fromFold $ FL.take (length xs) FL.toList) ins
588 outs <- S.parseD
589 (Prelude.sequence parsers)
590 (S.fromList $ concat ins)
591 return $
592 case outs of
593 Right x -> x == ins
594 Left _ -> False
596altEOF1 :: Property
597altEOF1 =
598 monadicIO $ do
599 s1 <- S.parseD
600 (P.satisfy (> 0) <|> return 66)
601 (S.fromList ([]::[Int]))
602 return $
603 case s1 of
604 Right x -> x == 66
605 Left _ -> False
607altEOF2 :: Property
608altEOF2 =
609 monadicIO $ do
610 s1 <- S.parseD
611 ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList))
612 (S.fromList ([51]::[Int]))
613 return $
614 case s1 of
615 Right x -> x == [51]
616 Left _ -> False
618monad :: Property
619monad =
620 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
621 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
622 monadicIO $ do
623 let parser = do
624 olist1 <- P.fromFold (FL.take (length list1) FL.toList)
625 olist2 <- P.fromFold (FL.take (length list2) FL.toList)
626 return (olist1, olist2)
627 s1 <- S.parseD parser (S.fromList $ list1 ++ list2)
628 return $
629 case s1 of
630 Right (olist1, olist2) -> olist1 == list1 && olist2 == list2
631 Left _ -> False
633-------------------------------------------------------------------------------
634-- Stream parsing
635-------------------------------------------------------------------------------
637parseMany :: Property
638parseMany =
639 forAll (chooseInt (1,100)) $ \len ->
640 forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
641 monadicIO $ do
642 outs <-
643 (toList $ S.catRights $ S.parseManyD
644 (P.fromFold $ FL.take len FL.toList) (S.fromList $ concat ins)
645 )
646 return $ outs == ins
648-- basic sanity test for parsing from arrays
649parseUnfold :: Property
650parseUnfold = do
651 let len = 200
652 -- ls = input list (stream)
653 -- clen = chunk size
654 -- tlen = parser take size
655 forAll
656 ((,,)
657 <$> vectorOf len (chooseAny :: Gen Int)
658 <*> chooseInt (1, len)
659 <*> chooseInt (1, len)) $ \(ls, clen, tlen) ->
660 monadicIO $ do
661 arrays <- toList $ S.arraysOf clen (S.fromList ls)
662 let src = Source.source (Just (Producer.OuterLoop arrays))
663 let parser = P.fromFold (FL.take tlen FL.toList)
664 let readSrc =
665 Source.producer
666 $ Producer.concat Producer.fromList A.producer
667 let streamParser =
668 Producer.simplify (Source.parseManyD parser readSrc)
669 xs <- run
670 $ toList
671 $ S.unfoldMany Unfold.fromList
672 $ S.catRights
673 $ S.unfold streamParser src
675 listEquals (==) xs ls
677parserSequence :: Property
678parserSequence =
679 forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ins ->
680 monadicIO $ do
681 let parsers = D.fromList
682 $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins
683 let sequencedParser = P.sequence parsers FL.sum
684 outs <-
685 S.parseD sequencedParser $ S.concatMap S.fromList (S.fromList ins)
686 return $
687 case outs of
688 Right x -> x == sum (map sum ins)
689 Left _ -> False
691-------------------------------------------------------------------------------
692-- Test for a particular case hit during fs events testing
693-------------------------------------------------------------------------------
695evId :: [Word8]
696evId = [96,238,17,9,0,0,0,0]
698evFlags :: [Word8]
699evFlags = [0,4,1,0,0,0,0,0]
701evPathLen :: [Word8]
702evPathLen = [71,0,0,0,0,0,0,0]
704evPath :: [Word8]
705evPath =
706 [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109
707 ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112
708 ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116
709 ,114,101,97,109,108,121,47,116,109,112,47,122,122
710 ]
712event :: [Word8]
713event = evId ++ evFlags ++ evPathLen ++ evPath
715data Event = Event
716 { eventId :: Word64
717 , eventFlags :: Word32
718 , eventAbsPath :: A.Array Word8
719 } deriving (Show, Ord, Eq)
721readOneEvent :: P.Parser Word8 IO Event
722readOneEvent = do
723 arr <- P.takeEQ 24 (A.writeN 24)
724 let arr1 = A.castUnsafe arr :: A.Array Word64
725 eid = A.unsafeIndex 0 arr1
726 eflags = A.unsafeIndex 1 arr1
727 pathLen = fromIntegral $ A.unsafeIndex 2 arr1
728 path <- P.takeEQ pathLen (A.writeN pathLen)
729 return $ Event
730 { eventId = eid
731 , eventFlags = fromIntegral eflags
732 , eventAbsPath = path
733 }
735parseMany2Events :: Property
736parseMany2Events =
737 monadicIO $ do
738 xs <-
739 ( run
740 $ toList
741 $ S.catRights
742 $ S.parseManyD readOneEvent
743 $ S.fromList (concat (replicate 2 event))
744 )
745 assert (length xs == 2)
746 -- XXX assuming little endian machine
747 let ev = Event
748 { eventId = 152170080
749 , eventFlags = 66560
750 , eventAbsPath = A.fromList evPath
751 }
752 in listEquals (==) xs (replicate 2 ev)
754-------------------------------------------------------------------------------
755-- Main
756-------------------------------------------------------------------------------
758moduleName :: String
759moduleName = "Data.Parser.ParserD"
761main :: IO ()
762main =
763 hspec $
764 H.parallel $
765 modifyMaxSuccess (const maxTestCount) $ do
766 describe moduleName $ do
768 describe "Instances" $ do
769 prop "applicative" applicative
770 prop "Alternative: end of input 1" altEOF1
771 prop "Alternative: end of input 2" altEOF2
772 prop "monad" monad
773 prop "sequence" sequence
775 describe "Stream parsing" $ do
776 prop "parseMany" parseMany
777 prop "parseMany2Events" parseMany2Events
778 prop "parseUnfold" parseUnfold
779 prop "parserSequence" parserSequence
781 describe "test for accumulator" $ do
782 prop "P.fromFold FL.sum = FL.sum" fromFold
783 prop "fromPure value provided" fromPure
784 prop "fromPure monadic value provided" fromEffect
785 prop "always fail" die
786 prop "always fail but monadic" dieM
788 describe "test for element parser" $ do
789 prop "peek = head with list length > 0" peekPass
790 prop "peek fail on []" peekFail
791 prop "eof pass on []" eofPass
792 prop "eof fail on non-empty list" eofFail
793 prop "first element exists and >= mid_value" satisfyPass
794 prop "check first element exists and satisfies predicate" satisfy
796 describe "test for sequence parser" $ do
797 prop "P.takeBetween m n = Prelude.take when len >= m and len <= n"
798 takeBetweenPass
799 prop ("P.takeBetween m n = Prelude.take when len >= m and len <= n and"
800 ++ " fail otherwise") takeBetween
801 prop "P.take = Prelude.take" Main.take
802 prop "P.takeEQ = Prelude.take when len >= n" takeEQPass
803 prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" Main.takeEQ
804 prop "P.takeGE n ls = ls when len >= n" takeGEPass
805 prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE
806 prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass
807 prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
808 prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
809 prop "P.takeWhile1 = Prelude.takeWhile if taken something, else check why failed" takeWhile1
810 prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy
811 prop "groupByRolling" groupByRolling
812 prop "P.takeEndByOrMax = Prelude.take n (Prelude.takeWhile (not . predicate)" takeEndByOrMax
813 prop "many (P.wordBy ' ') = words'" wordBy
814 prop "parse 0, then 1, else fail" splitWith
815 prop "fail due to die as left parser" splitWithFailLeft
816 prop "fail due to die as right parser" splitWithFailRight
817 prop "fail due to die as both parsers" splitWithFailBoth
818 {-
819 prop "parsed two lists should be equal" teeWithPass
820 prop "fail due to die as left parser" teeWithFailLeft
821 prop "fail due to die as right parser" teeWithFailRight
822 prop "fail due to die as both parsers" teeWithFailBoth
823 prop "P.takeWhile (<= half_mid_value) = Prelude.takeWhile half_mid_value" shortestPass
824 prop "pass even if die is left parser" shortestPassLeft
825 prop "pass even if die is right parser" shortestPassRight
826 prop "fail due to die as both parsers" shortestFailBoth
827 prop "P.takeWhile (<= mid_value) = Prelude.takeWhile (<= mid_value)" longestPass
828 prop "pass even if die is left parser" longestPassLeft
829 prop "pass even if die is right parser" longestPassRight
830 prop "fail due to die as both parsers" longestFailBoth
831 -}
832 prop "P.many concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" many
833 prop "[] due to parser being die" many_empty
834 prop "P.some concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" some
835 prop "fail due to parser being die" someFail
836 takeProperties