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