git.iko.soy/streamly
on abdc6e1 help sign in
streamly/test/Streamly/Test/Data/Parser.hs
1230 lines 45 kB history raw
1module Main (main) where
3import Control.Exception (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 Control.Monad.Fail as Fail
17import qualified Data.List as List
18import qualified Prelude
19import qualified Streamly.Internal.Data.Array as A
20import qualified Streamly.Internal.Data.Fold as FL
21import qualified Streamly.Internal.Data.Parser as P
22import qualified Streamly.Internal.Data.Stream as S
23import qualified Test.Hspec as H
25#if MIN_VERSION_QuickCheck(2,14,0)
27import Test.QuickCheck (chooseAny)
28import Control.Monad.Identity (Identity(runIdentity, Identity))
29import Streamly.Internal.Data.Parser (ParseError(..))
31#else
33import System.Random (Random(random))
34import Test.QuickCheck.Gen (Gen(MkGen))
36-- | Generates a random element over the natural range of `a`.
37chooseAny :: Random a => Gen a
38chooseAny = MkGen (\r _ -> let (x,_) = random r in x)
40#endif
42maxTestCount :: Int
43maxTestCount = 100
45min_value :: Int
46min_value = 0
48mid_value :: Int
49mid_value = 5000
51max_value :: Int
52max_value = 10000
54max_length :: Int
55max_length = 1000
57-- Accumulator Tests
59fromFold :: Property
60fromFold =
61 forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
62 monadicIO $ do
63 s1 <- S.parse (P.fromFold FL.sum) (S.fromList ls)
64 o2 <- S.fold FL.sum (S.fromList ls)
65 return $
66 case s1 of
67 Right o1 -> o1 == o2
68 Left _ -> False
70fromPure :: Property
71fromPure =
72 forAll (chooseInt (min_value, max_value)) $ \x ->
73 case runIdentity $ S.parse (P.fromPure x) (S.fromList [1 :: Int]) of
74 Right r -> r == x
75 Left _ -> False
77fromEffect :: Property
78fromEffect =
79 forAll (chooseInt (min_value, max_value)) $ \x ->
80 case runIdentity $ S.parse (P.fromEffect $ return x) (S.fromList [1 :: Int]) of
81 Right r -> r == x
82 Left _ -> False
84die :: Property
85die =
86 property $
87 case runIdentity $ S.parse (P.die "die test") (S.fromList [0 :: Int]) of
88 Right _ -> False
89 Left _ -> True
91dieM :: Property
92dieM =
93 property $
94 case runIdentity $ S.parse (P.dieM (Identity "die test")) (S.fromList [0 :: Int]) of
95 Right _ -> False
96 Left _ -> True
98parserFail :: Property
99parserFail =
100 property $
101 case runIdentity $ S.parse (Fail.fail err) (S.fromList [0 :: Int]) of
102 Right _ -> False
103 Left (ParseError e) -> err == e
104 where
105 err = "Testing MonadFail.fail."
107-- Element Parser Tests
109peekPass :: Property
110peekPass =
111 forAll (chooseInt (1, max_length)) $ \list_length ->
112 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
113 case runIdentity $ S.parse P.peek (S.fromList ls) of
114 Right head_value -> case ls of
115 head_ls : _ -> head_value == head_ls
116 _ -> False
117 Left _ -> False
119peekFail :: Property
120peekFail =
121 property (case runIdentity $ S.parse P.peek (S.fromList []) of
122 Right _ -> False
123 Left _ -> True)
125eofPass :: Property
126eofPass =
127 property (case runIdentity $ S.parse P.eof (S.fromList []) of
128 Right _ -> True
129 Left _ -> False)
131eofFail :: Property
132eofFail =
133 forAll (chooseInt (1, max_length)) $ \list_length ->
134 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
135 case runIdentity $ S.parse P.eof (S.fromList ls) of
136 Right _ -> False
137 Left _ -> True
139satisfyPass :: Property
140satisfyPass =
141 forAll (chooseInt (mid_value, max_value)) $ \first_element ->
142 forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->
143 let
144 ls = first_element : ls_tail
145 predicate = (>= mid_value)
146 in
147 case runIdentity $ S.parse (P.satisfy predicate) (S.fromList ls) of
148 Right r -> r == first_element
149 Left _ -> False
151satisfy :: Property
152satisfy =
153 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
154 case runIdentity $ S.parse (P.satisfy predicate) (S.fromList ls) of
155 Right r -> case ls of
156 [] -> False
157 (x : _) -> predicate x && (r == x)
158 Left _ -> case ls of
159 [] -> True
160 (x : _) -> not $ predicate x
161 where
162 predicate = (>= mid_value)
164onePass :: Property
165onePass =
166 forAll (chooseInt (1, max_value)) $ \int ->
167 property (case runIdentity $ S.parse P.one (S.fromList [int]) of
168 Right i -> i == int
169 Left _ -> False)
171one :: Property
172one =
173 property $
174 case runIdentity $ S.parse P.one (S.fromList []) of
175 Left _ -> True
176 Right _ -> False
178-- Sequence Parsers Tests
179takeBetweenPass :: Property
180takeBetweenPass =
181 forAll (chooseInt (min_value, max_value)) $ \m ->
182 forAll (chooseInt (m, max_value)) $ \n ->
183 forAll (chooseInt (m, max_value)) $ \list_length ->
184 forAll (vectorOf list_length (chooseInt (min_value, max_value)))
185 $ \ls ->
186 case runIdentity $ S.parse (P.takeBetween m n FL.toList)
187 (S.fromList ls) of
188 Right parsed_list ->
189 let lpl = Prelude.length parsed_list
190 in checkListEqual parsed_list
191 $ Prelude.take lpl ls
192 Left _ -> property False
194takeBetween :: Property
195takeBetween =
196 forAll (chooseInt (min_value, max_value)) $ \m ->
197 forAll (chooseInt (min_value, max_value)) $ \n ->
198 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
199 go m n ls
201 where
203 go m n ls =
204 let inputLen = Prelude.length ls
205 in do
206 let p = P.takeBetween m n FL.toList
207 case runIdentity $ S.parse p (S.fromList ls) of
208 Right xs ->
209 let parsedLen = Prelude.length xs
210 in if inputLen >= m && parsedLen >= m && parsedLen <= n
211 then checkListEqual xs $ Prelude.take parsedLen ls
212 else property False
213 Left _ ->
214 property ((m >= 0 && n >= 0 && m > n) || inputLen < m)
217takeEQPass :: Property
218takeEQPass =
219 forAll (chooseInt (min_value, max_value)) $ \n ->
220 forAll (chooseInt (n, max_value)) $ \list_length ->
221 forAll (vectorOf list_length
222 (chooseInt (min_value, max_value))) $ \ls ->
223 case runIdentity $ S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
224 Right parsed_list ->
225 checkListEqual parsed_list (Prelude.take n ls)
226 Left _ -> property False
228takeEQ :: Property
229takeEQ =
230 forAll (chooseInt (min_value, max_value)) $ \n ->
231 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
232 let
233 list_length = Prelude.length ls
234 in
235 case runIdentity $ S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
236 Right parsed_list ->
237 if n <= list_length
238 then checkListEqual parsed_list (Prelude.take n ls)
239 else property False
240 Left _ -> property (n > list_length)
242takeGEPass :: Property
243takeGEPass =
244 forAll (chooseInt (min_value, max_value)) $ \n ->
245 forAll (chooseInt (n, max_value)) $ \list_length ->
246 forAll (vectorOf list_length (chooseInt (min_value, max_value)))
247 $ \ls ->
248 case runIdentity $ S.parse (P.takeGE n FL.toList) (S.fromList ls) of
249 Right parsed_list -> checkListEqual parsed_list ls
250 Left _ -> property False
252takeGE :: Property
253takeGE =
254 forAll (chooseInt (min_value, max_value)) $ \n ->
255 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
256 let
257 list_length = Prelude.length ls
258 in
259 case runIdentity $ S.parse (P.takeGE n FL.toList) (S.fromList ls) of
260 Right parsed_list ->
261 if n <= list_length
262 then checkListEqual parsed_list ls
263 else property False
264 Left _ -> property (n > list_length)
267nLessThanEqual0 ::
268 ( Int
269 -> FL.Fold Identity Int [Int]
270 -> P.Parser Int Identity [Int]
271 )
272 -> (Int -> [Int] -> [Int])
273 -> Property
274nLessThanEqual0 tk ltk =
275 forAll (elements [0, (-1)]) $ \n ->
276 forAll (listOf arbitrary) $ \ls ->
277 case runIdentity $ S.parse (tk n FL.toList) (S.fromList ls) of
278 Right parsed_list -> checkListEqual parsed_list (ltk n ls)
279 Left _ -> property False
281takeProperties :: Spec
282takeProperties =
283 describe "take combinators when n <= 0/" $ do
284 prop "takeEQ n FL.toList = []" $
285 nLessThanEqual0 P.takeEQ (\_ -> const [])
286 prop "takeGE n FL.toList xs = xs" $
287 nLessThanEqual0 P.takeGE (\_ -> id)
289-- lookAheadPass :: Property
290-- lookAheadPass =
291-- forAll (chooseInt (min_value + 1, max_value)) $ \n ->
292-- let
293-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
294-- parseTwice = do
295-- parsed_list_1 <- takeWithoutConsume
296-- parsed_list_2 <- takeWithoutConsume
297-- return (parsed_list_1, parsed_list_2)
298-- in
299-- forAll (chooseInt (n, max_value)) $ \list_length ->
300-- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
301-- case S.parse parseTwice (S.fromList ls) of
302-- Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
303-- Left _ -> property $ False
305-- lookAheadFail :: Property
306-- lookAheadFail =
307-- forAll (chooseInt (min_value + 1, max_value)) $ \n ->
308-- let
309-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
310-- parseTwice = do
311-- parsed_list_1 <- takeWithoutConsume
312-- parsed_list_2 <- takeWithoutConsume
313-- return (parsed_list_1, parsed_list_2)
314-- in
315-- forAll (chooseInt (min_value, n - 1)) $ \list_length ->
316-- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
317-- case S.parse parseTwice (S.fromList ls) of
318-- Right _ -> False
319-- Left _ -> True
321-- lookAhead :: Property
322-- lookAhead =
323-- forAll (chooseInt (min_value, max_value)) $ \n ->
324-- let
325-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
326-- parseTwice = do
327-- parsed_list_1 <- takeWithoutConsume
328-- parsed_list_2 <- takeWithoutConsume
329-- return (parsed_list_1, parsed_list_2)
330-- in
331-- forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
332-- case S.parse parseTwice (S.fromList ls) of
333-- Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
334-- Left _ -> property ((list_length < n) || (list_length == n && n == 0))
335-- where
336-- list_length = Prelude.length ls
338takeEndBy_ :: Property
339takeEndBy_ =
340 forAll (listOf (chooseInt (min_value, max_value ))) $ \ls ->
341 case runIdentity $ S.parse (P.takeEndBy_ predicate prsr) (S.fromList ls) of
342 Right parsed_list ->
343 checkListEqual parsed_list (tkwhl ls)
344 Left _ -> property False
345 where
346 predicate = (>= 100)
347 prsr = P.many (P.satisfy (const True)) FL.toList
348 tkwhl ls = Prelude.takeWhile (not . predicate) ls
350takeStartBy :: Property
351takeStartBy =
352 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
353 let ls1 = 1:ls
354 in
355 case runIdentity $ S.parse parser (S.fromList ls1) of
356 Right parsed_list ->
357 if not $ Prelude.null ls1
358 then
359 let tls = Prelude.takeWhile (not . predicate) (tail ls1)
360 in checkListEqual parsed_list $
361 if predicate (head ls1)
362 then head ls1 : tls
363 else Prelude.takeWhile (not . predicate) ls1
364 else property $ Prelude.null parsed_list
365 Left _ -> property False
366 where
367 predicate = odd
368 parser = P.takeStartBy predicate FL.toList
370takeWhile :: Property
371takeWhile =
372 forAll (listOf (chooseInt (0, 1))) $ \ ls ->
373 case runIdentity $ S.parse (P.takeWhile predicate FL.toList) (S.fromList ls) of
374 Right parsed_list ->
375 checkListEqual parsed_list (Prelude.takeWhile predicate ls)
376 Left _ -> property False
377 where
378 predicate = (== 0)
380takeP :: Property
381takeP =
382 forAll
383 ((,) <$> chooseInt (min_value, max_value)
384 <*> listOf (chooseInt (0, 1)))
385 $ \(takeNum, ls) ->
386 case runIdentity $ S.parse
387 (P.takeP takeNum (P.fromFold FL.toList))
388 (S.fromList ls) of
389 Right parsed_list ->
390 checkListEqual parsed_list (Prelude.take takeNum ls)
391 Left _ -> property False
393takeWhile1 :: Property
394takeWhile1 =
395 forAll (listOf (chooseInt (0, 1))) $ \ ls ->
396 case runIdentity $ S.parse (P.takeWhile1 predicate FL.toList) (S.fromList ls) of
397 Right parsed_list -> case ls of
398 [] -> property False
399 (x : _) ->
400 if predicate x
401 then
402 checkListEqual parsed_list
403 $ Prelude.takeWhile predicate ls
404 else
405 property False
406 Left _ -> case ls of
407 [] -> property True
408 (x : _) -> property (not $ predicate x)
409 where
410 predicate = (== 0)
412takeWhileP :: Property
413takeWhileP =
414 forAll (listOf (chooseInt (0, 1))) $ \ls ->
415 forAll (chooseInt (min_value, max_value)) $ \n ->
416 let
417 predicate = (== 1)
419 prsr =
420 P.takeWhileP predicate
421 $ P.fromFold (FL.take n FL.toList)
423 takeWhileTillLen maxLen prd list =
424 Prelude.take maxLen $ Prelude.takeWhile prd list
425 in
426 case runIdentity $ S.parse prsr (S.fromList ls) of
427 Right parsed_list ->
428 checkListEqual
429 parsed_list
430 (takeWhileTillLen n predicate ls)
431 Left _ -> property False
433{-
434choice :: Property
435choice =
436 forAll
437 ((,,) <$> chooseInt (min_value, max_value)
438 <*> chooseInt (min_value, max_value)
439 <*> listOf (chooseInt (0, 1)))
440 $ \(i, j, ls) ->
441 case S.parse (P.choice [parser i, parser j]) (S.fromList ls) of
442 Right parsed_list ->
443 checkListEqual parsed_list $ take (min i j) ls
444 Left _ -> property False
446 where
448 parser i = P.fromFold (FL.take i FL.toList)
449-}
451groupBy :: Property
452groupBy =
453 forAll (listOf (chooseInt (0, 1)))
454 $ \ls ->
455 case runIdentity $ S.parse parser (S.fromList ls) of
456 Right parsed -> checkListEqual parsed (groupByLF ls)
457 Left _ -> property False
459 where
461 cmp = (==)
462 parser = P.groupBy cmp FL.toList
463 groupByLF lst
464 | null lst = []
465 | otherwise = head $ List.groupBy cmp lst
467wordBy :: Property
468wordBy =
469 forAll (listOf (elements [' ', 's']))
470 $ \ls ->
471 case runIdentity $ S.parse parser (S.fromList ls) of
472 Right parsed -> checkListEqual parsed (words' ls)
473 Left _ -> property False
475 where
477 predicate = (== ' ')
478 parser = P.many (P.wordBy predicate FL.toList) FL.toList
479 words' lst =
480 let wrds = words lst
481 in if wrds == [] && length lst > 0 then [""] else wrds
483parseManyWordQuotedBy :: H.SpecWith ()
484parseManyWordQuotedBy =
485 describe "parseMany wordQuotedBy"
486 $ for_ testCases
487 $ \c@(kQ, isQ, input, expected) -> do
488 let inpStrm = S.fromList input
490 esc = '\\'
492 spc ' ' = True
493 spc _ = False
495 tr _ _ = Nothing
497 parser = P.wordWithQuotes kQ tr esc isQ spc FL.toList
498 result <- H.runIO $ S.fold FL.toList $ S.catRights $ S.parseMany parser inpStrm
499 H.it (showCase c) $ result `H.shouldBe` expected
501 where
503 showCase (kQ, _, input, expected) =
504 show kQ ++ ", " ++ input ++ " -> " ++ show expected
506 testCases =
507 [ ( True
508 , \x -> if x == '\'' then Just '\'' else Nothing
509 , "The quick brown fox"
510 , ["The", "quick", "brown", "fox"])
511 , ( True
512 , \x -> if x == '\'' then Just '\'' else Nothing
513 , "The' quick brown' fox"
514 , ["The' quick brown'", "fox"])
515 , ( False
516 , \x -> if x == '\'' then Just '\'' else Nothing
517 , "The' quick brown' fox"
518 , ["The quick brown", "fox"])
519 , ( True
520 , \x -> if x == '[' then Just ']' else Nothing
521 , "The[ quick brown] fox"
522 , ["The[ quick brown]", "fox"])
523 , ( True
524 , \x -> if x == '[' then Just ']' else Nothing
525 , "The[ qui[ck] brown] \\ f[ ox]"
526 , ["The[ qui[ck] brown]", " f[ ox]"])
527 , ( False
528 , \x -> if x == '[' then Just ']' else Nothing
529 , "The[ qui[ck] brown] fox"
530 , ["The qui[ck] brown", "fox"])
531 ]
534-- splitWithPass :: Property
535-- splitWithPass =
536-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
537-- case S.parse (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of
538-- Right (result_first, result_second) -> case ls of
539-- 0 : 1 : _ -> (result_first == 0) && (result_second == 1)
540-- _ -> False
541-- Left _ -> case ls of
542-- 0 : 1 : _ -> False
543-- _ -> True
545-- splitWithFailLeft :: Property
546-- splitWithFailLeft =
547-- property (case S.parse (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
548-- Right _ -> False
549-- Left _ -> True)
551-- splitWithFailRight :: Property
552-- splitWithFailRight =
553-- property (case S.parse (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
554-- Right _ -> False
555-- Left _ -> True)
557-- splitWithFailBoth :: Property
558-- splitWithFailBoth =
559-- property (case S.parse (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
560-- Right _ -> False
561-- Left _ -> True)
563-- teeWithPass :: Property
564-- teeWithPass =
565-- forAll (chooseInt (0, 10000)) $ \n ->
566-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
567-- let
568-- prsr = P.take n FL.toList
569-- in
570-- case S.parse (P.teeWith (,) prsr prsr) (S.fromList ls) of
571-- Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
572-- Left _ -> property False
574-- teeWithFailLeft :: Property
575-- teeWithFailLeft =
576-- property (case S.parse (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
577-- Right _ -> False
578-- Left _ -> True)
580-- teeWithFailRight :: Property
581-- teeWithFailRight =
582-- property (case S.parse (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
583-- Right _ -> False
584-- Left _ -> True)
586-- teeWithFailBoth :: Property
587-- teeWithFailBoth =
588-- property (case S.parse (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
589-- Right _ -> False
590-- Left _ -> True)
592{-
593deintercalate :: Property
594deintercalate =
595 forAll (listOf (chooseAny :: Gen Int)) $ \ls ->
596 case runIdentity $ S.parse p (S.fromList ls) of
597 Right evenOdd -> evenOdd == List.partition even ls
598 Left _ -> False
600 where
601 p1 = P.takeWhile even FL.toList
602 p2 = P.takeWhile odd FL.toList
603 partition =
604 FL.tee (fmap concat $ FL.catLefts FL.toList)
605 (fmap concat $ FL.catRights FL.toList)
606 p = P.deintercalate p1 p2 partition
607-}
609-- shortestPass :: Property
610-- shortestPass =
611-- forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->
612-- let
613-- prsr_1 = P.takeWhile (<= (mid_value `Prelude.div` 2)) FL.toList
614-- prsr_2 = P.takeWhile (<= mid_value) FL.toList
615-- prsr_shortest = P.shortest prsr_1 prsr_2
616-- in
617-- case S.parse prsr_shortest (S.fromList ls) of
618-- Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= 2500) ls)
619-- Left _ -> property False
621-- shortestFailLeft :: Property
622-- shortestFailLeft =
623-- property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
624-- Right r -> r == 1
625-- Left _ -> False)
627-- shortestFailRight :: Property
628-- shortestFailRight =
629-- property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
630-- Right r -> r == 1
631-- Left _ -> False)
633-- shortestFailBoth :: Property
634-- shortestFailBoth =
635-- property (case S.parse (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
636-- Right _ -> False
637-- Left _ -> True)
639many :: Property
640many =
641 forAll (listOf (chooseInt (0, 1))) $ \ls ->
642 let fldstp conL currL = return $ FL.Partial $ conL ++ currL
643 concatFold = FL.Fold fldstp (return (FL.Partial [])) return
644 prsr =
645 flip P.many concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
646 in
647 case runIdentity $ S.parse prsr (S.fromList ls) of
648 Right res_list -> checkListEqual res_list
649 $ Prelude.filter (== 0) ls
650 Left _ -> property False
652-- many_empty :: Property
653-- many_empty =
654-- property (case S.parse (P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
655-- Right res_list -> checkListEqual res_list ([] :: [Int])
656-- Left _ -> property False)
658some :: Property
659some =
660 forAll (listOf (chooseInt (0, 1))) $ \genLs ->
661 let
662 ls = 0 : genLs
663 fldstp conL currL = return $ FL.Partial $ conL ++ currL
664 concatFold = FL.Fold fldstp (return (FL.Partial [])) return
665 prsr =
666 flip P.some concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
667 in
668 case runIdentity $ S.parse prsr (S.fromList ls) of
669 Right res_list -> res_list == Prelude.filter (== 0) ls
670 Left _ -> False
672-- someFail :: Property
673-- someFail =
674-- property (case S.parse (P.some FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
675-- Right _ -> False
676-- Left _ -> True)
678-------------------------------------------------------------------------------
679-- Instances
680-------------------------------------------------------------------------------
682applicative :: Property
683applicative =
684 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
685 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
686 let parser =
687 (,)
688 <$> P.fromFold (FL.take (length list1) FL.toList)
689 <*> P.fromFold (FL.take (length list2) FL.toList)
690 in monadicIO $ do
691 s <- S.parse parser (S.fromList $ list1 ++ list2)
692 return $
693 case s of
694 Right (olist1, olist2) -> olist1 == list1 && olist2 == list2
695 Left _ -> False
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 return $
707 case outs of
708 Right ls -> ls == ins
709 Left _ -> False
711monad :: Property
712monad =
713 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
714 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
715 let parser = do
716 olist1 <- P.fromFold (FL.take (length list1) FL.toList)
717 olist2 <- P.fromFold (FL.take (length list2) FL.toList)
718 return (olist1, olist2)
719 in monadicIO $ do
720 s <- S.parse parser (S.fromList $ list1 ++ list2)
721 return $
722 case s of
723 Right (olist1, olist2) -> olist1 == list1 && olist2 == list2
724 Left _ -> False
726-------------------------------------------------------------------------------
727-- Stream parsing
728-------------------------------------------------------------------------------
730parseMany :: Property
731parseMany =
732 forAll (chooseInt (1,100)) $ \len ->
733 forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
734 monadicIO $ do
735 outs <- do
736 let p = P.fromFold $ FL.take len FL.toList
737 run
738 $ S.fold FL.toList
739 $ S.catRights
740 $ S.parseMany p (S.fromList $ concat ins)
741 listEquals (==) outs ins
743-------------------------------------------------------------------------------
744-- Test for a particular case hit during fs events testing
745-------------------------------------------------------------------------------
747evId :: [Word8]
748evId = [96,238,17,9,0,0,0,0]
750evFlags :: [Word8]
751evFlags = [0,4,1,0,0,0,0,0]
753evPathLen :: [Word8]
754evPathLen = [71,0,0,0,0,0,0,0]
756evPath :: [Word8]
757evPath =
758 [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109
759 ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112
760 ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116
761 ,114,101,97,109,108,121,47,116,109,112,47,122,122
762 ]
764event :: [Word8]
765event = evId ++ evFlags ++ evPathLen ++ evPath
767data Event = Event
768 { eventId :: Word64
769 , eventFlags :: Word32
770 , eventAbsPath :: A.Array Word8
771 } deriving (Show, Ord, Eq)
773readOneEvent :: P.Parser Word8 IO Event
774readOneEvent = do
775 arr <- P.takeEQ 24 (A.writeN 24)
776 let arr1 = A.castUnsafe arr :: A.Array Word64
777 eid = A.unsafeIndex 0 arr1
778 eflags = A.unsafeIndex 1 arr1
779 pathLen = fromIntegral $ A.unsafeIndex 2 arr1
780 -- XXX handle if pathLen is 0
781 path <- P.takeEQ pathLen (A.writeN pathLen)
782 return $ Event
783 { eventId = eid
784 , eventFlags = fromIntegral eflags
785 , eventAbsPath = path
786 }
788parseMany2Events :: Property
789parseMany2Events =
790 monadicIO $ do
791 xs <-
792 ( run
793 $ S.fold FL.toList
794 $ S.catRights
795 $ S.parseMany readOneEvent
796 $ S.fromList (concat (replicate 2 event))
797 )
798 assert (length xs == 2)
799 -- XXX assuming little endian machine
800 let ev = Event
801 { eventId = 152170080
802 , eventFlags = 66560
803 , eventAbsPath = A.fromList evPath
804 }
805 in listEquals (==) xs (replicate 2 ev)
807manyEqParseMany :: Property
808manyEqParseMany =
809 forAll (listOf (chooseInt (0, 100))) $ \lst ->
810 forAll (chooseInt (1, 100)) $ \i ->
811 monadicIO $ do
812 let strm = S.fromList lst
813 r1 <- run $ S.parse (P.many (split i) FL.toList) strm
814 r2 <- run $ S.fold FL.toList $ S.catRights $ S.parseMany (split i) strm
815 return $
816 case r1 of
817 Right o1 -> o1 == r2
818 Left _ -> False
820 where
822 split i = P.fromFold (FL.take i FL.toList)
825takeEndBy1 :: Property
826takeEndBy1 =
827 forAll (listOf (chooseInt (0, 1))) $ \ls ->
828 case runIdentity $ S.parse (P.takeEndBy predicate prsr) (S.fromList ls) of
829 Right parsed_list ->
830 checkListEqual
831 parsed_list
832 (takeWhileAndFirstFail (not . predicate) ls)
833 Left _ -> property False
834 where
835 prsr = P.many (P.satisfy (const True)) FL.toList
837 predicate = (== 1)
839 takeWhileAndFirstFail prd (x : xs) =
840 if prd x
841 then x : takeWhileAndFirstFail prd xs
842 else [x]
843 takeWhileAndFirstFail _ [] = []
845splitWithSuffix
846 :: Monad m
847 => (a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b
848splitWithSuffix predicate f = S.foldMany (FL.takeEndBy predicate f)
850takeEndBy2 :: Property
851takeEndBy2 =
852 forAll (listOf (chooseInt (0, 1))) $ \ls ->
853 let
854 strm = S.fromList ls
856 predicate = (==0)
858 eitherParsedList =
859 S.fold FL.toList
860 $ S.catRights
861 $ S.parseMany (P.takeEndBy predicate prsr) strm
863 where
865 prsr = P.many (P.satisfy (const True)) FL.toList
867 eitherSplitList =
868 case ls of
869 [] -> return []
870 _ ->
871 if last ls == 0
872 then S.fold FL.toList $ S.append strm1 (S.fromList [])
873 else S.fold FL.toList strm1
875 where
877 strm1 = splitWithSuffix predicate FL.toList strm
878 in
879 case eitherParsedList of
880 Left _ -> property False
881 Right parsedList ->
882 case eitherSplitList of
883 Left _ -> property False
884 Right splitList -> checkListEqual parsedList splitList
886takeEndByEsc :: Property
887takeEndByEsc =
888 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
889 let
890 msg = "takeEndByEsc: trailing escape"
892 isSep = even
894 isEsc x = x `mod` 6 == 0
896 prsr = P.takeEndByEsc isEsc isSep prsr0
898 where
900 prsr0 = P.many (P.satisfy (const True)) FL.toList
902 escapeSep maybePrevEsc [] =
903 case maybePrevEsc of
904 Nothing -> []
905 Just prevEsc -> [prevEsc]
906 escapeSep maybePrevEsc (x : xs) =
907 case maybePrevEsc of
908 Nothing ->
909 if isEsc x
910 then escapeSep (Just x) xs
911 else
912 if isSep x
913 then [x]
914 else x : escapeSep Nothing xs
915 Just _ ->
916 x : escapeSep Nothing xs
917 in
918 case runIdentity $ S.parse prsr (S.fromList ls) of
919 Right parsed_list -> checkListEqual parsed_list $ escapeSep Nothing ls
920 Left err -> property (displayException err == msg)
922takeFramedByEsc_ :: Property
923takeFramedByEsc_ =
924 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
925 let
926 isBegin = (== 0)
928 isEnd = (== 1)
930 isEsc = (== 2)
932 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
934 checkPass (x : xs) maybePrevEsc openMinusClose =
935 case maybePrevEsc of
936 Nothing ->
937 if isEsc x
938 then checkPass xs (Just x) openMinusClose
939 else
940 if isBegin x
941 then checkPass xs Nothing (openMinusClose + 1)
942 else
943 if isEnd x
944 then
945 case openMinusClose of
946 0 -> False
947 1 -> True
948 _ ->
949 checkPass
950 xs
951 Nothing
952 (openMinusClose - 1)
953 else
954 checkPass xs Nothing openMinusClose
955 Just _ -> checkPass xs Nothing openMinusClose
956 checkPass [] _ _ = False
958 checkPassBeg [] = False
959 checkPassBeg xxs@(x:_)
960 | isBegin x = checkPass xxs Nothing (0 :: Int)
961 | otherwise = False
963 escapeFrame begin end escape l =
964 let
965 helper (x : xs) maybePrevEsc openMinusClose =
966 case maybePrevEsc of
967 Nothing ->
968 if escape x
969 then helper xs (Just x) openMinusClose
970 else
971 if begin x
972 then helper xs Nothing (openMinusClose + 1)
973 else
974 if end x
975 then
976 if openMinusClose - 1 == 0
977 then []
978 else
979 helper
980 xs
981 Nothing
982 (openMinusClose - 1)
983 else
984 x : helper xs Nothing openMinusClose
985 Just prevEsc ->
986 if escape x || begin x || end x
987 then x : helper xs Nothing openMinusClose
988 else
989 prevEsc : x : helper xs Nothing openMinusClose
990 helper [] _ _ = error "Cannot Reach Here"
991 in
992 helper l Nothing (0 :: Int)
993 in
994 case runIdentity $ S.parse prsr (S.fromList ls) of
995 Right parsed_list ->
996 if checkPassBeg ls
997 then checkListEqual parsed_list $
998 escapeFrame isBegin isEnd isEsc ls
999 else property False
1000 Left _ ->
1001 if checkPassBeg ls
1002 then property False
1003 else property True
1005takeFramedByEsc_Pass :: Property
1006takeFramedByEsc_Pass =
1007 forAll (listOf (chooseInt (min_value, max_value))) $ \list ->
1008 let
1009 ls = (0 : list) ++ (Prelude.replicate (Prelude.length list + 1) 1)
1011 isBegin = (== 0)
1013 isEnd = (== 1)
1015 isEsc = (== 2)
1017 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1019 escapeFrame begin end escape l =
1020 let
1021 helper (x : xs) maybePrevEsc openMinusClose =
1022 case maybePrevEsc of
1023 Nothing ->
1024 if escape x
1025 then helper xs (Just x) openMinusClose
1026 else
1027 if begin x
1028 then
1029 if openMinusClose == 0
1030 then helper xs Nothing (openMinusClose + 1)
1031 else x : helper xs Nothing (openMinusClose + 1)
1032 else
1033 if end x
1034 then
1035 if openMinusClose - 1 == 0
1036 then []
1037 else
1038 x :
1039 helper
1040 xs
1041 Nothing
1042 (openMinusClose - 1)
1043 else
1044 x : helper xs Nothing openMinusClose
1045 Just _ ->
1046 x : helper xs Nothing openMinusClose
1047 helper [] _ _ = error "Cannot Reach Here"
1048 in
1049 helper l Nothing (0 :: Int)
1050 in
1051 case runIdentity $ S.parse prsr (S.fromList ls) of
1052 Right parsed_list -> checkListEqual parsed_list $ escapeFrame isBegin isEnd isEsc ls
1053 _ -> property False
1055takeFramedByEsc_Fail1 :: Property
1056takeFramedByEsc_Fail1 =
1057 let
1058 msg = "takeFramedByEsc_: missing frame end"
1060 isBegin = (== 0)
1062 isEnd = (== 0)
1064 isEsc = (== 2)
1066 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1068 ls = [0 :: Int]
1069 in
1070 case runIdentity $ S.parse prsr (S.fromList ls) of
1071 Right _ -> property False
1072 Left err -> property (displayException err == msg)
1074takeFramedByEsc_Fail2 :: Property
1075takeFramedByEsc_Fail2 =
1076 let
1077 msg = "takeFramedByEsc_: missing frame start"
1079 isBegin = (== 0)
1081 isEnd = (== 1)
1083 isEsc = (== 1)
1085 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1087 ls = [1 :: Int]
1088 in
1089 case runIdentity $ S.parse prsr (S.fromList ls) of
1090 Right _ -> property False
1091 Left err -> property (displayException err == msg)
1093takeFramedByEsc_Fail3 :: Property
1094takeFramedByEsc_Fail3 =
1095 let
1096 msg = "takeFramedByEsc_: missing frame end"
1098 isBegin = (== 2)
1100 isEnd = (== 1)
1102 isEsc = (== 2)
1104 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1106 ls = [2 :: Int]
1107 in
1108 case runIdentity $ S.parse prsr (S.fromList ls) of
1109 Right _ -> property False
1110 Left err -> property $ (displayException err == msg)
1112takeStartBy_ :: Property
1113takeStartBy_ =
1114 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
1115 let ls1 = 1:ls
1116 msg = "takeFramedByGeneric: empty token"
1117 in
1118 case runIdentity $ S.parse parser (S.fromList ls1) of
1119 Right parsed_list ->
1120 if not $ Prelude.null ls1
1121 then
1122 let tls = Prelude.takeWhile (not . predicate) (tail ls1)
1123 in checkListEqual parsed_list $
1124 if predicate (head ls1)
1125 then tls
1126 else Prelude.takeWhile (not . predicate) ls1
1127 else property $ Prelude.null parsed_list
1128 Left err -> property (displayException err == msg)
1129 where
1130 predicate = odd
1131 parser = P.takeStartBy_ predicate FL.toList
1132-------------------------------------------------------------------------------
1133-- Main
1134-------------------------------------------------------------------------------
1136moduleName :: String
1137moduleName = "Data.Parser"
1139main :: IO ()
1140main =
1141 hspec $
1142 H.parallel $
1143 modifyMaxSuccess (const maxTestCount) $ do
1144 describe moduleName $ do
1146 describe "Instances" $ do
1147 prop "applicative" applicative
1148 prop "monad" monad
1149 prop "sequence" sequence
1150 describe "Stream parsing" $ do
1151 prop "parseMany" parseMany
1152 prop "parseMany2Events" parseMany2Events
1154 describe "test for accumulator" $ do
1155 prop "P.fromFold FL.sum = FL.sum" fromFold
1156 prop "fromPure value provided" fromPure
1157 prop "fromPure monadic value provided" fromEffect
1158 prop "fail err = Left (SomeException (ParseError err))" parserFail
1159 prop "always fail" die
1160 prop "always fail but monadic" dieM
1162 describe "test for element parser" $ do
1163 prop "peek = head with list length > 0" peekPass
1164 prop "peek fail on []" peekFail
1165 prop "eof pass on []" eofPass
1166 prop "eof fail on non-empty list" eofFail
1167 prop "first element exists and >= mid_value" satisfyPass
1168 prop "one pass on [Int]" onePass
1169 prop "one fail on []" one
1170 prop "check first element exists and satisfies predicate" satisfy
1172 describe "test for sequence parser" $ do
1173 prop "P.takeBetween = Prelude.take when len >= m and len <= n"
1174 takeBetweenPass
1175 prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail"
1176 ++ "otherwise fail") Main.takeBetween
1178 prop "P.takeEQ = Prelude.take when len >= n" takeEQPass
1179 prop "P.takeEQ = Prelude.take when len >= n and fail otherwise"
1180 Main.takeEQ
1181 prop "P.takeGE n ls = ls when len >= n" takeGEPass
1182 prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE
1183 -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass
1184 -- prop "Fail when stream length exceeded" lookAheadFail
1185 -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
1186 prop "P.takeEndBy_ test" Main.takeEndBy_
1187 prop ("P.takeStartBy pred = head : Prelude.takeWhile (not . pred)"
1188 ++ " tail") takeStartBy
1189 prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
1190 prop ("P.takeWhile1 = Prelude.takeWhile if taken something,"
1191 ++ " else check why failed") takeWhile1
1192 prop "takeWhileP prd P.take = takeWhileMaxLen prd" takeWhileP
1193 prop ("P.takeP = Prelude.take") takeP
1194 prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy
1195 prop "many (P.wordBy ' ') = words'" wordBy
1196 parseManyWordQuotedBy
1197 -- prop "choice" choice
1198 -- prop "" splitWithPass
1199 -- prop "" splitWithFailLeft
1200 -- prop "" splitWithFailRight
1201 -- prop "" splitWithFailBoth
1202 -- prop "" teeWithPass
1203 -- prop "" teeWithFailLeft
1204 -- prop "" teeWithFailRight
1205 -- prop "" teeWithFailBoth
1206 -- prop "deintercalate" deintercalate
1207 -- prop "" shortestPass
1208 -- prop "" shortestFailLeft
1209 -- prop "" shortestFailRight
1210 -- prop "" shortestFailBoth
1211 prop ("P.many concatFold $ P.takeEndBy_ (== 1) FL.toList ="
1212 ++ "Prelude.filter (== 0)") many
1213 -- prop "[] due to parser being die" many_empty
1214 prop ("P.some concatFold $ P.takeEndBy_ (== 1) FL.toList ="
1215 ++ "Prelude.filter (== 0)") some
1216 -- prop "fail due to parser being die" someFail
1217 prop "P.many == S.parseMany" manyEqParseMany
1219 prop "takeEndBy_" takeEndBy_
1220 prop "takeEndBy1" takeEndBy1
1221 prop "takeEndBy2" takeEndBy2
1222 prop "takeEndByEsc" takeEndByEsc
1223 prop "takeFramedByEsc_" takeFramedByEsc_
1224 prop "takeFramedByEsc_Pass" takeFramedByEsc_Pass
1225 prop "takeFramedByEsc_Fail1" takeFramedByEsc_Fail1
1226 prop "takeFramedByEsc_Fail2" takeFramedByEsc_Fail2
1227 prop "takeFramedByEsc_Fail3" takeFramedByEsc_Fail3
1228 prop "takeStartBy_" takeStartBy_
1230 takeProperties