@@ -11,6 +11,7 @@ import Test.Hspec.QuickCheck
1111import Test.QuickCheck (forAll, choose, Property, property, listOf, vectorOf, counterexample, Gen)
1212
1313import Test.QuickCheck.Monadic (monadicIO, PropertyM, assert, monitor)
14+import Control.Exception (SomeException(..), displayException)
1415import Control.Monad.IO.Class (MonadIO(..))
1516import Control.Monad (when)
1617import Data.List ((\\))
@@ -75,7 +76,7 @@ all =
7576 Left _ -> False
7677
7778yield :: Property
78−yield =
79+yield =
7980 forAll (chooseInt (min_value, max_value)) $ \x ->
8081 case S.parse (P.yield x) (S.fromList [1 :: Int]) of
8182 Right r -> r == x
@@ -102,10 +103,19 @@ dieM =
102103 Right _ -> False
103104 Left _ -> True
104105
106+parserFail :: Property
107+parserFail =
108+ property $
109+ case S.parse (fail err) (S.fromList [0 :: Int]) of
110+ Right _ -> False
111+ Left (SomeException e) -> err == displayException e
112+ where
113+ err = "Testing MonadFail.fail."
114+
105115-- Element Parser Tests
106116
107117peekPass :: Property
108−peekPass =
118+peekPass =
109119 forAll (chooseInt (1, max_length)) $ \list_length ->
110120 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
111121 case S.parse P.peek (S.fromList ls) of
@@ -121,13 +131,13 @@ peekFail =
121131 Left _ -> True)
122132
123133eofPass :: Property
124−eofPass =
134+eofPass =
125135 property (case S.parse P.eof (S.fromList []) of
126136 Right _ -> True
127137 Left _ -> False)
128138
129139eofFail :: Property
130−eofFail =
140+eofFail =
131141 forAll (chooseInt (1, max_length)) $ \list_length ->
132142 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
133143 case S.parse P.eof (S.fromList ls) of
@@ -135,7 +145,7 @@ eofFail =
135145 Left _ -> True
136146
137147satisfyPass :: Property
138−satisfyPass =
148+satisfyPass =
139149 forAll (chooseInt (mid_value, max_value)) $ \first_element ->
140150 forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->
141151 let
@@ -147,7 +157,7 @@ satisfyPass =
147157 Left _ -> False
148158
149159satisfy :: Property
150−satisfy =
160+satisfy =
151161 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
152162 case S.parse (P.satisfy predicate) (S.fromList ls) of
153163 Right r -> case ls of
@@ -162,7 +172,7 @@ satisfy =
162172-- Sequence Parsers Tests
163173
164174take :: Property
165−take =
175+take =
166176 forAll (chooseInt (min_value, max_value)) $ \n ->
167177 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
168178 case S.parse (P.take n FL.toList) (S.fromList ls) of
@@ -170,7 +180,7 @@ take =
170180 Left _ -> property False
171181
172182takeEQPass :: Property
173−takeEQPass =
183+takeEQPass =
174184 forAll (chooseInt (min_value, max_value)) $ \n ->
175185 forAll (chooseInt (n, max_value)) $ \list_length ->
176186 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
@@ -182,11 +192,11 @@ takeEQ :: Property
182192takeEQ =
183193 forAll (chooseInt (min_value, max_value)) $ \n ->
184194 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
185− let
195+ let
186196 list_length = Prelude.length ls
187197 in
188198 case S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
189− Right parsed_list ->
199+ Right parsed_list ->
190200 if (n <= list_length) then
191201 checkListEqual parsed_list (Prelude.take n ls)
192202 else
@@ -194,7 +204,7 @@ takeEQ =
194204 Left _ -> property (n > list_length)
195205
196206takeGEPass :: Property
197−takeGEPass =
207+takeGEPass =
198208 forAll (chooseInt (min_value, max_value)) $ \n ->
199209 forAll (chooseInt (n, max_value)) $ \list_length ->
200210 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
@@ -206,11 +216,11 @@ takeGE :: Property
206216takeGE =
207217 forAll (chooseInt (min_value, max_value)) $ \n ->
208218 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
209− let
219+ let
210220 list_length = Prelude.length ls
211221 in
212222 case S.parse (P.takeGE n FL.toList) (S.fromList ls) of
213− Right parsed_list ->
223+ Right parsed_list ->
214224 if (n <= list_length) then
215225 checkListEqual parsed_list ls
216226 else
@@ -219,7 +229,7 @@ takeGE =
219229
220230-- lookAheadPass :: Property
221231-- lookAheadPass =
222−-- forAll (chooseInt (min_value + 1, max_value)) $ \n ->
232+-- forAll (chooseInt (min_value + 1, max_value)) $ \n ->
223233-- let
224234-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
225235-- parseTwice = do
@@ -235,7 +245,7 @@ takeGE =
235245
236246-- lookAheadFail :: Property
237247-- lookAheadFail =
238−-- forAll (chooseInt (min_value + 1, max_value)) $ \n ->
248+-- forAll (chooseInt (min_value + 1, max_value)) $ \n ->
239249-- let
240250-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
241251-- parseTwice = do
@@ -251,7 +261,7 @@ takeGE =
251261
252262-- lookAhead :: Property
253263-- lookAhead =
254−-- forAll (chooseInt (min_value, max_value)) $ \n ->
264+-- forAll (chooseInt (min_value, max_value)) $ \n ->
255265-- let
256266-- takeWithoutConsume = P.lookAhead $ P.take n FL.toList
257267-- parseTwice = do
@@ -281,7 +291,7 @@ takeWhile1 =
281291 case S.parse (P.takeWhile1 predicate FL.toList) (S.fromList ls) of
282292 Right parsed_list -> case ls of
283293 [] -> property False
284− (x : _) ->
294+ (x : _) ->
285295 if predicate x then
286296 checkListEqual parsed_list (Prelude.takeWhile predicate ls)
287297 else
@@ -291,7 +301,7 @@ takeWhile1 =
291301 (x : _) -> property (not $ predicate x)
292302 where
293303 predicate = (== 0)
294−
304+
295305sliceSepBy :: Property
296306sliceSepBy =
297307 forAll (listOf (chooseInt (0, 1))) $ \ls ->
@@ -302,7 +312,7 @@ sliceSepBy =
302312 predicate = (== 1)
303313
304314-- sliceSepByMax :: Property
305−-- sliceSepByMax =
315+-- sliceSepByMax =
306316-- forAll (chooseInt (min_value, max_value)) $ \n ->
307317-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
308318-- case S.parse (P.sliceSepByMax predicate n FL.toList) (S.fromList ls) of
@@ -341,7 +351,7 @@ sliceSepBy =
341351-- Left _ -> True)
342352
343353-- teeWithPass :: Property
344−-- teeWithPass =
354+-- teeWithPass =
345355-- forAll (chooseInt (0, 10000)) $ \n ->
346356-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
347357-- let
@@ -352,25 +362,25 @@ sliceSepBy =
352362-- Left _ -> property False
353363
354364-- teeWithFailLeft :: Property
355−-- teeWithFailLeft =
365+-- teeWithFailLeft =
356366-- property (case S.parse (P.teeWith (,) (P.die "die") (P.yield (1 :: Int))) (S.fromList [1 :: Int]) of
357367-- Right _ -> False
358368-- Left _ -> True)
359369
360370-- teeWithFailRight :: Property
361−-- teeWithFailRight =
371+-- teeWithFailRight =
362372-- property (case S.parse (P.teeWith (,) (P.yield (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
363373-- Right _ -> False
364374-- Left _ -> True)
365375
366376-- teeWithFailBoth :: Property
367−-- teeWithFailBoth =
377+-- teeWithFailBoth =
368378-- property (case S.parse (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
369379-- Right _ -> False
370380-- Left _ -> True)
371381
372382-- deintercalate :: Property
373−-- deintercalate =
383+-- deintercalate =
374384-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
375385-- case S.parse (P.deintercalate concatFold prsr_1 concatFold prsr_2) (S.fromList ls) of
376386-- Right parsed_list_tuple -> parsed_list_tuple == (partition (== 0) ls)
@@ -419,9 +429,10 @@ main = hspec $ do
419429 prop "P.all = Prelude.all" Main.all
420430 prop "yield value provided" yield
421431 prop "yield monadic value provided" yieldM
432+ prop "fail err = Left (SomeException (ParseError err))" parserFail
422433 prop "always fail" die
423434 prop "always fail but monadic" dieM
424−
435+
425436 describe "test for element parser" $ do
426437 prop "peek = head with list length > 0" peekPass
427438 prop "peek fail on []" peekFail
@@ -455,4 +466,4 @@ main = hspec $ do
455466 -- prop "pass test for shortest function" shortestPass
456467 -- prop "left fail test for shortest function" shortestFailLeft
457468 -- prop "right fail test for shortest function" shortestFailRight
458− -- prop "both fail test for shortest function" shortestFailBoth
469+ -- prop "both fail test for shortest function" shortestFailBoth