git.iko.soy/streamly
on 95ebe09 help sign in
streamly/test/Streamly/Test/Data/Parser.hs
1239 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.ParserD (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, lQ, rQ, fromLQ, input, expected) -> do
488 let inpStrm = S.fromList input
490 esc '\\' = True
491 esc _ = False
493 spc ' ' = True
494 spc _ = False
496 parser = P.wordQuotedBy kQ esc lQ rQ fromLQ spc FL.toList
497 result <- H.runIO $ S.fold FL.toList $ S.catRights $ S.parseMany parser inpStrm
498 H.it (showCase c) $ result `H.shouldBe` expected
500 where
502 showCase (kQ, _, _, _, input, expected) =
503 show kQ ++ ", " ++ input ++ " -> " ++ show expected
505 testCases =
506 [ ( True
507 , (== '\'')
508 , (== '\'')
509 , id
510 , "The quick brown fox"
511 , ["The", "quick", "brown", "fox"])
512 , ( True
513 , (== '\'')
514 , (== '\'')
515 , id
516 , "The' quick brown' fox"
517 , ["The' quick brown'", "fox"])
518 , ( False
519 , (== '\'')
520 , (== '\'')
521 , id
522 , "The' quick brown' fox"
523 , ["The quick brown", "fox"])
524 , ( True
525 , (== '[')
526 , (== '[')
527 , \x -> if x == '[' then ']' else error "Not an opening quote."
528 , "The[ quick brown] fox"
529 , ["The[ quick brown]", "fox"])
530 , ( True
531 , (== '[')
532 , (== '[')
533 , \x -> if x == '[' then ']' else error "Not an opening quote."
534 , "The[ qui[ck] brown] \\ f[ ox]"
535 , ["The[ qui[ck] brown]", " f[ ox]"])
536 , ( False
537 , (== '[')
538 , (== '[')
539 , \x -> if x == '[' then ']' else error "Not an opening quote."
540 , "The[ qui[ck] brown] fox"
541 , ["The qui[ck] brown", "fox"])
542 ]
545-- splitWithPass :: Property
546-- splitWithPass =
547-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
548-- case S.parse (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of
549-- Right (result_first, result_second) -> case ls of
550-- 0 : 1 : _ -> (result_first == 0) && (result_second == 1)
551-- _ -> False
552-- Left _ -> case ls of
553-- 0 : 1 : _ -> False
554-- _ -> True
556-- splitWithFailLeft :: Property
557-- splitWithFailLeft =
558-- property (case S.parse (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
559-- Right _ -> False
560-- Left _ -> True)
562-- splitWithFailRight :: Property
563-- splitWithFailRight =
564-- property (case S.parse (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
565-- Right _ -> False
566-- Left _ -> True)
568-- splitWithFailBoth :: Property
569-- splitWithFailBoth =
570-- property (case S.parse (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
571-- Right _ -> False
572-- Left _ -> True)
574-- teeWithPass :: Property
575-- teeWithPass =
576-- forAll (chooseInt (0, 10000)) $ \n ->
577-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
578-- let
579-- prsr = P.take n FL.toList
580-- in
581-- case S.parse (P.teeWith (,) prsr prsr) (S.fromList ls) of
582-- Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
583-- Left _ -> property False
585-- teeWithFailLeft :: Property
586-- teeWithFailLeft =
587-- property (case S.parse (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
588-- Right _ -> False
589-- Left _ -> True)
591-- teeWithFailRight :: Property
592-- teeWithFailRight =
593-- property (case S.parse (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
594-- Right _ -> False
595-- Left _ -> True)
597-- teeWithFailBoth :: Property
598-- teeWithFailBoth =
599-- property (case S.parse (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
600-- Right _ -> False
601-- Left _ -> True)
603deintercalate :: Property
604deintercalate =
605 forAll (listOf (chooseAny :: Gen Int)) $ \ls ->
606 case runIdentity $ S.parse p (S.fromList ls) of
607 Right evenOdd -> evenOdd == List.partition even ls
608 Left _ -> False
610 where
611 p1 = P.takeWhile even FL.toList
612 p2 = P.takeWhile odd FL.toList
613 partition =
614 FL.tee (fmap concat $ FL.catLefts FL.toList)
615 (fmap concat $ FL.catRights FL.toList)
616 p = P.deintercalate p1 p2 partition
618-- shortestPass :: Property
619-- shortestPass =
620-- forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->
621-- let
622-- prsr_1 = P.takeWhile (<= (mid_value `Prelude.div` 2)) FL.toList
623-- prsr_2 = P.takeWhile (<= mid_value) FL.toList
624-- prsr_shortest = P.shortest prsr_1 prsr_2
625-- in
626-- case S.parse prsr_shortest (S.fromList ls) of
627-- Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= 2500) ls)
628-- Left _ -> property False
630-- shortestFailLeft :: Property
631-- shortestFailLeft =
632-- property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
633-- Right r -> r == 1
634-- Left _ -> False)
636-- shortestFailRight :: Property
637-- shortestFailRight =
638-- property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
639-- Right r -> r == 1
640-- Left _ -> False)
642-- shortestFailBoth :: Property
643-- shortestFailBoth =
644-- property (case S.parse (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
645-- Right _ -> False
646-- Left _ -> True)
648many :: Property
649many =
650 forAll (listOf (chooseInt (0, 1))) $ \ls ->
651 let fldstp conL currL = return $ FL.Partial $ conL ++ currL
652 concatFold = FL.Fold fldstp (return (FL.Partial [])) return
653 prsr =
654 flip P.many concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
655 in
656 case runIdentity $ S.parse prsr (S.fromList ls) of
657 Right res_list -> checkListEqual res_list
658 $ Prelude.filter (== 0) ls
659 Left _ -> property False
661-- many_empty :: Property
662-- many_empty =
663-- property (case S.parse (P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
664-- Right res_list -> checkListEqual res_list ([] :: [Int])
665-- Left _ -> property False)
667some :: Property
668some =
669 forAll (listOf (chooseInt (0, 1))) $ \genLs ->
670 let
671 ls = 0 : genLs
672 fldstp conL currL = return $ FL.Partial $ conL ++ currL
673 concatFold = FL.Fold fldstp (return (FL.Partial [])) return
674 prsr =
675 flip P.some concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
676 in
677 case runIdentity $ S.parse prsr (S.fromList ls) of
678 Right res_list -> res_list == Prelude.filter (== 0) ls
679 Left _ -> False
681-- someFail :: Property
682-- someFail =
683-- property (case S.parse (P.some FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
684-- Right _ -> False
685-- Left _ -> True)
687-------------------------------------------------------------------------------
688-- Instances
689-------------------------------------------------------------------------------
691applicative :: Property
692applicative =
693 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
694 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
695 let parser =
696 (,)
697 <$> P.fromFold (FL.take (length list1) FL.toList)
698 <*> P.fromFold (FL.take (length list2) FL.toList)
699 in monadicIO $ do
700 s <- S.parse parser (S.fromList $ list1 ++ list2)
701 return $
702 case s of
703 Right (olist1, olist2) -> olist1 == list1 && olist2 == list2
704 Left _ -> False
706sequence :: Property
707sequence =
708 forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->
709 let p xs = P.fromFold (FL.take (length xs) FL.toList)
710 in monadicIO $ do
711 outs <- run $
712 S.parse
713 (Prelude.sequence $ fmap p ins)
714 (S.fromList $ concat ins)
715 return $
716 case outs of
717 Right ls -> ls == ins
718 Left _ -> False
720monad :: Property
721monad =
722 forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
723 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
724 let parser = do
725 olist1 <- P.fromFold (FL.take (length list1) FL.toList)
726 olist2 <- P.fromFold (FL.take (length list2) FL.toList)
727 return (olist1, olist2)
728 in monadicIO $ do
729 s <- S.parse parser (S.fromList $ list1 ++ list2)
730 return $
731 case s of
732 Right (olist1, olist2) -> olist1 == list1 && olist2 == list2
733 Left _ -> False
735-------------------------------------------------------------------------------
736-- Stream parsing
737-------------------------------------------------------------------------------
739parseMany :: Property
740parseMany =
741 forAll (chooseInt (1,100)) $ \len ->
742 forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
743 monadicIO $ do
744 outs <- do
745 let p = P.fromFold $ FL.take len FL.toList
746 run
747 $ S.fold FL.toList
748 $ S.catRights
749 $ S.parseMany p (S.fromList $ concat ins)
750 listEquals (==) outs ins
752-------------------------------------------------------------------------------
753-- Test for a particular case hit during fs events testing
754-------------------------------------------------------------------------------
756evId :: [Word8]
757evId = [96,238,17,9,0,0,0,0]
759evFlags :: [Word8]
760evFlags = [0,4,1,0,0,0,0,0]
762evPathLen :: [Word8]
763evPathLen = [71,0,0,0,0,0,0,0]
765evPath :: [Word8]
766evPath =
767 [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109
768 ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112
769 ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116
770 ,114,101,97,109,108,121,47,116,109,112,47,122,122
771 ]
773event :: [Word8]
774event = evId ++ evFlags ++ evPathLen ++ evPath
776data Event = Event
777 { eventId :: Word64
778 , eventFlags :: Word32
779 , eventAbsPath :: A.Array Word8
780 } deriving (Show, Ord, Eq)
782readOneEvent :: P.Parser Word8 IO Event
783readOneEvent = do
784 arr <- P.takeEQ 24 (A.writeN 24)
785 let arr1 = A.castUnsafe arr :: A.Array Word64
786 eid = A.unsafeIndex 0 arr1
787 eflags = A.unsafeIndex 1 arr1
788 pathLen = fromIntegral $ A.unsafeIndex 2 arr1
789 -- XXX handle if pathLen is 0
790 path <- P.takeEQ pathLen (A.writeN pathLen)
791 return $ Event
792 { eventId = eid
793 , eventFlags = fromIntegral eflags
794 , eventAbsPath = path
795 }
797parseMany2Events :: Property
798parseMany2Events =
799 monadicIO $ do
800 xs <-
801 ( run
802 $ S.fold FL.toList
803 $ S.catRights
804 $ S.parseMany readOneEvent
805 $ S.fromList (concat (replicate 2 event))
806 )
807 assert (length xs == 2)
808 -- XXX assuming little endian machine
809 let ev = Event
810 { eventId = 152170080
811 , eventFlags = 66560
812 , eventAbsPath = A.fromList evPath
813 }
814 in listEquals (==) xs (replicate 2 ev)
816manyEqParseMany :: Property
817manyEqParseMany =
818 forAll (listOf (chooseInt (0, 100))) $ \lst ->
819 forAll (chooseInt (1, 100)) $ \i ->
820 monadicIO $ do
821 let strm = S.fromList lst
822 r1 <- run $ S.parse (P.many (split i) FL.toList) strm
823 r2 <- run $ S.fold FL.toList $ S.catRights $ S.parseMany (split i) strm
824 return $
825 case r1 of
826 Right o1 -> o1 == r2
827 Left _ -> False
829 where
831 split i = P.fromFold (FL.take i FL.toList)
834takeEndBy1 :: Property
835takeEndBy1 =
836 forAll (listOf (chooseInt (0, 1))) $ \ls ->
837 case runIdentity $ S.parse (P.takeEndBy predicate prsr) (S.fromList ls) of
838 Right parsed_list ->
839 checkListEqual
840 parsed_list
841 (takeWhileAndFirstFail (not . predicate) ls)
842 Left _ -> property False
843 where
844 prsr = P.many (P.satisfy (const True)) FL.toList
846 predicate = (== 1)
848 takeWhileAndFirstFail prd (x : xs) =
849 if prd x
850 then x : takeWhileAndFirstFail prd xs
851 else [x]
852 takeWhileAndFirstFail _ [] = []
854splitWithSuffix
855 :: Monad m
856 => (a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b
857splitWithSuffix predicate f = S.foldMany (FL.takeEndBy predicate f)
859takeEndBy2 :: Property
860takeEndBy2 =
861 forAll (listOf (chooseInt (0, 1))) $ \ls ->
862 let
863 strm = S.fromList ls
865 predicate = (==0)
867 eitherParsedList =
868 S.fold FL.toList
869 $ S.catRights
870 $ S.parseMany (P.takeEndBy predicate prsr) strm
872 where
874 prsr = P.many (P.satisfy (const True)) FL.toList
876 eitherSplitList =
877 case ls of
878 [] -> return []
879 _ ->
880 if last ls == 0
881 then S.fold FL.toList $ S.append strm1 (S.fromList [])
882 else S.fold FL.toList strm1
884 where
886 strm1 = splitWithSuffix predicate FL.toList strm
887 in
888 case eitherParsedList of
889 Left _ -> property False
890 Right parsedList ->
891 case eitherSplitList of
892 Left _ -> property False
893 Right splitList -> checkListEqual parsedList splitList
895takeEndByEsc :: Property
896takeEndByEsc =
897 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
898 let
899 msg = "takeEndByEsc: trailing escape"
901 isSep = even
903 isEsc x = x `mod` 6 == 0
905 prsr = P.takeEndByEsc isEsc isSep prsr0
907 where
909 prsr0 = P.many (P.satisfy (const True)) FL.toList
911 escapeSep maybePrevEsc [] =
912 case maybePrevEsc of
913 Nothing -> []
914 Just prevEsc -> [prevEsc]
915 escapeSep maybePrevEsc (x : xs) =
916 case maybePrevEsc of
917 Nothing ->
918 if isEsc x
919 then escapeSep (Just x) xs
920 else
921 if isSep x
922 then [x]
923 else x : escapeSep Nothing xs
924 Just _ ->
925 x : escapeSep Nothing xs
926 in
927 case runIdentity $ S.parse prsr (S.fromList ls) of
928 Right parsed_list -> checkListEqual parsed_list $ escapeSep Nothing ls
929 Left err -> property (displayException err == msg)
931takeFramedByEsc_ :: Property
932takeFramedByEsc_ =
933 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
934 let
935 isBegin = (== 0)
937 isEnd = (== 1)
939 isEsc = (== 2)
941 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
943 checkPass (x : xs) maybePrevEsc openMinusClose =
944 case maybePrevEsc of
945 Nothing ->
946 if isEsc x
947 then checkPass xs (Just x) openMinusClose
948 else
949 if isBegin x
950 then checkPass xs Nothing (openMinusClose + 1)
951 else
952 if isEnd x
953 then
954 case openMinusClose of
955 0 -> False
956 1 -> True
957 _ ->
958 checkPass
959 xs
960 Nothing
961 (openMinusClose - 1)
962 else
963 checkPass xs Nothing openMinusClose
964 Just _ -> checkPass xs Nothing openMinusClose
965 checkPass [] _ _ = False
967 checkPassBeg [] = False
968 checkPassBeg xxs@(x:_)
969 | isBegin x = checkPass xxs Nothing (0 :: Int)
970 | otherwise = False
972 escapeFrame begin end escape l =
973 let
974 helper (x : xs) maybePrevEsc openMinusClose =
975 case maybePrevEsc of
976 Nothing ->
977 if escape x
978 then helper xs (Just x) openMinusClose
979 else
980 if begin x
981 then helper xs Nothing (openMinusClose + 1)
982 else
983 if end x
984 then
985 if openMinusClose - 1 == 0
986 then []
987 else
988 helper
989 xs
990 Nothing
991 (openMinusClose - 1)
992 else
993 x : helper xs Nothing openMinusClose
994 Just prevEsc ->
995 if escape x || begin x || end x
996 then x : helper xs Nothing openMinusClose
997 else
998 prevEsc : x : helper xs Nothing openMinusClose
999 helper [] _ _ = error "Cannot Reach Here"
1000 in
1001 helper l Nothing (0 :: Int)
1002 in
1003 case runIdentity $ S.parse prsr (S.fromList ls) of
1004 Right parsed_list ->
1005 if checkPassBeg ls
1006 then checkListEqual parsed_list $
1007 escapeFrame isBegin isEnd isEsc ls
1008 else property False
1009 Left _ ->
1010 if checkPassBeg ls
1011 then property False
1012 else property True
1014takeFramedByEsc_Pass :: Property
1015takeFramedByEsc_Pass =
1016 forAll (listOf (chooseInt (min_value, max_value))) $ \list ->
1017 let
1018 ls = (0 : list) ++ (Prelude.replicate (Prelude.length list + 1) 1)
1020 isBegin = (== 0)
1022 isEnd = (== 1)
1024 isEsc = (== 2)
1026 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1028 escapeFrame begin end escape l =
1029 let
1030 helper (x : xs) maybePrevEsc openMinusClose =
1031 case maybePrevEsc of
1032 Nothing ->
1033 if escape x
1034 then helper xs (Just x) openMinusClose
1035 else
1036 if begin x
1037 then
1038 if openMinusClose == 0
1039 then helper xs Nothing (openMinusClose + 1)
1040 else x : helper xs Nothing (openMinusClose + 1)
1041 else
1042 if end x
1043 then
1044 if openMinusClose - 1 == 0
1045 then []
1046 else
1047 x :
1048 helper
1049 xs
1050 Nothing
1051 (openMinusClose - 1)
1052 else
1053 x : helper xs Nothing openMinusClose
1054 Just _ ->
1055 x : helper xs Nothing openMinusClose
1056 helper [] _ _ = error "Cannot Reach Here"
1057 in
1058 helper l Nothing (0 :: Int)
1059 in
1060 case runIdentity $ S.parse prsr (S.fromList ls) of
1061 Right parsed_list -> checkListEqual parsed_list $ escapeFrame isBegin isEnd isEsc ls
1062 _ -> property False
1064takeFramedByEsc_Fail1 :: Property
1065takeFramedByEsc_Fail1 =
1066 let
1067 msg = "takeFramedByEsc_: missing frame end"
1069 isBegin = (== 0)
1071 isEnd = (== 0)
1073 isEsc = (== 2)
1075 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1077 ls = [0 :: Int]
1078 in
1079 case runIdentity $ S.parse prsr (S.fromList ls) of
1080 Right _ -> property False
1081 Left err -> property (displayException err == msg)
1083takeFramedByEsc_Fail2 :: Property
1084takeFramedByEsc_Fail2 =
1085 let
1086 msg = "takeFramedByEsc_: missing frame start"
1088 isBegin = (== 0)
1090 isEnd = (== 1)
1092 isEsc = (== 1)
1094 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1096 ls = [1 :: Int]
1097 in
1098 case runIdentity $ S.parse prsr (S.fromList ls) of
1099 Right _ -> property False
1100 Left err -> property (displayException err == msg)
1102takeFramedByEsc_Fail3 :: Property
1103takeFramedByEsc_Fail3 =
1104 let
1105 msg = "takeFramedByEsc_: missing frame end"
1107 isBegin = (== 2)
1109 isEnd = (== 1)
1111 isEsc = (== 2)
1113 prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList
1115 ls = [2 :: Int]
1116 in
1117 case runIdentity $ S.parse prsr (S.fromList ls) of
1118 Right _ -> property False
1119 Left err -> property $ (displayException err == msg)
1121takeStartBy_ :: Property
1122takeStartBy_ =
1123 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
1124 let ls1 = 1:ls
1125 msg = "takeFramedByGeneric: empty token"
1126 in
1127 case runIdentity $ S.parse parser (S.fromList ls1) of
1128 Right parsed_list ->
1129 if not $ Prelude.null ls1
1130 then
1131 let tls = Prelude.takeWhile (not . predicate) (tail ls1)
1132 in checkListEqual parsed_list $
1133 if predicate (head ls1)
1134 then tls
1135 else Prelude.takeWhile (not . predicate) ls1
1136 else property $ Prelude.null parsed_list
1137 Left err -> property (displayException err == msg)
1138 where
1139 predicate = odd
1140 parser = P.takeStartBy_ predicate FL.toList
1141-------------------------------------------------------------------------------
1142-- Main
1143-------------------------------------------------------------------------------
1145moduleName :: String
1146moduleName = "Data.Parser"
1148main :: IO ()
1149main =
1150 hspec $
1151 H.parallel $
1152 modifyMaxSuccess (const maxTestCount) $ do
1153 describe moduleName $ do
1155 describe "Instances" $ do
1156 prop "applicative" applicative
1157 prop "monad" monad
1158 prop "sequence" sequence
1159 describe "Stream parsing" $ do
1160 prop "parseMany" parseMany
1161 prop "parseMany2Events" parseMany2Events
1163 describe "test for accumulator" $ do
1164 prop "P.fromFold FL.sum = FL.sum" fromFold
1165 prop "fromPure value provided" fromPure
1166 prop "fromPure monadic value provided" fromEffect
1167 prop "fail err = Left (SomeException (ParseError err))" parserFail
1168 prop "always fail" die
1169 prop "always fail but monadic" dieM
1171 describe "test for element parser" $ do
1172 prop "peek = head with list length > 0" peekPass
1173 prop "peek fail on []" peekFail
1174 prop "eof pass on []" eofPass
1175 prop "eof fail on non-empty list" eofFail
1176 prop "first element exists and >= mid_value" satisfyPass
1177 prop "one pass on [Int]" onePass
1178 prop "one fail on []" one
1179 prop "check first element exists and satisfies predicate" satisfy
1181 describe "test for sequence parser" $ do
1182 prop "P.takeBetween = Prelude.take when len >= m and len <= n"
1183 takeBetweenPass
1184 prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail"
1185 ++ "otherwise fail") Main.takeBetween
1187 prop "P.takeEQ = Prelude.take when len >= n" takeEQPass
1188 prop "P.takeEQ = Prelude.take when len >= n and fail otherwise"
1189 Main.takeEQ
1190 prop "P.takeGE n ls = ls when len >= n" takeGEPass
1191 prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE
1192 -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass
1193 -- prop "Fail when stream length exceeded" lookAheadFail
1194 -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
1195 prop "P.takeEndBy_ test" Main.takeEndBy_
1196 prop ("P.takeStartBy pred = head : Prelude.takeWhile (not . pred)"
1197 ++ " tail") takeStartBy
1198 prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
1199 prop ("P.takeWhile1 = Prelude.takeWhile if taken something,"
1200 ++ " else check why failed") takeWhile1
1201 prop "takeWhileP prd P.take = takeWhileMaxLen prd" takeWhileP
1202 prop ("P.takeP = Prelude.take") takeP
1203 prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy
1204 prop "many (P.wordBy ' ') = words'" wordBy
1205 parseManyWordQuotedBy
1206 -- prop "choice" choice
1207 -- prop "" splitWithPass
1208 -- prop "" splitWithFailLeft
1209 -- prop "" splitWithFailRight
1210 -- prop "" splitWithFailBoth
1211 -- prop "" teeWithPass
1212 -- prop "" teeWithFailLeft
1213 -- prop "" teeWithFailRight
1214 -- prop "" teeWithFailBoth
1215 prop "deintercalate" deintercalate
1216 -- prop "" shortestPass
1217 -- prop "" shortestFailLeft
1218 -- prop "" shortestFailRight
1219 -- prop "" shortestFailBoth
1220 prop ("P.many concatFold $ P.takeEndBy_ (== 1) FL.toList ="
1221 ++ "Prelude.filter (== 0)") many
1222 -- prop "[] due to parser being die" many_empty
1223 prop ("P.some concatFold $ P.takeEndBy_ (== 1) FL.toList ="
1224 ++ "Prelude.filter (== 0)") some
1225 -- prop "fail due to parser being die" someFail
1226 prop "P.many == S.parseMany" manyEqParseMany
1228 prop "takeEndBy_" takeEndBy_
1229 prop "takeEndBy1" takeEndBy1
1230 prop "takeEndBy2" takeEndBy2
1231 prop "takeEndByEsc" takeEndByEsc
1232 prop "takeFramedByEsc_" takeFramedByEsc_
1233 prop "takeFramedByEsc_Pass" takeFramedByEsc_Pass
1234 prop "takeFramedByEsc_Fail1" takeFramedByEsc_Fail1
1235 prop "takeFramedByEsc_Fail2" takeFramedByEsc_Fail2
1236 prop "takeFramedByEsc_Fail3" takeFramedByEsc_Fail3
1237 prop "takeStartBy_" takeStartBy_
1239 takeProperties