git.iko.soy/streamly
on 30c98dc help sign in
streamly/test/Streamly/Test/Data/Parser.hs
1220 lines 44 kB history raw
1module Main (main) where
3import Control.Exception (SomeException(..), displayException, try)
4import Data.Foldable (for_)
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, property, listOf,
11 vectorOf, Gen)
12import Test.QuickCheck.Monadic (monadicIO, assert, run)
14import Prelude hiding (sequence)
16import qualified Data.List as List
17import qualified Prelude
18import qualified Streamly.Internal.Data.Array.Unboxed as A
19import qualified Streamly.Internal.Data.Fold as FL
20import qualified Streamly.Internal.Data.Parser as P
21import qualified Streamly.Internal.Data.Stream as S
22import qualified Test.Hspec as H
24#if MIN_VERSION_QuickCheck(2,14,0)
26import Test.QuickCheck (chooseAny)
28#else
30import System.Random (Random(random))
31import Test.QuickCheck.Gen (Gen(MkGen))
33-- | Generates a random element over the natural range of `a`.
34chooseAny :: Random a => Gen a
35chooseAny = MkGen (\r _ -> let (x,_) = random r in x)
37#endif
39maxTestCount :: Int
40maxTestCount = 100
42min_value :: Int
43min_value = 0
45mid_value :: Int
46mid_value = 5000
48max_value :: Int
49max_value = 10000
51max_length :: Int
52max_length = 1000
54-- Accumulator Tests
56fromFold :: Property
57fromFold =
58 forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
59 case (==) <$> S.parse (P.fromFold FL.sum) (S.fromList ls)
60 <*> S.fold FL.sum (S.fromList ls) of
61 Right is_equal -> is_equal
62 Left _ -> False
64fromPure :: Property
65fromPure =
66 forAll (chooseInt (min_value, max_value)) $ \x ->
67 case S.parse (P.fromPure x) (S.fromList [1 :: Int]) of
68 Right r -> r == x
69 Left _ -> False
71fromEffect :: Property
72fromEffect =
73 forAll (chooseInt (min_value, max_value)) $ \x ->
74 case S.parse (P.fromEffect $ return x) (S.fromList [1 :: Int]) of
75 Right r -> r == x
76 Left _ -> False
78die :: Property
79die =
80 property $
81 case S.parse (P.die "die test") (S.fromList [0 :: Int]) of
82 Right _ -> False
83 Left _ -> True
85dieM :: Property
86dieM =
87 property $
88 case S.parse (P.dieM (Right "die test")) (S.fromList [0 :: Int]) of
89 Right _ -> False
90 Left _ -> True
92parserFail :: Property
93parserFail =
94 property $
95 case S.parse (fail err) (S.fromList [0 :: Int]) of
96 Right _ -> False
97 Left (SomeException e) -> err == displayException e
98 where
99 err = "Testing MonadFail.fail."
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.parse 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.parse P.peek (S.fromList []) of
116 Right _ -> False
117 Left _ -> True)
119eofPass :: Property
120eofPass =
121 property (case S.parse 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.parse 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.parse (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.parse (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)
158onePass :: Property
159onePass =
160 forAll (chooseInt (1, max_value)) $ \int ->
161 property (case S.parse P.one (S.fromList [int]) of
162 Right i -> i == int
163 Left _ -> False)
165one :: Property
166one =
167 property (case S.parse P.one (S.fromList []) of
168 Left _ -> True
169 Right _ -> False)
171-- Sequence Parsers Tests
172takeBetweenPass :: Property
173takeBetweenPass =
174 forAll (chooseInt (min_value, max_value)) $ \m ->
175 forAll (chooseInt (m, max_value)) $ \n ->
176 forAll (chooseInt (m, max_value)) $ \list_length ->
177 forAll (vectorOf list_length (chooseInt (min_value, max_value)))
178 $ \ls ->
179 case S.parse (P.takeBetween m n FL.toList)
180 (S.fromList ls) of
181 Right parsed_list ->
182 let lpl = Prelude.length parsed_list
183 in checkListEqual parsed_list
184 $ Prelude.take lpl ls
185 Left _ -> property False
187takeBetween :: Property
188takeBetween =
189 forAll (chooseInt (min_value, max_value)) $ \m ->
190 forAll (chooseInt (min_value, max_value)) $ \n ->
191 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
192 go m n ls
194 where
196 go m n ls =
197 let inputLen = Prelude.length ls
198 in monadicIO $ do
199 let p = P.takeBetween m n FL.toList
200 r <- run $ try $ S.parse p (S.fromList ls)
201 return $ case r of
202 Right xs ->
203 let parsedLen = Prelude.length xs
204 in if inputLen >= m && parsedLen >= m && parsedLen <= n
205 then checkListEqual xs $ Prelude.take parsedLen ls
206 else property False
207 Left (_ :: SomeException) ->
208 property ((m >= 0 && n >= 0 && m > n) || inputLen < m)
210takeEQPass :: Property
211takeEQPass =
212 forAll (chooseInt (min_value, max_value)) $ \n ->
213 forAll (chooseInt (n, max_value)) $ \list_length ->
214 forAll (vectorOf list_length
215 (chooseInt (min_value, max_value))) $ \ls ->
216 case S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
217 Right parsed_list ->
218 checkListEqual parsed_list (Prelude.take n ls)
219 Left _ -> property False
221takeEQ :: Property
222takeEQ =
223 forAll (chooseInt (min_value, max_value)) $ \n ->
224 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
225 let
226 list_length = Prelude.length ls
227 in
228 case S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
229 Right parsed_list ->
230 if n <= list_length
231 then checkListEqual parsed_list (Prelude.take n ls)
232 else property False
233 Left _ -> property (n > list_length)
235takeGEPass :: Property
236takeGEPass =
237 forAll (chooseInt (min_value, max_value)) $ \n ->
238 forAll (chooseInt (n, max_value)) $ \list_length ->
239 forAll (vectorOf list_length (chooseInt (min_value, max_value)))
240 $ \ls ->
241 case S.parse (P.takeGE n FL.toList) (S.fromList ls) of
242 Right parsed_list -> checkListEqual parsed_list ls
243 Left _ -> property False
245takeGE :: Property
246takeGE =
247 forAll (chooseInt (min_value, max_value)) $ \n ->
248 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
249 let
250 list_length = Prelude.length ls
251 in
252 case S.parse (P.takeGE n FL.toList) (S.fromList ls) of
253 Right parsed_list ->
254 if n <= list_length
255 then checkListEqual parsed_list ls
256 else property False
257 Left _ -> property (n > list_length)
259nLessThanEqual0 ::
260 ( Int
261 -> FL.Fold (Either SomeException) Int [Int]
262 -> P.Parser (Either SomeException) Int [Int]
263 )
264 -> (Int -> [Int] -> [Int])
265 -> Property
266nLessThanEqual0 tk ltk =
267 forAll (elements [0, (-1)]) $ \n ->
268 forAll (listOf arbitrary) $ \ls ->
269 case S.parse (tk n FL.toList) (S.fromList ls) of
270 Right parsed_list -> checkListEqual parsed_list (ltk n ls)
271 Left _ -> property False
273takeProperties :: Spec
274takeProperties =
275 describe "take combinators when n <= 0/" $ do
276 prop "takeEQ n FL.toList = []" $
277 nLessThanEqual0 P.takeEQ (\_ -> const [])
278 prop "takeGE n FL.toList xs = xs" $
279 nLessThanEqual0 P.takeGE (\_ -> id)
281-- lookAheadPass :: Property
282-- lookAheadPass =
283-- forAll (chooseInt (min_value + 1, max_value)) $ \n ->
284-- let
285-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
286-- parseTwice = do
287-- parsed_list_1 <- takeWithoutConsume
288-- parsed_list_2 <- takeWithoutConsume
289-- return (parsed_list_1, parsed_list_2)
290-- in
291-- forAll (chooseInt (n, max_value)) $ \list_length ->
292-- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
293-- case S.parse parseTwice (S.fromList ls) of
294-- Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
295-- Left _ -> property $ False
297-- lookAheadFail :: Property
298-- lookAheadFail =
299-- forAll (chooseInt (min_value + 1, max_value)) $ \n ->
300-- let
301-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
302-- parseTwice = do
303-- parsed_list_1 <- takeWithoutConsume
304-- parsed_list_2 <- takeWithoutConsume
305-- return (parsed_list_1, parsed_list_2)
306-- in
307-- forAll (chooseInt (min_value, n - 1)) $ \list_length ->
308-- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
309-- case S.parse parseTwice (S.fromList ls) of
310-- Right _ -> False
311-- Left _ -> True
313-- lookAhead :: Property
314-- lookAhead =
315-- forAll (chooseInt (min_value, max_value)) $ \n ->
316-- let
317-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
318-- parseTwice = do
319-- parsed_list_1 <- takeWithoutConsume
320-- parsed_list_2 <- takeWithoutConsume
321-- return (parsed_list_1, parsed_list_2)
322-- in
323-- forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
324-- case S.parse parseTwice (S.fromList ls) of
325-- Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
326-- Left _ -> property ((list_length < n) || (list_length == n && n == 0))
327-- where
328-- list_length = Prelude.length ls
330takeEndBy_ :: Property
331takeEndBy_ =
332 forAll (listOf (chooseInt (min_value, max_value ))) $ \ls ->
333 case S.parse (P.takeEndBy_ predicate prsr) (S.fromList ls) of
334 Right parsed_list ->
335 checkListEqual parsed_list (tkwhl ls)
336 Left _ -> property False
337 where
338 predicate = (>= 100)
339 prsr = P.many (P.satisfy (const True)) FL.toList
340 tkwhl ls = Prelude.takeWhile (not . predicate) ls
342takeStartBy :: Property
343takeStartBy =
344 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
345 let ls1 = 1:ls
346 in
347 case S.parse parser (S.fromList ls1) of
348 Right parsed_list ->
349 if not $ Prelude.null ls1
350 then
351 let tls = Prelude.takeWhile (not . predicate) (tail ls1)
352 in checkListEqual parsed_list $
353 if predicate (head ls1)
354 then head ls1 : tls
355 else Prelude.takeWhile (not . predicate) ls1
356 else property $ Prelude.null parsed_list
357 Left _ -> property False
358 where
359 predicate = odd
360 parser = P.takeStartBy predicate FL.toList
362takeWhile :: Property
363takeWhile =
364 forAll (listOf (chooseInt (0, 1))) $ \ ls ->
365 case S.parse (P.takeWhile predicate FL.toList) (S.fromList ls) of
366 Right parsed_list ->
367 checkListEqual parsed_list (Prelude.takeWhile predicate ls)
368 Left _ -> property False
369 where
370 predicate = (== 0)
372takeP :: Property
373takeP =
374 forAll
375 ((,) <$> chooseInt (min_value, max_value)
376 <*> listOf (chooseInt (0, 1)))
377 $ \(takeNum, ls) ->
378 case S.parse
379 (P.takeP takeNum (P.fromFold FL.toList))
380 (S.fromList ls) of
381 Right parsed_list ->
382 checkListEqual parsed_list (Prelude.take takeNum ls)
383 Left _ -> property False
385takeWhile1 :: Property
386takeWhile1 =
387 forAll (listOf (chooseInt (0, 1))) $ \ ls ->
388 case S.parse (P.takeWhile1 predicate FL.toList) (S.fromList ls) of
389 Right parsed_list -> case ls of
390 [] -> property False
391 (x : _) ->
392 if predicate x
393 then
394 checkListEqual parsed_list
395 $ Prelude.takeWhile predicate ls
396 else
397 property False
398 Left _ -> case ls of
399 [] -> property True
400 (x : _) -> property (not $ predicate x)
401 where
402 predicate = (== 0)
404takeWhileP :: Property
405takeWhileP =
406 forAll (listOf (chooseInt (0, 1))) $ \ls ->
407 forAll (chooseInt (min_value, max_value)) $ \n ->
408 let
409 predicate = (== 1)
411 prsr =
412 P.takeWhileP predicate
413 $ P.fromFold (FL.take n FL.toList)
415 takeWhileTillLen maxLen prd list =
416 Prelude.take maxLen $ Prelude.takeWhile prd list
417 in
418 case S.parse prsr (S.fromList ls) of
419 Right parsed_list ->
420 checkListEqual
421 parsed_list
422 (takeWhileTillLen n predicate ls)
423 Left _ -> property False
425{-
426choice :: Property
427choice =
428 forAll
429 ((,,) <$> chooseInt (min_value, max_value)
430 <*> chooseInt (min_value, max_value)
431 <*> listOf (chooseInt (0, 1)))
432 $ \(i, j, ls) ->
433 case S.parse (P.choice [parser i, parser j]) (S.fromList ls) of
434 Right parsed_list ->
435 checkListEqual parsed_list $ take (min i j) ls
436 Left _ -> property False
438 where
440 parser i = P.fromFold (FL.take i FL.toList)
441-}
443groupBy :: Property
444groupBy =
445 forAll (listOf (chooseInt (0, 1)))
446 $ \ls ->
447 case S.parse parser (S.fromList ls) of
448 Right parsed -> checkListEqual parsed (groupByLF ls)
449 Left _ -> property False
451 where
453 cmp = (==)
454 parser = P.groupBy cmp FL.toList
455 groupByLF lst
456 | null lst = []
457 | otherwise = head $ List.groupBy cmp lst
459wordBy :: Property
460wordBy =
461 forAll (listOf (elements [' ', 's']))
462 $ \ls ->
463 case S.parse parser (S.fromList ls) of
464 Right parsed -> checkListEqual parsed (words' ls)
465 Left _ -> property False
467 where
469 predicate = (== ' ')
470 parser = P.many (P.wordBy predicate FL.toList) FL.toList
471 words' lst =
472 let wrds = words lst
473 in if wrds == [] && length lst > 0 then [""] else wrds
475parseManyWordQuotedBy :: H.SpecWith ()
476parseManyWordQuotedBy =
477 describe "parseMany wordQuotedBy"
478 $ for_ testCases
479 $ \c@(kQ, lQ, rQ, fromLQ, input, expected) -> do
480 let inpStrm = S.fromList input
482 esc '\\' = True
483 esc _ = False
485 spc ' ' = True
486 spc _ = False
488 parser = P.wordQuotedBy kQ esc lQ rQ fromLQ spc FL.toList
489 result <- H.runIO $ S.fold FL.toList $ S.parseMany parser inpStrm
490 H.it (showCase c) $ result `H.shouldBe` expected
492 where
494 showCase (kQ, _, _, _, input, expected) =
495 show kQ ++ ", " ++ input ++ " -> " ++ show expected
497 testCases =
498 [ ( True
499 , (== '\'')
500 , (== '\'')
501 , id
502 , "The quick brown fox"
503 , ["The", "quick", "brown", "fox"])
504 , ( True
505 , (== '\'')
506 , (== '\'')
507 , id
508 , "The' quick brown' fox"
509 , ["The' quick brown'", "fox"])
510 , ( False
511 , (== '\'')
512 , (== '\'')
513 , id
514 , "The' quick brown' fox"
515 , ["The quick brown", "fox"])
516 , ( True
517 , (== '[')
518 , (== '[')
519 , \x -> if x == '[' then ']' else error "Not an opening quote."
520 , "The[ quick brown] fox"
521 , ["The[ quick brown]", "fox"])
522 , ( True
523 , (== '[')
524 , (== '[')
525 , \x -> if x == '[' then ']' else error "Not an opening quote."
526 , "The[ qui[ck] brown] \\ f[ ox]"
527 , ["The[ qui[ck] brown]", " f[ ox]"])
528 , ( False
529 , (== '[')
530 , (== '[')
531 , \x -> if x == '[' then ']' else error "Not an opening quote."
532 , "The[ qui[ck] brown] fox"
533 , ["The qui[ck] brown", "fox"])
534 ]
537-- splitWithPass :: Property
538-- splitWithPass =
539-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
540-- case S.parse (P.serialWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of
541-- Right (result_first, result_second) -> case ls of
542-- 0 : 1 : _ -> (result_first == 0) && (result_second == 1)
543-- _ -> False
544-- Left _ -> case ls of
545-- 0 : 1 : _ -> False
546-- _ -> True
548-- splitWithFailLeft :: Property
549-- splitWithFailLeft =
550-- property (case S.parse (P.serialWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
551-- Right _ -> False
552-- Left _ -> True)
554-- splitWithFailRight :: Property
555-- splitWithFailRight =
556-- property (case S.parse (P.serialWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
557-- Right _ -> False
558-- Left _ -> True)
560-- splitWithFailBoth :: Property
561-- splitWithFailBoth =
562-- property (case S.parse (P.serialWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
563-- Right _ -> False
564-- Left _ -> True)
566-- teeWithPass :: Property
567-- teeWithPass =
568-- forAll (chooseInt (0, 10000)) $ \n ->
569-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
570-- let
571-- prsr = P.take n FL.toList
572-- in
573-- case S.parse (P.teeWith (,) prsr prsr) (S.fromList ls) of
574-- Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
575-- Left _ -> property False
577-- teeWithFailLeft :: Property
578-- teeWithFailLeft =
579-- property (case S.parse (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
580-- Right _ -> False
581-- Left _ -> True)
583-- teeWithFailRight :: Property
584-- teeWithFailRight =
585-- property (case S.parse (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
586-- Right _ -> False
587-- Left _ -> True)
589-- teeWithFailBoth :: Property
590-- teeWithFailBoth =
591-- property (case S.parse (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
592-- Right _ -> False
593-- Left _ -> True)
595deintercalate :: Property
596deintercalate =
597 forAll (listOf (chooseAny :: Gen Int)) $ \ls ->
598 case S.parse p (S.fromList ls) of
599 Right evenOdd -> evenOdd == List.partition even ls
600 Left _ -> False
602 where
603 p1 = P.takeWhile even FL.toList
604 p2 = P.takeWhile odd FL.toList
605 partition =
606 FL.tee (fmap concat $ FL.lefts FL.toList)
607 (fmap concat $ FL.rights FL.toList)
608 p = P.deintercalate partition p1 p2
610-- shortestPass :: Property
611-- shortestPass =
612-- forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->
613-- let
614-- prsr_1 = P.takeWhile (<= (mid_value `Prelude.div` 2)) FL.toList
615-- prsr_2 = P.takeWhile (<= mid_value) FL.toList
616-- prsr_shortest = P.shortest prsr_1 prsr_2
617-- in
618-- case S.parse prsr_shortest (S.fromList ls) of
619-- Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= 2500) ls)
620-- Left _ -> property False
622-- shortestFailLeft :: Property
623-- shortestFailLeft =
624-- property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
625-- Right r -> r == 1
626-- Left _ -> False)
628-- shortestFailRight :: Property
629-- shortestFailRight =
630-- property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
631-- Right r -> r == 1
632-- Left _ -> False)
634-- shortestFailBoth :: Property
635-- shortestFailBoth =
636-- property (case S.parse (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
637-- Right _ -> False
638-- Left _ -> True)
640many :: Property
641many =
642 forAll (listOf (chooseInt (0, 1))) $ \ls ->
643 let fldstp conL currL = return $ FL.Partial $ conL ++ currL
644 concatFold = FL.Fold fldstp (return (FL.Partial [])) return
645 prsr =
646 flip P.many concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
647 in
648 case S.parse prsr (S.fromList ls) of
649 Right res_list -> checkListEqual res_list
650 $ Prelude.filter (== 0) ls
651 Left _ -> property False
653-- many_empty :: Property
654-- many_empty =
655-- property (case S.parse (P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
656-- Right res_list -> checkListEqual res_list ([] :: [Int])
657-- Left _ -> property False)
659some :: Property
660some =
661 forAll (listOf (chooseInt (0, 1))) $ \genLs ->
662 let
663 ls = 0 : genLs
664 fldstp conL currL = return $ FL.Partial $ conL ++ currL
665 concatFold = FL.Fold fldstp (return (FL.Partial [])) return
666 prsr =
667 flip P.some concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
668 in
669 case S.parse prsr (S.fromList ls) of
670 Right res_list -> res_list == Prelude.filter (== 0) ls
671 Left _ -> False
673-- someFail :: Property
674-- someFail =
675-- property (case S.parse (P.some FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
676-- Right _ -> False
677-- Left _ -> True)
679-------------------------------------------------------------------------------
680-- Instances
681-------------------------------------------------------------------------------
683applicative :: Property
684applicative =
685 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
686 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
687 let parser =
688 (,)
689 <$> P.fromFold (FL.take (length list1) FL.toList)
690 <*> P.fromFold (FL.take (length list2) FL.toList)
691 in monadicIO $ do
692 (olist1, olist2) <-
693 run $ S.parse parser (S.fromList $ list1 ++ list2)
694 listEquals (==) olist1 list1
695 listEquals (==) olist2 list2
697sequence :: Property
698sequence =
699 forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->
700 let p xs = P.fromFold (FL.take (length xs) FL.toList)
701 in monadicIO $ do
702 outs <- run $
703 S.parse
704 (Prelude.sequence $ fmap p ins)
705 (S.fromList $ concat ins)
706 listEquals (==) outs ins
708monad :: Property
709monad =
710 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
711 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
712 let parser = do
713 olist1 <- P.fromFold (FL.take (length list1) FL.toList)
714 olist2 <- P.fromFold (FL.take (length list2) FL.toList)
715 return (olist1, olist2)
716 in monadicIO $ do
717 (olist1, olist2) <-
718 run $ S.parse parser (S.fromList $ list1 ++ list2)
719 listEquals (==) olist1 list1
720 listEquals (==) olist2 list2
722-------------------------------------------------------------------------------
723-- Stream parsing
724-------------------------------------------------------------------------------
726parseMany :: Property
727parseMany =
728 forAll (chooseInt (1,100)) $ \len ->
729 forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
730 monadicIO $ do
731 outs <- do
732 let p = P.fromFold $ FL.take len FL.toList
733 run
734 $ S.fold FL.toList
735 $ S.parseMany p (S.fromList $ concat ins)
736 listEquals (==) outs ins
738-------------------------------------------------------------------------------
739-- Test for a particular case hit during fs events testing
740-------------------------------------------------------------------------------
742evId :: [Word8]
743evId = [96,238,17,9,0,0,0,0]
745evFlags :: [Word8]
746evFlags = [0,4,1,0,0,0,0,0]
748evPathLen :: [Word8]
749evPathLen = [71,0,0,0,0,0,0,0]
751evPath :: [Word8]
752evPath =
753 [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109
754 ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112
755 ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116
756 ,114,101,97,109,108,121,47,116,109,112,47,122,122
757 ]
759event :: [Word8]
760event = evId ++ evFlags ++ evPathLen ++ evPath
762data Event = Event
763 { eventId :: Word64
764 , eventFlags :: Word32
765 , eventAbsPath :: A.Array Word8
766 } deriving (Show, Ord, Eq)
768readOneEvent :: P.Parser IO Word8 Event
769readOneEvent = do
770 arr <- P.takeEQ 24 (A.writeN 24)
771 let arr1 = A.castUnsafe arr :: A.Array Word64
772 eid = A.unsafeIndex 0 arr1
773 eflags = A.unsafeIndex 1 arr1
774 pathLen = fromIntegral $ A.unsafeIndex 2 arr1
775 -- XXX handle if pathLen is 0
776 path <- P.takeEQ pathLen (A.writeN pathLen)
777 return $ Event
778 { eventId = eid
779 , eventFlags = fromIntegral eflags
780 , eventAbsPath = path
781 }
783parseMany2Events :: Property
784parseMany2Events =
785 monadicIO $ do
786 xs <-
787 ( run
788 $ S.fold FL.toList
789 $ S.parseMany readOneEvent
790 $ S.fromList (concat (replicate 2 event))
791 )
792 assert (length xs == 2)
793 -- XXX assuming little endian machine
794 let ev = Event
795 { eventId = 152170080
796 , eventFlags = 66560
797 , eventAbsPath = A.fromList evPath
798 }
799 in listEquals (==) xs (replicate 2 ev)
801manyEqParseMany :: Property
802manyEqParseMany =
803 forAll (listOf (chooseInt (0, 100))) $ \lst ->
804 forAll (chooseInt (1, 100)) $ \i ->
805 monadicIO $ do
806 let strm = S.fromList lst
807 r1 <- run $ S.parse (P.many (split i) FL.toList) strm
808 r2 <- run $ S.fold FL.toList $ S.parseMany (split i) strm
809 assert $ r1 == r2
811 where
813 split i = P.fromFold (FL.take i FL.toList)
816takeEndBy1 :: Property
817takeEndBy1 =
818 forAll (listOf (chooseInt (0, 1))) $ \ls ->
819 case S.parse (P.takeEndBy predicate prsr) (S.fromList ls) of
820 Right parsed_list ->
821 checkListEqual
822 parsed_list
823 (takeWhileAndFirstFail (not . predicate) ls)
824 Left _ -> property False
825 where
826 prsr = P.many (P.satisfy (const True)) FL.toList
828 predicate = (== 1)
830 takeWhileAndFirstFail prd (x : xs) =
831 if prd x
832 then x : takeWhileAndFirstFail prd xs
833 else [x]
834 takeWhileAndFirstFail _ [] = []
836splitWithSuffix
837 :: Monad m
838 => (a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b
839splitWithSuffix predicate f = S.foldMany (FL.takeEndBy predicate f)
841takeEndBy2 :: Property
842takeEndBy2 =
843 forAll (listOf (chooseInt (0, 1))) $ \ls ->
844 let
845 strm = S.fromList ls
847 predicate = (==0)
849 eitherParsedList =
850 S.fold FL.toList $
851 S.parseMany (P.takeEndBy predicate prsr) strm
853 where
855 prsr = P.many (P.satisfy (const True)) FL.toList
857 eitherSplitList =
858 case ls of
859 [] -> return []
860 _ ->
861 if last ls == 0
862 then S.fold FL.toList $ S.append strm1 (S.fromList [])
863 else S.fold FL.toList strm1
865 where
867 strm1 = splitWithSuffix predicate FL.toList strm
868 in
869 case eitherParsedList of
870 Left _ -> property False
871 Right parsedList ->
872 case eitherSplitList of
873 Left _ -> property False
874 Right splitList -> checkListEqual parsedList splitList
876takeEndByEsc :: Property
877takeEndByEsc =
878 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
879 let
880 msg = "takeEndByEsc: trailing escape"
882 isSep = even
884 isEsc x = x `mod` 6 == 0
886 prsr = P.takeEndByEsc isEsc isSep prsr0
888 where
890 prsr0 = P.many (P.satisfy (const True)) FL.toList
892 escapeSep maybePrevEsc [] =
893 case maybePrevEsc of
894 Nothing -> []
895 Just prevEsc -> [prevEsc]
896 escapeSep maybePrevEsc (x : xs) =
897 case maybePrevEsc of
898 Nothing ->
899 if isEsc x
900 then escapeSep (Just x) xs
901 else
902 if isSep x
903 then [x]
904 else x : escapeSep Nothing xs
905 Just _ ->
906 x : escapeSep Nothing xs
907 in
908 case S.parse prsr (S.fromList ls) of
909 Right parsed_list -> checkListEqual parsed_list $ escapeSep Nothing ls
910 Left err -> property (displayException err == msg)
912takeFramedByEsc_ :: Property
913takeFramedByEsc_ =
914 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
915 let
916 isBegin = (== 0)
918 isEnd = (== 1)
920 isEsc = (== 2)
922 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
924 checkPass (x : xs) maybePrevEsc openMinusClose =
925 case maybePrevEsc of
926 Nothing ->
927 if isEsc x
928 then checkPass xs (Just x) openMinusClose
929 else
930 if isBegin x
931 then checkPass xs Nothing (openMinusClose + 1)
932 else
933 if isEnd x
934 then
935 case openMinusClose of
936 0 -> False
937 1 -> True
938 _ ->
939 checkPass
940 xs
941 Nothing
942 (openMinusClose - 1)
943 else
944 checkPass xs Nothing openMinusClose
945 Just _ -> checkPass xs Nothing openMinusClose
946 checkPass [] _ _ = False
948 checkPassBeg [] = False
949 checkPassBeg xxs@(x:_)
950 | isBegin x = checkPass xxs Nothing (0 :: Int)
951 | otherwise = False
953 escapeFrame begin end escape l =
954 let
955 helper (x : xs) maybePrevEsc openMinusClose =
956 case maybePrevEsc of
957 Nothing ->
958 if escape x
959 then helper xs (Just x) openMinusClose
960 else
961 if begin x
962 then helper xs Nothing (openMinusClose + 1)
963 else
964 if end x
965 then
966 if openMinusClose - 1 == 0
967 then []
968 else
969 helper
970 xs
971 Nothing
972 (openMinusClose - 1)
973 else
974 x : helper xs Nothing openMinusClose
975 Just prevEsc ->
976 if escape x || begin x || end x
977 then x : helper xs Nothing openMinusClose
978 else
979 prevEsc : x : helper xs Nothing openMinusClose
980 helper [] _ _ = error "Cannot Reach Here"
981 in
982 helper l Nothing (0 :: Int)
983 in
984 case S.parse prsr (S.fromList ls) of
985 Right parsed_list ->
986 if checkPassBeg ls
987 then checkListEqual parsed_list $
988 escapeFrame isBegin isEnd isEsc ls
989 else property False
990 Left _ ->
991 if checkPassBeg ls
992 then property False
993 else property True
995takeFramedByEsc_Pass :: Property
996takeFramedByEsc_Pass =
997 forAll (listOf (chooseInt (min_value, max_value))) $ \list ->
998 let
999 ls = (0 : list) ++ (Prelude.replicate (Prelude.length list + 1) 1)
1001 isBegin = (== 0)
1003 isEnd = (== 1)
1005 isEsc = (== 2)
1007 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1009 escapeFrame begin end escape l =
1010 let
1011 helper (x : xs) maybePrevEsc openMinusClose =
1012 case maybePrevEsc of
1013 Nothing ->
1014 if escape x
1015 then helper xs (Just x) openMinusClose
1016 else
1017 if begin x
1018 then
1019 if openMinusClose == 0
1020 then helper xs Nothing (openMinusClose + 1)
1021 else x : helper xs Nothing (openMinusClose + 1)
1022 else
1023 if end x
1024 then
1025 if openMinusClose - 1 == 0
1026 then []
1027 else
1028 x :
1029 helper
1030 xs
1031 Nothing
1032 (openMinusClose - 1)
1033 else
1034 x : helper xs Nothing openMinusClose
1035 Just _ ->
1036 x : helper xs Nothing openMinusClose
1037 helper [] _ _ = error "Cannot Reach Here"
1038 in
1039 helper l Nothing (0 :: Int)
1040 in
1041 case S.parse prsr (S.fromList ls) of
1042 Right parsed_list -> checkListEqual parsed_list $ escapeFrame isBegin isEnd isEsc ls
1043 _ -> property False
1045takeFramedByEsc_Fail1 :: Property
1046takeFramedByEsc_Fail1 =
1047 let
1048 msg = "takeFramedByEsc_: missing frame end"
1050 isBegin = (== 0)
1052 isEnd = (== 0)
1054 isEsc = (== 2)
1056 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1058 ls = [0 :: Int]
1059 in
1060 case S.parse prsr (S.fromList ls) of
1061 Right _ -> property False
1062 Left err -> property (displayException err == msg)
1064takeFramedByEsc_Fail2 :: Property
1065takeFramedByEsc_Fail2 =
1066 let
1067 msg = "takeFramedByEsc_: missing frame start"
1069 isBegin = (== 0)
1071 isEnd = (== 1)
1073 isEsc = (== 1)
1075 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1077 ls = [1 :: Int]
1078 in
1079 case S.parse prsr (S.fromList ls) of
1080 Right _ -> property False
1081 Left err -> property (displayException err == msg)
1083takeFramedByEsc_Fail3 :: Property
1084takeFramedByEsc_Fail3 =
1085 let
1086 msg = "takeFramedByEsc_: missing frame end"
1088 isBegin = (== 2)
1090 isEnd = (== 1)
1092 isEsc = (== 2)
1094 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1096 ls = [2 :: Int]
1097 in
1098 case S.parse prsr (S.fromList ls) of
1099 Right _ -> property False
1100 Left err -> property $ (displayException err == msg)
1102takeStartBy_ :: Property
1103takeStartBy_ =
1104 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
1105 let ls1 = 1:ls
1106 msg = "takeFramedByGeneric: empty token"
1107 in
1108 case S.parse parser (S.fromList ls1) of
1109 Right parsed_list ->
1110 if not $ Prelude.null ls1
1111 then
1112 let tls = Prelude.takeWhile (not . predicate) (tail ls1)
1113 in checkListEqual parsed_list $
1114 if predicate (head ls1)
1115 then tls
1116 else Prelude.takeWhile (not . predicate) ls1
1117 else property $ Prelude.null parsed_list
1118 Left err -> property (displayException err == msg)
1119 where
1120 predicate = odd
1121 parser = P.takeStartBy_ predicate FL.toList
1122-------------------------------------------------------------------------------
1123-- Main
1124-------------------------------------------------------------------------------
1126moduleName :: String
1127moduleName = "Data.Parser"
1129main :: IO ()
1130main =
1131 hspec $
1132 H.parallel $
1133 modifyMaxSuccess (const maxTestCount) $ do
1134 describe moduleName $ do
1136 describe "Instances" $ do
1137 prop "applicative" applicative
1138 prop "monad" monad
1139 prop "sequence" sequence
1140 describe "Stream parsing" $ do
1141 prop "parseMany" parseMany
1142 prop "parseMany2Events" parseMany2Events
1144 describe "test for accumulator" $ do
1145 prop "P.fromFold FL.sum = FL.sum" fromFold
1146 prop "fromPure value provided" fromPure
1147 prop "fromPure monadic value provided" fromEffect
1148 prop "fail err = Left (SomeException (ParseError err))" parserFail
1149 prop "always fail" die
1150 prop "always fail but monadic" dieM
1152 describe "test for element parser" $ do
1153 prop "peek = head with list length > 0" peekPass
1154 prop "peek fail on []" peekFail
1155 prop "eof pass on []" eofPass
1156 prop "eof fail on non-empty list" eofFail
1157 prop "first element exists and >= mid_value" satisfyPass
1158 prop "one pass on [Int]" onePass
1159 prop "one fail on []" one
1160 prop "check first element exists and satisfies predicate" satisfy
1162 describe "test for sequence parser" $ do
1163 prop "P.takeBetween = Prelude.take when len >= m and len <= n"
1164 takeBetweenPass
1165 prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail"
1166 ++ "otherwise fail") Main.takeBetween
1168 prop "P.takeEQ = Prelude.take when len >= n" takeEQPass
1169 prop "P.takeEQ = Prelude.take when len >= n and fail otherwise"
1170 Main.takeEQ
1171 prop "P.takeGE n ls = ls when len >= n" takeGEPass
1172 prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE
1173 -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass
1174 -- prop "Fail when stream length exceeded" lookAheadFail
1175 -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
1176 prop "P.takeEndBy_ test" Main.takeEndBy_
1177 prop ("P.takeStartBy pred = head : Prelude.takeWhile (not . pred)"
1178 ++ " tail") takeStartBy
1179 prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
1180 prop ("P.takeWhile1 = Prelude.takeWhile if taken something,"
1181 ++ " else check why failed") takeWhile1
1182 prop "takeWhileP prd P.take = takeWhileMaxLen prd" takeWhileP
1183 prop ("P.takeP = Prelude.take") takeP
1184 prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy
1185 prop "many (P.wordBy ' ') = words'" wordBy
1186 parseManyWordQuotedBy
1187 -- prop "choice" choice
1188 -- prop "" splitWithPass
1189 -- prop "" splitWithFailLeft
1190 -- prop "" splitWithFailRight
1191 -- prop "" splitWithFailBoth
1192 -- prop "" teeWithPass
1193 -- prop "" teeWithFailLeft
1194 -- prop "" teeWithFailRight
1195 -- prop "" teeWithFailBoth
1196 prop "deintercalate" deintercalate
1197 -- prop "" shortestPass
1198 -- prop "" shortestFailLeft
1199 -- prop "" shortestFailRight
1200 -- prop "" shortestFailBoth
1201 prop ("P.many concatFold $ P.takeEndBy_ (== 1) FL.toList ="
1202 ++ "Prelude.filter (== 0)") many
1203 -- prop "[] due to parser being die" many_empty
1204 prop ("P.some concatFold $ P.takeEndBy_ (== 1) FL.toList ="
1205 ++ "Prelude.filter (== 0)") some
1206 -- prop "fail due to parser being die" someFail
1207 prop "P.many == S.parseMany" manyEqParseMany
1209 prop "takeEndBy_" takeEndBy_
1210 prop "takeEndBy1" takeEndBy1
1211 prop "takeEndBy2" takeEndBy2
1212 prop "takeEndByEsc" takeEndByEsc
1213 prop "takeFramedByEsc_" takeFramedByEsc_
1214 prop "takeFramedByEsc_Pass" takeFramedByEsc_Pass
1215 prop "takeFramedByEsc_Fail1" takeFramedByEsc_Fail1
1216 prop "takeFramedByEsc_Fail2" takeFramedByEsc_Fail2
1217 prop "takeFramedByEsc_Fail3" takeFramedByEsc_Fail3
1218 prop "takeStartBy_" takeStartBy_
1220 takeProperties