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