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