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