git.iko.soy/streamly
on aaa279c help sign in
streamly/test/Streamly/Test/Data/Parser.hs
1206 lines 43 kB history raw
1module Main (main) where
3import Control.Exception (SomeException(..), displayException)
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.Foreign as A
19import qualified Streamly.Internal.Data.Fold as FL
20import qualified Streamly.Internal.Data.Parser as P
21import qualified Streamly.Internal.Data.Stream.IsStream 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
40maxTestCount :: Int
41maxTestCount = 100
43min_value :: Int
44min_value = 0
46mid_value :: Int
47mid_value = 5000
49max_value :: Int
50max_value = 10000
52max_length :: Int
53max_length = 1000
55-- Accumulator Tests
57fromFold :: Property
58fromFold =
59 forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
60 case (==) <$> S.parse (P.fromFold FL.sum) (S.fromList ls)
61 <*> S.fold FL.sum (S.fromList ls) of
62 Right is_equal -> is_equal
63 Left _ -> False
65fromPure :: Property
66fromPure =
67 forAll (chooseInt (min_value, max_value)) $ \x ->
68 case S.parse (P.fromPure x) (S.fromList [1 :: Int]) of
69 Right r -> r == x
70 Left _ -> False
72fromEffect :: Property
73fromEffect =
74 forAll (chooseInt (min_value, max_value)) $ \x ->
75 case S.parse (P.fromEffect $ return x) (S.fromList [1 :: Int]) of
76 Right r -> r == x
77 Left _ -> False
79die :: Property
80die =
81 property $
82 case S.parse (P.die "die test") (S.fromList [0 :: Int]) of
83 Right _ -> False
84 Left _ -> True
86dieM :: Property
87dieM =
88 property $
89 case S.parse (P.dieM (Right "die test")) (S.fromList [0 :: Int]) of
90 Right _ -> False
91 Left _ -> True
93parserFail :: Property
94parserFail =
95 property $
96 case S.parse (fail err) (S.fromList [0 :: Int]) of
97 Right _ -> False
98 Left (SomeException e) -> err == displayException e
99 where
100 err = "Testing MonadFail.fail."
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 S.parse 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 S.parse P.peek (S.fromList []) of
117 Right _ -> False
118 Left _ -> True)
120eofPass :: Property
121eofPass =
122 property (case S.parse 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 S.parse 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 S.parse (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 S.parse (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)
159onePass :: Property
160onePass =
161 forAll (chooseInt (1, max_value)) $ \int ->
162 property (case S.parse P.one (S.fromList [int]) of
163 Right i -> i == int
164 Left _ -> False)
166one :: Property
167one =
168 property (case S.parse P.one (S.fromList []) of
169 Left _ -> True
170 Right _ -> False)
172-- Sequence Parsers Tests
173takeBetweenPass :: Property
174takeBetweenPass =
175 forAll (chooseInt (min_value, max_value)) $ \m ->
176 forAll (chooseInt (m, max_value)) $ \n ->
177 forAll (chooseInt (m, max_value)) $ \list_length ->
178 forAll (vectorOf list_length (chooseInt (min_value, max_value)))
179 $ \ls ->
180 case S.parse (P.takeBetween m n FL.toList)
181 (S.fromList ls) of
182 Right parsed_list ->
183 let lpl = Prelude.length parsed_list
184 in checkListEqual parsed_list
185 $ Prelude.take lpl ls
186 Left _ -> property False
188takeBetween :: Property
189takeBetween =
190 forAll (chooseInt (min_value, max_value)) $ \m ->
191 forAll (chooseInt (min_value, max_value)) $ \n ->
192 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
193 go m n ls
195 where
197 go m n ls =
198 let inputLen = Prelude.length ls
199 in case S.parse (P.takeBetween m n FL.toList) (S.fromList ls) of
200 Right xs ->
201 let parsedLen = Prelude.length xs
202 in if inputLen >= m && parsedLen >= m && parsedLen <= n
203 then checkListEqual xs $ Prelude.take parsedLen ls
204 else property False
205 Left _ ->
206 property ((m >= 0 && n >= 0 && m > n) || inputLen < m)
208takeEQPass :: Property
209takeEQPass =
210 forAll (chooseInt (min_value, max_value)) $ \n ->
211 forAll (chooseInt (n, max_value)) $ \list_length ->
212 forAll (vectorOf list_length
213 (chooseInt (min_value, max_value))) $ \ls ->
214 case S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
215 Right parsed_list ->
216 checkListEqual parsed_list (Prelude.take n ls)
217 Left _ -> property False
219takeEQ :: Property
220takeEQ =
221 forAll (chooseInt (min_value, max_value)) $ \n ->
222 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
223 let
224 list_length = Prelude.length ls
225 in
226 case S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
227 Right parsed_list ->
228 if n <= list_length
229 then checkListEqual parsed_list (Prelude.take n ls)
230 else 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)))
238 $ \ls ->
239 case S.parse (P.takeGE n FL.toList) (S.fromList ls) of
240 Right parsed_list -> checkListEqual parsed_list ls
241 Left _ -> property False
243takeGE :: Property
244takeGE =
245 forAll (chooseInt (min_value, max_value)) $ \n ->
246 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
247 let
248 list_length = Prelude.length ls
249 in
250 case S.parse (P.takeGE n FL.toList) (S.fromList ls) of
251 Right parsed_list ->
252 if n <= list_length
253 then checkListEqual parsed_list ls
254 else property False
255 Left _ -> property (n > list_length)
257nLessThanEqual0 ::
258 ( Int
259 -> FL.Fold (Either SomeException) Int [Int]
260 -> P.Parser (Either SomeException) Int [Int]
261 )
262 -> (Int -> [Int] -> [Int])
263 -> Property
264nLessThanEqual0 tk ltk =
265 forAll (elements [0, (-1)]) $ \n ->
266 forAll (listOf arbitrary) $ \ls ->
267 case S.parse (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)
279-- lookAheadPass :: Property
280-- lookAheadPass =
281-- forAll (chooseInt (min_value + 1, max_value)) $ \n ->
282-- let
283-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
284-- parseTwice = do
285-- parsed_list_1 <- takeWithoutConsume
286-- parsed_list_2 <- takeWithoutConsume
287-- return (parsed_list_1, parsed_list_2)
288-- in
289-- forAll (chooseInt (n, max_value)) $ \list_length ->
290-- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
291-- case S.parse parseTwice (S.fromList ls) of
292-- Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
293-- Left _ -> property $ False
295-- lookAheadFail :: Property
296-- lookAheadFail =
297-- forAll (chooseInt (min_value + 1, max_value)) $ \n ->
298-- let
299-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
300-- parseTwice = do
301-- parsed_list_1 <- takeWithoutConsume
302-- parsed_list_2 <- takeWithoutConsume
303-- return (parsed_list_1, parsed_list_2)
304-- in
305-- forAll (chooseInt (min_value, n - 1)) $ \list_length ->
306-- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
307-- case S.parse parseTwice (S.fromList ls) of
308-- Right _ -> False
309-- Left _ -> True
311-- lookAhead :: Property
312-- lookAhead =
313-- forAll (chooseInt (min_value, max_value)) $ \n ->
314-- let
315-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
316-- parseTwice = do
317-- parsed_list_1 <- takeWithoutConsume
318-- parsed_list_2 <- takeWithoutConsume
319-- return (parsed_list_1, parsed_list_2)
320-- in
321-- forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
322-- case S.parse parseTwice (S.fromList ls) of
323-- Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
324-- Left _ -> property ((list_length < n) || (list_length == n && n == 0))
325-- where
326-- list_length = Prelude.length ls
328takeEndBy_ :: Property
329takeEndBy_ =
330 forAll (listOf (chooseInt (min_value, max_value ))) $ \ls ->
331 case S.parse (P.takeEndBy_ predicate prsr) (S.fromList ls) of
332 Right parsed_list ->
333 checkListEqual parsed_list (tkwhl ls)
334 Left _ -> property False
335 where
336 predicate = (>= 100)
337 prsr = P.many (P.satisfy (const True)) FL.toList
338 tkwhl ls = Prelude.takeWhile (not . predicate) ls
340takeStartBy :: Property
341takeStartBy =
342 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
343 let ls1 = 1:ls
344 in
345 case S.parse parser (S.fromList ls1) of
346 Right parsed_list ->
347 if not $ Prelude.null ls1
348 then
349 let tls = Prelude.takeWhile (not . predicate) (tail ls1)
350 in checkListEqual parsed_list $
351 if predicate (head ls1)
352 then head ls1 : tls
353 else Prelude.takeWhile (not . predicate) ls1
354 else property $ Prelude.null parsed_list
355 Left _ -> property False
356 where
357 predicate = odd
358 parser = P.takeStartBy predicate FL.toList
360takeWhile :: Property
361takeWhile =
362 forAll (listOf (chooseInt (0, 1))) $ \ ls ->
363 case S.parse (P.takeWhile predicate FL.toList) (S.fromList ls) of
364 Right parsed_list ->
365 checkListEqual parsed_list (Prelude.takeWhile predicate ls)
366 Left _ -> property False
367 where
368 predicate = (== 0)
370takeP :: Property
371takeP =
372 forAll
373 ((,) <$> chooseInt (min_value, max_value)
374 <*> listOf (chooseInt (0, 1)))
375 $ \(takeNum, ls) ->
376 case S.parse
377 (P.takeP takeNum (P.fromFold FL.toList))
378 (S.fromList ls) of
379 Right parsed_list ->
380 checkListEqual parsed_list (Prelude.take takeNum ls)
381 Left _ -> property False
383takeWhile1 :: Property
384takeWhile1 =
385 forAll (listOf (chooseInt (0, 1))) $ \ ls ->
386 case S.parse (P.takeWhile1 predicate FL.toList) (S.fromList ls) of
387 Right parsed_list -> case ls of
388 [] -> property False
389 (x : _) ->
390 if predicate x
391 then
392 checkListEqual parsed_list
393 $ Prelude.takeWhile predicate ls
394 else
395 property False
396 Left _ -> case ls of
397 [] -> property True
398 (x : _) -> property (not $ predicate x)
399 where
400 predicate = (== 0)
402takeWhileP :: Property
403takeWhileP =
404 forAll (listOf (chooseInt (0, 1))) $ \ls ->
405 forAll (chooseInt (min_value, max_value)) $ \n ->
406 let
407 predicate = (== 1)
409 prsr =
410 P.takeWhileP predicate
411 $ P.fromFold (FL.take n FL.toList)
413 takeWhileTillLen maxLen prd list =
414 Prelude.take maxLen $ Prelude.takeWhile prd list
415 in
416 case S.parse prsr (S.fromList ls) of
417 Right parsed_list ->
418 checkListEqual
419 parsed_list
420 (takeWhileTillLen n predicate ls)
421 Left _ -> property False
423choice :: Property
424choice =
425 forAll
426 ((,,) <$> chooseInt (min_value, max_value)
427 <*> chooseInt (min_value, max_value)
428 <*> listOf (chooseInt (0, 1)))
429 $ \(i, j, ls) ->
430 case S.parse (P.choice [parser i, parser j]) (S.fromList ls) of
431 Right parsed_list ->
432 checkListEqual parsed_list $ take (min i j) ls
433 Left _ -> property False
435 where
437 parser i = P.fromFold (FL.take i FL.toList)
439groupBy :: Property
440groupBy =
441 forAll (listOf (chooseInt (0, 1)))
442 $ \ls ->
443 case S.parse parser (S.fromList ls) of
444 Right parsed -> checkListEqual parsed (groupByLF ls)
445 Left _ -> property False
447 where
449 cmp = (==)
450 parser = P.groupBy cmp FL.toList
451 groupByLF lst
452 | null lst = []
453 | otherwise = head $ List.groupBy cmp lst
455wordBy :: Property
456wordBy =
457 forAll (listOf (elements [' ', 's']))
458 $ \ls ->
459 case S.parse parser (S.fromList ls) of
460 Right parsed -> checkListEqual parsed (words' ls)
461 Left _ -> property False
463 where
465 predicate = (== ' ')
466 parser = P.many (P.wordBy predicate FL.toList) FL.toList
467 words' lst =
468 let wrds = words lst
469 in if wrds == [] && length lst > 0 then [""] else wrds
471parseManyWordQuotedBy :: H.SpecWith ()
472parseManyWordQuotedBy =
473 describe "parseMany wordQuotedBy"
474 $ for_ testCases
475 $ \c@(kQ, lQ, rQ, fromLQ, input, expected) -> do
476 let inpStrm = S.fromList input
478 esc '\\' = True
479 esc _ = False
481 spc ' ' = True
482 spc _ = False
484 parser = P.wordQuotedBy kQ esc lQ rQ fromLQ spc FL.toList
485 result <- H.runIO $ S.toList $ S.parseMany parser inpStrm
486 H.it (showCase c) $ result `H.shouldBe` expected
488 where
490 showCase (kQ, _, _, _, input, expected) =
491 show kQ ++ ", " ++ input ++ " -> " ++ show expected
493 testCases =
494 [ ( True
495 , (== '\'')
496 , (== '\'')
497 , id
498 , "The quick brown fox"
499 , ["The", "quick", "brown", "fox"])
500 , ( True
501 , (== '\'')
502 , (== '\'')
503 , id
504 , "The' quick brown' fox"
505 , ["The' quick brown'", "fox"])
506 , ( False
507 , (== '\'')
508 , (== '\'')
509 , id
510 , "The' quick brown' fox"
511 , ["The quick brown", "fox"])
512 , ( True
513 , (== '[')
514 , (== '[')
515 , \x -> if x == '[' then ']' else error "Not an opening quote."
516 , "The[ quick brown] fox"
517 , ["The[ quick brown]", "fox"])
518 , ( True
519 , (== '[')
520 , (== '[')
521 , \x -> if x == '[' then ']' else error "Not an opening quote."
522 , "The[ qui[ck] brown] \\ f[ ox]"
523 , ["The[ qui[ck] brown]", " f[ ox]"])
524 , ( False
525 , (== '[')
526 , (== '[')
527 , \x -> if x == '[' then ']' else error "Not an opening quote."
528 , "The[ qui[ck] brown] fox"
529 , ["The qui[ck] brown", "fox"])
530 ]
533-- splitWithPass :: Property
534-- splitWithPass =
535-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
536-- case S.parse (P.serialWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of
537-- Right (result_first, result_second) -> case ls of
538-- 0 : 1 : _ -> (result_first == 0) && (result_second == 1)
539-- _ -> False
540-- Left _ -> case ls of
541-- 0 : 1 : _ -> False
542-- _ -> True
544-- splitWithFailLeft :: Property
545-- splitWithFailLeft =
546-- property (case S.parse (P.serialWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
547-- Right _ -> False
548-- Left _ -> True)
550-- splitWithFailRight :: Property
551-- splitWithFailRight =
552-- property (case S.parse (P.serialWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
553-- Right _ -> False
554-- Left _ -> True)
556-- splitWithFailBoth :: Property
557-- splitWithFailBoth =
558-- property (case S.parse (P.serialWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
559-- Right _ -> False
560-- Left _ -> True)
562-- teeWithPass :: Property
563-- teeWithPass =
564-- forAll (chooseInt (0, 10000)) $ \n ->
565-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
566-- let
567-- prsr = P.take n FL.toList
568-- in
569-- case S.parse (P.teeWith (,) prsr prsr) (S.fromList ls) of
570-- Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
571-- Left _ -> property False
573-- teeWithFailLeft :: Property
574-- teeWithFailLeft =
575-- property (case S.parse (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
576-- Right _ -> False
577-- Left _ -> True)
579-- teeWithFailRight :: Property
580-- teeWithFailRight =
581-- property (case S.parse (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
582-- Right _ -> False
583-- Left _ -> True)
585-- teeWithFailBoth :: Property
586-- teeWithFailBoth =
587-- property (case S.parse (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
588-- Right _ -> False
589-- Left _ -> True)
591deintercalate :: Property
592deintercalate =
593 forAll (listOf (chooseAny :: Gen Int)) $ \ls ->
594 case S.parse p (S.fromList ls) of
595 Right evenOdd -> evenOdd == List.partition even ls
596 Left _ -> False
598 where
599 p1 = P.takeWhile even FL.toList
600 p2 = P.takeWhile odd FL.toList
601 partition =
602 FL.tee (fmap concat $ FL.lefts FL.toList)
603 (fmap concat $ FL.rights FL.toList)
604 p = P.deintercalate partition p1 p2
606-- shortestPass :: Property
607-- shortestPass =
608-- forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->
609-- let
610-- prsr_1 = P.takeWhile (<= (mid_value `Prelude.div` 2)) FL.toList
611-- prsr_2 = P.takeWhile (<= mid_value) FL.toList
612-- prsr_shortest = P.shortest prsr_1 prsr_2
613-- in
614-- case S.parse prsr_shortest (S.fromList ls) of
615-- Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= 2500) ls)
616-- Left _ -> property False
618-- shortestFailLeft :: Property
619-- shortestFailLeft =
620-- property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
621-- Right r -> r == 1
622-- Left _ -> False)
624-- shortestFailRight :: Property
625-- shortestFailRight =
626-- property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
627-- Right r -> r == 1
628-- Left _ -> False)
630-- shortestFailBoth :: Property
631-- shortestFailBoth =
632-- property (case S.parse (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
633-- Right _ -> False
634-- Left _ -> True)
636many :: Property
637many =
638 forAll (listOf (chooseInt (0, 1))) $ \ls ->
639 let fldstp conL currL = return $ FL.Partial $ conL ++ currL
640 concatFold = FL.Fold fldstp (return (FL.Partial [])) return
641 prsr =
642 flip P.many concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
643 in
644 case S.parse prsr (S.fromList ls) of
645 Right res_list -> checkListEqual res_list
646 $ Prelude.filter (== 0) ls
647 Left _ -> property False
649-- many_empty :: Property
650-- many_empty =
651-- property (case S.parse (P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
652-- Right res_list -> checkListEqual res_list ([] :: [Int])
653-- Left _ -> property False)
655some :: Property
656some =
657 forAll (listOf (chooseInt (0, 1))) $ \genLs ->
658 let
659 ls = 0 : genLs
660 fldstp conL currL = return $ FL.Partial $ conL ++ currL
661 concatFold = FL.Fold fldstp (return (FL.Partial [])) return
662 prsr =
663 flip P.some concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
664 in
665 case S.parse prsr (S.fromList ls) of
666 Right res_list -> res_list == Prelude.filter (== 0) ls
667 Left _ -> False
669-- someFail :: Property
670-- someFail =
671-- property (case S.parse (P.some FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
672-- Right _ -> False
673-- Left _ -> True)
675-------------------------------------------------------------------------------
676-- Instances
677-------------------------------------------------------------------------------
679applicative :: Property
680applicative =
681 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
682 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
683 let parser =
684 (,)
685 <$> P.fromFold (FL.take (length list1) FL.toList)
686 <*> P.fromFold (FL.take (length list2) FL.toList)
687 in monadicIO $ do
688 (olist1, olist2) <-
689 run $ S.parse parser (S.fromList $ list1 ++ list2)
690 listEquals (==) olist1 list1
691 listEquals (==) olist2 list2
693sequence :: Property
694sequence =
695 forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->
696 let p xs = P.fromFold (FL.take (length xs) FL.toList)
697 in monadicIO $ do
698 outs <- run $
699 S.parse
700 (Prelude.sequence $ fmap p ins)
701 (S.fromList $ concat ins)
702 listEquals (==) outs ins
704monad :: Property
705monad =
706 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
707 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
708 let parser = do
709 olist1 <- P.fromFold (FL.take (length list1) FL.toList)
710 olist2 <- P.fromFold (FL.take (length list2) FL.toList)
711 return (olist1, olist2)
712 in monadicIO $ do
713 (olist1, olist2) <-
714 run $ S.parse parser (S.fromList $ list1 ++ list2)
715 listEquals (==) olist1 list1
716 listEquals (==) olist2 list2
718-------------------------------------------------------------------------------
719-- Stream parsing
720-------------------------------------------------------------------------------
722parseMany :: Property
723parseMany =
724 forAll (chooseInt (1,100)) $ \len ->
725 forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
726 monadicIO $ do
727 outs <- do
728 let p = P.fromFold $ FL.take len FL.toList
729 run
730 $ S.toList
731 $ S.parseMany p (S.fromList $ concat ins)
732 listEquals (==) outs ins
734-------------------------------------------------------------------------------
735-- Test for a particular case hit during fs events testing
736-------------------------------------------------------------------------------
738evId :: [Word8]
739evId = [96,238,17,9,0,0,0,0]
741evFlags :: [Word8]
742evFlags = [0,4,1,0,0,0,0,0]
744evPathLen :: [Word8]
745evPathLen = [71,0,0,0,0,0,0,0]
747evPath :: [Word8]
748evPath =
749 [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109
750 ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112
751 ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116
752 ,114,101,97,109,108,121,47,116,109,112,47,122,122
753 ]
755event :: [Word8]
756event = evId ++ evFlags ++ evPathLen ++ evPath
758data Event = Event
759 { eventId :: Word64
760 , eventFlags :: Word32
761 , eventAbsPath :: A.Array Word8
762 } deriving (Show, Ord, Eq)
764readOneEvent :: P.Parser IO Word8 Event
765readOneEvent = do
766 arr <- P.takeEQ 24 (A.writeN 24)
767 let arr1 = A.castUnsafe arr :: A.Array Word64
768 eid = A.unsafeIndex 0 arr1
769 eflags = A.unsafeIndex 1 arr1
770 pathLen = fromIntegral $ A.unsafeIndex 2 arr1
771 -- XXX handle if pathLen is 0
772 path <- P.takeEQ pathLen (A.writeN pathLen)
773 return $ Event
774 { eventId = eid
775 , eventFlags = fromIntegral eflags
776 , eventAbsPath = path
777 }
779parseMany2Events :: Property
780parseMany2Events =
781 monadicIO $ do
782 xs <-
783 ( run
784 $ S.toList
785 $ S.parseMany readOneEvent
786 $ S.fromList (concat (replicate 2 event))
787 )
788 assert (length xs == 2)
789 -- XXX assuming little endian machine
790 let ev = Event
791 { eventId = 152170080
792 , eventFlags = 66560
793 , eventAbsPath = A.fromList evPath
794 }
795 in listEquals (==) xs (replicate 2 ev)
797manyEqParseMany :: Property
798manyEqParseMany =
799 forAll (listOf (chooseInt (0, 100))) $ \lst ->
800 forAll (chooseInt (1, 100)) $ \i ->
801 monadicIO $ do
802 let strm = S.fromList lst
803 r1 <- run $ S.parse (P.many (split i) FL.toList) strm
804 r2 <- run $ S.toList $ S.parseMany (split i) strm
805 assert $ r1 == r2
807 where
809 split i = P.fromFold (FL.take i FL.toList)
812takeEndBy1 :: Property
813takeEndBy1 =
814 forAll (listOf (chooseInt (0, 1))) $ \ls ->
815 case S.parse (P.takeEndBy predicate prsr) (S.fromList ls) of
816 Right parsed_list ->
817 checkListEqual
818 parsed_list
819 (takeWhileAndFirstFail (not . predicate) ls)
820 Left _ -> property False
821 where
822 prsr = P.many (P.satisfy (const True)) FL.toList
824 predicate = (== 1)
826 takeWhileAndFirstFail prd (x : xs) =
827 if prd x
828 then x : takeWhileAndFirstFail prd xs
829 else [x]
830 takeWhileAndFirstFail _ [] = []
832takeEndBy2 :: Property
833takeEndBy2 =
834 forAll (listOf (chooseInt (0, 1))) $ \ls ->
835 let
836 strm = S.fromList ls
838 predicate = (==0)
840 eitherParsedList =
841 S.toList $
842 S.parseMany (P.takeEndBy predicate prsr) strm
844 where
846 prsr = P.many (P.satisfy (const True)) FL.toList
848 eitherSplitList =
849 case ls of
850 [] -> return []
851 _ ->
852 if last ls == 0
853 then S.toList $ S.append strm1 (S.fromList [])
854 else S.toList strm1
856 where
858 strm1 = S.splitWithSuffix predicate FL.toList strm
859 in
860 case eitherParsedList of
861 Left _ -> property False
862 Right parsedList ->
863 case eitherSplitList of
864 Left _ -> property False
865 Right splitList -> checkListEqual parsedList splitList
867takeEndByEsc :: Property
868takeEndByEsc =
869 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
870 let
871 msg = "takeEndByEsc: trailing escape"
873 isSep = even
875 isEsc x = x `mod` 6 == 0
877 prsr = P.takeEndByEsc isEsc isSep prsr0
879 where
881 prsr0 = P.many (P.satisfy (const True)) FL.toList
883 escapeSep maybePrevEsc [] =
884 case maybePrevEsc of
885 Nothing -> []
886 Just prevEsc -> [prevEsc]
887 escapeSep maybePrevEsc (x : xs) =
888 case maybePrevEsc of
889 Nothing ->
890 if isEsc x
891 then escapeSep (Just x) xs
892 else
893 if isSep x
894 then [x]
895 else x : escapeSep Nothing xs
896 Just _ ->
897 x : escapeSep Nothing xs
898 in
899 case S.parse prsr (S.fromList ls) of
900 Right parsed_list -> checkListEqual parsed_list $ escapeSep Nothing ls
901 Left err -> property (displayException err == msg)
903takeFramedByEsc_ :: Property
904takeFramedByEsc_ =
905 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
906 let
907 isBegin = (== 0)
909 isEnd = (== 1)
911 isEsc = (== 2)
913 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
915 checkPass (x : xs) maybePrevEsc openMinusClose =
916 case maybePrevEsc of
917 Nothing ->
918 if isEsc x
919 then checkPass xs (Just x) openMinusClose
920 else
921 if isBegin x
922 then checkPass xs Nothing (openMinusClose + 1)
923 else
924 if isEnd x
925 then
926 case openMinusClose of
927 0 -> False
928 1 -> True
929 _ ->
930 checkPass
931 xs
932 Nothing
933 (openMinusClose - 1)
934 else
935 checkPass xs Nothing openMinusClose
936 Just _ -> checkPass xs Nothing openMinusClose
937 checkPass [] _ _ = False
939 escapeFrame begin end escape l =
940 let
941 helper (x : xs) maybePrevEsc openMinusClose =
942 case maybePrevEsc of
943 Nothing ->
944 if escape x
945 then helper xs (Just x) openMinusClose
946 else
947 if begin x
948 then helper xs Nothing (openMinusClose + 1)
949 else
950 if end x
951 then
952 if openMinusClose - 1 == 0
953 then []
954 else
955 helper
956 xs
957 Nothing
958 (openMinusClose - 1)
959 else
960 x : helper xs Nothing openMinusClose
961 Just prevEsc ->
962 if escape x || begin x || end x
963 then x : helper xs Nothing openMinusClose
964 else
965 prevEsc : x : helper xs Nothing openMinusClose
966 helper [] _ _ = error "Cannot Reach Here"
967 in
968 helper l Nothing (0 :: Int)
969 in
970 case S.parse prsr (S.fromList ls) of
971 Right parsed_list ->
972 if checkPass ls Nothing (0 :: Int)
973 then checkListEqual parsed_list $
974 escapeFrame isBegin isEnd isEsc ls
975 else property False
976 Left _ ->
977 if checkPass ls Nothing (0 :: Int)
978 then property False
979 else property True
981takeFramedByEsc_Pass :: Property
982takeFramedByEsc_Pass =
983 forAll (listOf (chooseInt (min_value, max_value))) $ \list ->
984 let
985 ls = (0 : list) ++ (Prelude.replicate (Prelude.length list + 1) 1)
987 isBegin = (== 0)
989 isEnd = (== 1)
991 isEsc = (== 2)
993 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
995 escapeFrame begin end escape l =
996 let
997 helper (x : xs) maybePrevEsc openMinusClose =
998 case maybePrevEsc of
999 Nothing ->
1000 if escape x
1001 then helper xs (Just x) openMinusClose
1002 else
1003 if begin x
1004 then
1005 if openMinusClose == 0
1006 then helper xs Nothing (openMinusClose + 1)
1007 else x : helper xs Nothing (openMinusClose + 1)
1008 else
1009 if end x
1010 then
1011 if openMinusClose - 1 == 0
1012 then []
1013 else
1014 x :
1015 helper
1016 xs
1017 Nothing
1018 (openMinusClose - 1)
1019 else
1020 x : helper xs Nothing openMinusClose
1021 Just _ ->
1022 x : helper xs Nothing openMinusClose
1023 helper [] _ _ = error "Cannot Reach Here"
1024 in
1025 helper l Nothing (0 :: Int)
1026 in
1027 case S.parse prsr (S.fromList ls) of
1028 Right parsed_list -> checkListEqual parsed_list $ escapeFrame isBegin isEnd isEsc ls
1029 _ -> property False
1031takeFramedByEsc_Fail1 :: Property
1032takeFramedByEsc_Fail1 =
1033 let
1034 msg = "takeFramedByEsc_: missing frame end"
1036 isBegin = (== 0)
1038 isEnd = (== 0)
1040 isEsc = (== 2)
1042 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1044 ls = [0 :: Int]
1045 in
1046 case S.parse prsr (S.fromList ls) of
1047 Right _ -> property False
1048 Left err -> property (displayException err == msg)
1050takeFramedByEsc_Fail2 :: Property
1051takeFramedByEsc_Fail2 =
1052 let
1053 msg = "takeFramedByEsc_: missing frame start"
1055 isBegin = (== 0)
1057 isEnd = (== 1)
1059 isEsc = (== 1)
1061 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1063 ls = [1 :: Int]
1064 in
1065 case S.parse prsr (S.fromList ls) of
1066 Right _ -> property False
1067 Left err -> property (displayException err == msg)
1069takeFramedByEsc_Fail3 :: Property
1070takeFramedByEsc_Fail3 =
1071 let
1072 msg = "takeFramedByEsc_: missing frame end"
1074 isBegin = (== 2)
1076 isEnd = (== 1)
1078 isEsc = (== 2)
1080 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1082 ls = [2 :: Int]
1083 in
1084 case S.parse prsr (S.fromList ls) of
1085 Right _ -> property False
1086 Left err -> property $ (displayException err == msg)
1088takeStartBy_ :: Property
1089takeStartBy_ =
1090 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
1091 let ls1 = 1:ls
1092 msg = "takeFramedByGeneric: empty token"
1093 in
1094 case S.parse parser (S.fromList ls1) of
1095 Right parsed_list ->
1096 if not $ Prelude.null ls1
1097 then
1098 let tls = Prelude.takeWhile (not . predicate) (tail ls1)
1099 in checkListEqual parsed_list $
1100 if predicate (head ls1)
1101 then tls
1102 else Prelude.takeWhile (not . predicate) ls1
1103 else property $ Prelude.null parsed_list
1104 Left err -> property (displayException err == msg)
1105 where
1106 predicate = odd
1107 parser = P.takeStartBy_ predicate FL.toList
1108-------------------------------------------------------------------------------
1109-- Main
1110-------------------------------------------------------------------------------
1112moduleName :: String
1113moduleName = "Data.Parser"
1115main :: IO ()
1116main =
1117 hspec $
1118 H.parallel $
1119 modifyMaxSuccess (const maxTestCount) $ do
1120 describe moduleName $ do
1122 describe "Instances" $ do
1123 prop "applicative" applicative
1124 prop "monad" monad
1125 prop "sequence" sequence
1126 describe "Stream parsing" $ do
1127 prop "parseMany" parseMany
1128 prop "parseMany2Events" parseMany2Events
1130 describe "test for accumulator" $ do
1131 prop "P.fromFold FL.sum = FL.sum" fromFold
1132 prop "fromPure value provided" fromPure
1133 prop "fromPure monadic value provided" fromEffect
1134 prop "fail err = Left (SomeException (ParseError err))" parserFail
1135 prop "always fail" die
1136 prop "always fail but monadic" dieM
1138 describe "test for element parser" $ do
1139 prop "peek = head with list length > 0" peekPass
1140 prop "peek fail on []" peekFail
1141 prop "eof pass on []" eofPass
1142 prop "eof fail on non-empty list" eofFail
1143 prop "first element exists and >= mid_value" satisfyPass
1144 prop "one pass on [Int]" onePass
1145 prop "one fail on []" one
1146 prop "check first element exists and satisfies predicate" satisfy
1148 describe "test for sequence parser" $ do
1149 prop "P.takeBetween = Prelude.take when len >= m and len <= n"
1150 takeBetweenPass
1151 prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail"
1152 ++ "otherwise fail") Main.takeBetween
1154 prop "P.takeEQ = Prelude.take when len >= n" takeEQPass
1155 prop "P.takeEQ = Prelude.take when len >= n and fail otherwise"
1156 Main.takeEQ
1157 prop "P.takeGE n ls = ls when len >= n" takeGEPass
1158 prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE
1159 -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass
1160 -- prop "Fail when stream length exceeded" lookAheadFail
1161 -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
1162 prop "P.takeEndBy_ test" Main.takeEndBy_
1163 prop ("P.takeStartBy pred = head : Prelude.takeWhile (not . pred)"
1164 ++ " tail") takeStartBy
1165 prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
1166 prop ("P.takeWhile1 = Prelude.takeWhile if taken something,"
1167 ++ " else check why failed") takeWhile1
1168 prop "takeWhileP prd P.take = takeWhileMaxLen prd" takeWhileP
1169 prop ("P.takeP = Prelude.take") takeP
1170 prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy
1171 prop "many (P.wordBy ' ') = words'" wordBy
1172 parseManyWordQuotedBy
1173 prop "choice" choice
1174 -- prop "" splitWithPass
1175 -- prop "" splitWithFailLeft
1176 -- prop "" splitWithFailRight
1177 -- prop "" splitWithFailBoth
1178 -- prop "" teeWithPass
1179 -- prop "" teeWithFailLeft
1180 -- prop "" teeWithFailRight
1181 -- prop "" teeWithFailBoth
1182 prop "deintercalate" deintercalate
1183 -- prop "" shortestPass
1184 -- prop "" shortestFailLeft
1185 -- prop "" shortestFailRight
1186 -- prop "" shortestFailBoth
1187 prop ("P.many concatFold $ P.takeEndBy_ (== 1) FL.toList ="
1188 ++ "Prelude.filter (== 0)") many
1189 -- prop "[] due to parser being die" many_empty
1190 prop ("P.some concatFold $ P.takeEndBy_ (== 1) FL.toList ="
1191 ++ "Prelude.filter (== 0)") some
1192 -- prop "fail due to parser being die" someFail
1193 prop "P.many == S.parseMany" manyEqParseMany
1195 prop "takeEndBy_" takeEndBy_
1196 prop "takeEndBy1" takeEndBy1
1197 prop "takeEndBy2" takeEndBy2
1198 prop "takeEndByEsc" takeEndByEsc
1199 prop "takeFramedByEsc_" takeFramedByEsc_
1200 prop "takeFramedByEsc_Pass" takeFramedByEsc_Pass
1201 prop "takeFramedByEsc_Fail1" takeFramedByEsc_Fail1
1202 prop "takeFramedByEsc_Fail2" takeFramedByEsc_Fail2
1203 prop "takeFramedByEsc_Fail3" takeFramedByEsc_Fail3
1204 prop "takeStartBy_" takeStartBy_
1206 takeProperties