Skip to content

Commit 576874b

Browse files
matthewleonmatthewleon
committed
Arbitrary-less law checks
addresses #35
1 parent 43cefe0 commit 576874b

28 files changed

+481
-236
lines changed

‎src/Test/QuickCheck/Laws/Control/Alt.purs‎

Lines changed: 18 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -3,13 +3,12 @@ module Test.QuickCheck.Laws.Control.Alt where
33
import Prelude
44

55
import Control.Alt (class Alt, (<|>))
6+
import Control.Apply (lift2, lift3)
67
import Control.Monad.Eff.Console (log)
7-
8-
import Type.Proxy (Proxy2)
9-
10-
import Test.QuickCheck (QC, quickCheck')
11-
import Test.QuickCheck.Arbitrary (class Arbitrary)
8+
import Test.QuickCheck (class Arbitrary, QC, arbitrary, quickCheck')
9+
import Test.QuickCheck.Gen (Gen)
1210
import Test.QuickCheck.Laws (A, B)
11+
import Type.Proxy (Proxy2)
1312

1413
-- | - Associativity: `(x <|> y) <|> z == x <|> (y <|> z)`
1514
-- | - Distributivity: `f <$> (x <|> y) == (f <$> x) <|> (f <$> y)`
@@ -21,18 +20,27 @@ checkAlt
2120
⇒ Eq (f B)
2221
⇒ Proxy2 f
2322
→ QC eff Unit
24-
checkAlt _ = do
23+
checkAlt _ = checkAltGen (arbitrary :: Gen (f A))
24+
25+
checkAltGen
26+
∷ ∀ eff f
27+
. Alt f
28+
⇒ Eq (f A)
29+
⇒ Eq (f B)
30+
⇒ Gen (f A)
31+
→ QC eff Unit
32+
checkAltGen gen = do
2533

2634
log "Checking 'Associativity' law for Alt"
27-
quickCheck' 1000 associativity
35+
quickCheck' 1000 $ lift3 associativity gen gen gen
2836

2937
log "Checking 'Distributivity' law for Alt"
30-
quickCheck' 1000 distributivity
38+
quickCheck' 1000 $ lift2 distributivity gen gen
3139

3240
where
3341

3442
associativity ∷ f A → f A → f A → Boolean
3543
associativity x y z = ((x <|> y) <|> z) == (x <|> (y <|> z))
3644

37-
distributivity ∷ (A → B) → f A → f A → Boolean
38-
distributivity f x y = (f <$> (x <|> y)) == ((f <$> x) <|> (f <$> y))
45+
distributivity ∷ f A → f A → (A → B) → Boolean
46+
distributivity x y f = (f <$> (x <|> y)) == ((f <$> x) <|> (f <$> y))

‎src/Test/QuickCheck/Laws/Control/Alternative.purs‎

Lines changed: 18 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -4,14 +4,13 @@ import Prelude
44

55
import Control.Alt ((<|>))
66
import Control.Alternative (class Alternative)
7+
import Control.Apply (lift3)
78
import Control.Monad.Eff.Console (log)
89
import Control.Plus (empty)
9-
10-
import Type.Proxy (Proxy2)
11-
12-
import Test.QuickCheck (QC, quickCheck')
13-
import Test.QuickCheck.Arbitrary (class Arbitrary)
10+
import Test.QuickCheck (class Arbitrary, QC, arbitrary, quickCheck')
11+
import Test.QuickCheck.Gen (Gen)
1412
import Test.QuickCheck.Laws (A, B)
13+
import Type.Proxy (Proxy2)
1514

1615
-- | - Distributivity: `(f <|> g) <*> x == (f <*> x) <|> (g <*> x)`
1716
-- | - Annihilation: `empty <*> x = empty`
@@ -24,13 +23,24 @@ checkAlternative
2423
⇒ Eq (f B)
2524
⇒ Proxy2 f
2625
→ QC eff Unit
27-
checkAlternative _ = do
26+
checkAlternative _ =
27+
checkAlternativeGen (arbitrary :: Gen (f A)) (arbitrary :: Gen (f (A → B)))
28+
29+
checkAlternativeGen
30+
∷ ∀ eff f
31+
. Alternative f
32+
⇒ Eq (f A)
33+
⇒ Eq (f B)
34+
⇒ Gen (f A)
35+
→ Gen (f (A → B))
36+
→ QC eff Unit
37+
checkAlternativeGen gen genf = do
2838

2939
log "Checking 'Left identity' law for Alternative"
30-
quickCheck' 1000 distributivity
40+
quickCheck' 1000 $ lift3 distributivity genf genf gen
3141

3242
log "Checking 'Annihilation' law for Alternative"
33-
quickCheck' 1000 annihilation
43+
quickCheck' 1000 $ annihilation <$> gen
3444

3545
where
3646

‎src/Test/QuickCheck/Laws/Control/Applicative.purs‎

Lines changed: 24 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -2,13 +2,12 @@ module Test.QuickCheck.Laws.Control.Applicative where
22

33
import Prelude
44

5+
import Control.Apply (lift3)
56
import Control.Monad.Eff.Console (log)
6-
7-
import Type.Proxy (Proxy2)
8-
9-
import Test.QuickCheck (QC, quickCheck')
10-
import Test.QuickCheck.Arbitrary (class Arbitrary)
7+
import Test.QuickCheck (class Arbitrary, QC, arbitrary, quickCheck')
8+
import Test.QuickCheck.Gen (Gen)
119
import Test.QuickCheck.Laws (A, B, C)
10+
import Type.Proxy (Proxy2)
1211

1312
-- | - Identity: `(pure id) <*> v = v`
1413
-- | - Composition: `(pure (<<<)) <*> f <*> g <*> h = f <*> (g <*> h)`
@@ -25,19 +24,35 @@ checkApplicative
2524
⇒ Eq (f C)
2625
⇒ Proxy2 f
2726
→ QC eff Unit
28-
checkApplicative _ = do
27+
checkApplicative _ =
28+
checkApplicativeGen
29+
(arbitrary :: Gen (f A))
30+
(arbitrary :: Gen (f (A → B)))
31+
(arbitrary :: Gen (f (B → C)))
32+
33+
checkApplicativeGen
34+
∷ ∀ eff f
35+
. Applicative f
36+
⇒ Eq (f A)
37+
⇒ Eq (f B)
38+
⇒ Eq (f C)
39+
⇒ Gen (f A)
40+
→ Gen (f (A → B))
41+
→ Gen (f (B → C))
42+
→ QC eff Unit
43+
checkApplicativeGen gen genab genbc = do
2944

3045
log "Checking 'Identity' law for Applicative"
31-
quickCheck' 1000 identity
46+
quickCheck' 1000 $ identity <$> gen
3247

3348
log "Checking 'Composition' law for Applicative"
34-
quickCheck' 1000 composition
49+
quickCheck' 1000 $ lift3 composition genbc genab gen
3550

3651
log "Checking 'Homomorphism' law for Applicative"
3752
quickCheck' 1000 homomorphism
3853

3954
log "Checking 'Interchange' law for Applicative"
40-
quickCheck' 1000 interchange
55+
quickCheck' 1000 $ flip interchange <$> genab
4156

4257
where
4358

‎src/Test/QuickCheck/Laws/Control/Apply.purs‎

Lines changed: 20 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -2,13 +2,12 @@ module Test.QuickCheck.Laws.Control.Apply where
22

33
import Prelude
44

5+
import Control.Apply (lift3)
56
import Control.Monad.Eff.Console (log)
6-
7-
import Type.Proxy (Proxy2)
8-
9-
import Test.QuickCheck (QC, quickCheck')
10-
import Test.QuickCheck.Arbitrary (class Arbitrary)
7+
import Test.QuickCheck (class Arbitrary, QC, arbitrary, quickCheck')
8+
import Test.QuickCheck.Gen (Gen)
119
import Test.QuickCheck.Laws (A, B, C)
10+
import Type.Proxy (Proxy2)
1211

1312
-- | - Associative composition: `(<<<) <$> f <*> g <*> h = f <*> (g <*> h)`
1413
checkApply
@@ -20,10 +19,24 @@ checkApply
2019
⇒ Eq (f C)
2120
⇒ Proxy2 f
2221
→ QC eff Unit
23-
checkApply _ = do
22+
checkApply _ =
23+
checkApplyGen
24+
(arbitrary :: Gen (f A))
25+
(arbitrary :: Gen (f (A → B)))
26+
(arbitrary :: Gen (f (B → C)))
27+
28+
checkApplyGen
29+
∷ ∀ eff f
30+
. Apply f
31+
⇒ Eq (f C)
32+
⇒ Gen (f A)
33+
→ Gen (f (A → B))
34+
→ Gen (f (B → C))
35+
→ QC eff Unit
36+
checkApplyGen gen genab genbc = do
2437

2538
log "Checking 'Associative composition' law for Apply"
26-
quickCheck' 1000 associativeComposition
39+
quickCheck' 1000 $ lift3 associativeComposition genbc genab gen
2740

2841
where
2942

‎src/Test/QuickCheck/Laws/Control/Bind.purs‎

Lines changed: 15 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -2,13 +2,12 @@ module Test.QuickCheck.Laws.Control.Bind where
22

33
import Prelude
44

5+
import Control.Apply (lift3)
56
import Control.Monad.Eff.Console (log)
6-
7-
import Type.Proxy (Proxy2)
8-
9-
import Test.QuickCheck (QC, quickCheck')
10-
import Test.QuickCheck.Arbitrary (class Arbitrary)
7+
import Test.QuickCheck (class Arbitrary, arbitrary, QC, quickCheck')
8+
import Test.QuickCheck.Gen (Gen)
119
import Test.QuickCheck.Laws (A)
10+
import Type.Proxy (Proxy2)
1211

1312
-- | - Associativity: `(x >>= f) >>= g = x >>= (\k → f k >>= g)`
1413
checkBind
@@ -18,10 +17,19 @@ checkBind
1817
⇒ Eq (m A)
1918
⇒ Proxy2 m
2019
→ QC eff Unit
21-
checkBind _ = do
20+
checkBind _ = checkBindGen (arbitrary :: Gen (m A)) (arbitrary :: Gen (A → m A))
21+
22+
checkBindGen
23+
∷ ∀ eff m
24+
. Bind m
25+
⇒ Eq (m A)
26+
⇒ Gen (m A)
27+
→ Gen (A → m A)
28+
→ QC eff Unit
29+
checkBindGen gen genF = do
2230

2331
log "Checking 'Associativity' law for Bind"
24-
quickCheck' 1000 associativity
32+
quickCheck' 1000 $ lift3 associativity gen genF genF
2533

2634
where
2735

‎src/Test/QuickCheck/Laws/Control/Category.purs‎

Lines changed: 14 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -3,12 +3,10 @@ module Test.QuickCheck.Laws.Control.Category where
33
import Prelude
44

55
import Control.Monad.Eff.Console (log)
6-
7-
import Type.Proxy (Proxy3)
8-
9-
import Test.QuickCheck (QC, quickCheck')
10-
import Test.QuickCheck.Arbitrary (class Arbitrary)
6+
import Test.QuickCheck (class Arbitrary, QC, arbitrary, quickCheck')
7+
import Test.QuickCheck.Gen (Gen)
118
import Test.QuickCheck.Laws (B, C)
9+
import Type.Proxy (Proxy3)
1210

1311
-- | - Identity: `id <<< p = p <<< id = p`
1412
checkCategory
@@ -18,10 +16,19 @@ checkCategory
1816
⇒ Eq (a B C)
1917
⇒ Proxy3 a
2018
→ QC eff Unit
21-
checkCategory _ = do
19+
checkCategory _ = checkCategoryGen (arbitrary :: Gen (a B C))
20+
21+
checkCategoryGen
22+
∷ ∀ eff a
23+
. Category a
24+
⇒ Arbitrary (a B C)
25+
⇒ Eq (a B C)
26+
⇒ Gen (a B C)
27+
→ QC eff Unit
28+
checkCategoryGen gen = do
2229

2330
log "Checking 'Identity' law for Category"
24-
quickCheck' 1000 identity
31+
quickCheck' 1000 $ identity <$> gen
2532

2633
where
2734

‎src/Test/QuickCheck/Laws/Control/Comonad.purs‎

Lines changed: 20 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -2,15 +2,14 @@ module Test.QuickCheck.Laws.Control.Comonad where
22

33
import Prelude
44

5-
import Control.Monad.Eff.Console (log)
5+
import Control.Apply (lift2)
66
import Control.Comonad (class Comonad, extract)
77
import Control.Extend ((<<=))
8-
9-
import Type.Proxy (Proxy2)
10-
11-
import Test.QuickCheck (QC, quickCheck')
12-
import Test.QuickCheck.Arbitrary (class Arbitrary, class Coarbitrary)
8+
import Control.Monad.Eff.Console (log)
9+
import Test.QuickCheck (class Arbitrary, class Coarbitrary, QC, arbitrary, quickCheck')
10+
import Test.QuickCheck.Gen (Gen)
1311
import Test.QuickCheck.Laws (A, B)
12+
import Type.Proxy (Proxy2)
1413

1514
-- | - Left Identity: `extract <<= x = x`
1615
-- | - Right Identity: `extract (f <<= x) = f x`
@@ -22,13 +21,25 @@ checkComonad
2221
⇒ Eq (w A)
2322
⇒ Proxy2 w
2423
→ QC eff Unit
25-
checkComonad _ = do
24+
checkComonad _ =
25+
checkComonadGen
26+
(arbitrary :: Gen (w A))
27+
(arbitrary :: Gen (w A → B))
28+
29+
checkComonadGen
30+
∷ ∀ eff w
31+
. Comonad w
32+
⇒ Eq (w A)
33+
⇒ Gen (w A)
34+
→ Gen (w A → B)
35+
→ QC eff Unit
36+
checkComonadGen gen cogen = do
2637

2738
log "Checking 'Left identity' law for Comonad"
28-
quickCheck' 1000 leftIdentity
39+
quickCheck' 1000 $ leftIdentity <$> gen
2940

3041
log "Checking 'Right identity' law for Comonad"
31-
quickCheck' 1000 rightIdentity
42+
quickCheck' 1000 $ lift2 rightIdentity cogen gen
3243

3344
where
3445

‎src/Test/QuickCheck/Laws/Control/Extend.purs‎

Lines changed: 23 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -2,14 +2,13 @@ module Test.QuickCheck.Laws.Control.Extend where
22

33
import Prelude
44

5+
import Control.Apply (lift3)
56
import Control.Extend (class Extend, (<<=))
67
import Control.Monad.Eff.Console (log)
7-
8-
import Type.Proxy (Proxy2)
9-
10-
import Test.QuickCheck (QC, quickCheck')
11-
import Test.QuickCheck.Arbitrary (class Arbitrary, class Coarbitrary)
8+
import Test.QuickCheck (class Arbitrary, class Coarbitrary, QC, arbitrary, quickCheck')
9+
import Test.QuickCheck.Gen (Gen)
1210
import Test.QuickCheck.Laws (A, B, C)
11+
import Type.Proxy (Proxy2)
1312

1413
-- | - Associativity: `extend f <<< extend g = extend (f <<< extend g)`
1514
checkExtend
@@ -21,10 +20,27 @@ checkExtend
2120
⇒ Eq (w C)
2221
⇒ Proxy2 w
2322
→ QC eff Unit
24-
checkExtend _ = do
23+
checkExtend _ =
24+
checkExtendGen
25+
(arbitrary :: Gen (w A))
26+
(arbitrary :: Gen (w B → C))
27+
(arbitrary :: Gen (w A → B))
28+
29+
checkExtendGen
30+
∷ ∀ eff w
31+
. Extend w
32+
⇒ Arbitrary (w A)
33+
⇒ Coarbitrary (w A)
34+
⇒ Coarbitrary (w B)
35+
⇒ Eq (w C)
36+
⇒ Gen (w A)
37+
→ Gen (w B → C)
38+
→ Gen (w A → B)
39+
→ QC eff Unit
40+
checkExtendGen gen genwbc genwab = do
2541

2642
log "Checking 'Associativity' law for Extend"
27-
quickCheck' 1000 associativity
43+
quickCheck' 1000 $ lift3 associativity genwbc genwab gen
2844

2945
where
3046

0 commit comments

Comments
 (0)