Skip to content

Commit dcdf9ae

Browse files
paf31paf31
committed
Merge pull request #9 from jdegoes/ready/determinism
General enhancements to Gen
2 parents 73d0937 + 9d0b7f2 commit dcdf9ae

File tree

7 files changed

+747
-218
lines changed

7 files changed

+747
-218
lines changed

‎README.md‎

Lines changed: 34 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,15 @@
77
newtype AlphaNumString where
88
AlphaNumString :: String -> AlphaNumString
99

10+
newtype Negative where
11+
Negative :: Number -> Negative
12+
13+
newtype NonZero where
14+
NonZero :: Number -> NonZero
15+
16+
newtype Positive where
17+
Positive :: Number -> Positive
18+
1019
type QC a = forall eff. Eff (err :: Exception, random :: Random, trace :: Trace | eff) a
1120

1221
data Result where
@@ -40,8 +49,14 @@
4049

4150
instance arbMaybe :: (Arbitrary a) => Arbitrary (Maybe a)
4251

52+
instance arbNegative :: Arbitrary Negative
53+
54+
instance arbNonZero :: Arbitrary NonZero
55+
4356
instance arbNumber :: Arbitrary Number
4457

58+
instance arbPositive :: Arbitrary Positive
59+
4560
instance arbString :: Arbitrary String
4661

4762
instance arbTuple :: (Arbitrary a, Arbitrary b) => Arbitrary (Tuple a b)
@@ -58,12 +73,22 @@
5873

5974
instance coarbMaybe :: (CoArbitrary a) => CoArbitrary (Maybe a)
6075

76+
instance coarbNegative :: CoArbitrary Negative
77+
78+
instance coarbNonZero :: CoArbitrary NonZero
79+
6180
instance coarbNumber :: CoArbitrary Number
6281

82+
instance coarbPositive :: CoArbitrary Positive
83+
6384
instance coarbString :: CoArbitrary String
6485

6586
instance coarbTuple :: (CoArbitrary a, CoArbitrary b) => CoArbitrary (Tuple a b)
6687

88+
instance monoidResult :: Monoid Result
89+
90+
instance semigroupResult :: Semigroup Result
91+
6792
instance showResult :: Show Result
6893

6994
instance testableBoolean :: Testable Boolean
@@ -81,7 +106,15 @@
81106

82107
quickCheck' :: forall prop. (Testable prop) => Number -> prop -> QC Unit
83108

84-
quickCheckPure :: forall prop. (Testable prop) => Number -> Number -> prop -> [Result]
109+
quickCheckPure :: forall prop. (Testable prop) => Number -> Seed -> prop -> [Result]
110+
111+
smallCheck :: forall prop. (Testable prop) => prop -> QC Unit
112+
113+
smallCheckPure :: forall prop. (Testable prop) => Number -> prop -> [Result]
114+
115+
statCheck :: forall prop. (Testable prop) => Number -> prop -> QC Unit
116+
117+
statCheckPure :: forall prop. (Testable prop) => Seed -> Number -> prop -> Result
85118

86119

87120

‎bower.json‎

Lines changed: 16 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,11 @@
11
{
22
"name": "purescript-quickcheck",
3-
"version": "0.0.2",
3+
"version": "0.1.6",
44
"license": "MIT",
5+
"authors": [
6+
"John A. De Goes <[email protected]> (http://degoes.net)",
7+
"Phil Freeman <[email protected]>"
8+
],
59
"ignore": [
610
"**/.*",
711
"bower_components",
@@ -14,14 +18,17 @@
1418
"package.json"
1519
],
1620
"dependencies": {
17-
"purescript-random": "*",
18-
"purescript-exceptions": "*",
19-
"purescript-arrays": "*",
20-
"purescript-strings": "*",
21-
"purescript-math": "*",
22-
"purescript-tuples": "*",
23-
"purescript-either": "*",
24-
"purescript-maybe": "*",
21+
"purescript-random": "*",
22+
"purescript-exceptions": "*",
23+
"purescript-transformers": "*",
24+
"purescript-free": "0.1.3",
25+
"purescript-machines": "0.1.5",
26+
"purescript-arrays": "*",
27+
"purescript-strings": "*",
28+
"purescript-math": "*",
29+
"purescript-tuples": "*",
30+
"purescript-either": "*",
31+
"purescript-maybe": "*",
2532
"purescript-foldable-traversable": "*"
2633
}
2734
}

‎examples/Prelude.purs‎

Lines changed: 118 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -4,27 +4,129 @@ import Control.Monad.Eff
44
import Data.Eq
55
import Debug.Trace
66
import Test.QuickCheck
7+
import Test.QuickCheck.LCG
8+
import Control.Monad.Trampoline
9+
import Data.Monoid
10+
import Data.Tuple
11+
import Data.Maybe
12+
import Data.Foldable
13+
import qualified Data.Array as Array
14+
import qualified Math as Math
715

8-
testConst :: Number -> Number -> Number -> Boolean
9-
testConst a b c = const a b == const a c
16+
between :: forall a. (Ord a) => a -> a -> a -> Boolean
17+
between min max = \n -> n >= min && n <= max
1018

11-
mkMessage :: (Number -> Number) -> String
12-
mkMessage f = "Test failed for function ("
13-
++ show (f 0) ++ ", "
14-
++ show (f 1) ++ ", "
15-
++ show (f 2) ++ ")"
19+
data Mega = Mega {
20+
arrayOf :: [Number],
21+
arrayOf1 :: [Number],
22+
choose :: Number,
23+
chooseInt :: Number,
24+
collectAll :: [Number],
25+
allInArray :: [Number],
26+
allInRange :: [Number],
27+
dropGen :: [Number],
28+
takeGen :: [Number],
29+
elements :: [String],
30+
extend :: [String],
31+
infinite :: [String],
32+
perms :: [[String]] }
33+
34+
{- TODO: Remaining cases
35+
, frequency
36+
, oneOf
37+
, perturbGen
38+
, repeatable
39+
, resize
40+
, sample
41+
, sample'
42+
, showSample
43+
, showSample'
44+
, sized
45+
, stateful
46+
, suchThat
47+
, suchThatMaybe
48+
, unfoldGen
49+
, uniform
50+
, variant
51+
, vectorOf
52+
-}
53+
54+
data DetABC = DetABC String
55+
56+
runDetABC :: DetABC -> String
57+
runDetABC (DetABC s) = s
58+
59+
instance arbDetABC :: Arbitrary DetABC where
60+
arbitrary = DetABC <$> allInArray ["A", "B", "C"]
61+
62+
data OneToTen = OneToTen Number
63+
64+
runOneToTen :: OneToTen -> Number
65+
runOneToTen (OneToTen n) = n
66+
67+
instance arbOneToTen :: Arbitrary OneToTen where
68+
arbitrary = OneToTen <$> chooseInt 0 10
69+
70+
instance arbMega :: Arbitrary Mega where
71+
arbitrary = do
72+
arrayOf' <- arrayOf (choose 0 10)
73+
arrayOf1' <- arrayOf1 (choose 0 10)
74+
choose' <- choose 0 10
75+
chooseInt' <- chooseInt 0 10
76+
collectAll' <- collectAll mempty (allInArray [0, 1, 2])
77+
allInArray' <- collectAll mempty (allInArray [0, 1, 2])
78+
allInRange' <- collectAll mempty (allInRange 0 10)
79+
dropGen' <- collectAll mempty $ dropGen 2 (allInArray [2, 1, -1])
80+
takeGen' <- collectAll mempty $ takeGen 2 (allInArray [2, 1, -1])
81+
elements' <- arrayOf $ elements "foo" ["bar", "baz"]
82+
extend' <- collectAll mempty $ extend 3 (pure "5")
83+
infinite' <- collectAll mempty $ takeGen 4 (infinite $ pure "foo")
84+
perms' <- collectAll mempty $ perms ["John", "D"]
85+
return $ Mega {
86+
arrayOf: arrayOf',
87+
arrayOf1: (case arrayOf1' of Tuple a as -> a : as),
88+
choose: choose',
89+
chooseInt: chooseInt',
90+
collectAll: collectAll',
91+
allInArray: allInArray',
92+
allInRange: allInRange',
93+
dropGen: dropGen',
94+
takeGen: takeGen',
95+
elements: elements',
96+
extend: extend',
97+
infinite: infinite',
98+
perms: perms' }
99+
100+
verify_gen :: Mega -> Result
101+
verify_gen (Mega m) = fold [
102+
all (between 0 10) m.arrayOf <?> "arrayOf: " ++ show m.arrayOf,
103+
Array.length m.arrayOf1 >= 1 <?> "arrayOf1: " ++ show m.arrayOf1,
104+
between 0 10 m.choose <?> "choose: " ++ show m.choose,
105+
between 0 10 m.chooseInt &&
106+
Math.floor(m.chooseInt) == m.chooseInt <?> "chooseInt: " ++ show m.chooseInt,
107+
m.collectAll == [0, 1, 2] <?> "collectAll: " ++ show m.collectAll,
108+
m.allInArray == [0, 1, 2] <?> "allInArray: " ++ show m.allInArray,
109+
m.allInRange == [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10] <?> "allInRange: " ++ show m.allInRange,
110+
m.dropGen == [-1] <?> "dropGen: " ++ show m.dropGen,
111+
m.takeGen == [2, 1] <?> "takeGen: " ++ show m.takeGen,
112+
all (flip elem ["foo", "bar", "baz"]) m.elements <?> "elements: " ++ show m.elements,
113+
m.extend == ["5", "5", "5"] <?> "extend: " ++ show m.extend,
114+
m.infinite == ["foo", "foo", "foo", "foo"] <?> "infinite: " ++ show m.infinite,
115+
m.perms == ["John", "D"] : ["D", "John"] : [] <?> "perms: " ++ show m.perms]
16116

17117
main = do
18-
Debug.Trace.trace "testConst:"
19-
quickCheck testConst
118+
trace "Gen combinators"
119+
quickCheck $ verify_gen
120+
121+
trace "foldGen"
122+
quickCheck $ (runTrampoline $ foldGen (\a b -> Just $ a + b) 1 mempty (allInArray [1, 2, 3])) == 7
20123

21-
Debug.Trace.trace "id is a left unit for <<<"
22-
quickCheck $ \f a -> ((id <<< f) (a :: Number) == (f a) :: Number) <?> mkMessage f
124+
trace "smallCheck"
125+
smallCheck $ runDetABC >>> (flip elem ["A", "B", "C"])
23126

24-
Debug.Trace.trace "Precedence of && and ||:"
25-
quickCheck $ \a b c -> ((a :: Boolean && b) || c) == ((a || c) && (b || c))
127+
trace "Fair distribution of booleans"
128+
statCheck (1/2) $ (==) true
26129

27-
Debug.Trace.trace "Test Eq instance for Ref:"
28-
quickCheck $ \a -> (Ref a :: Ref Number) == Ref a
29-
quickCheck $ \a -> not $ (Ref a :: Ref Number /= Ref a)
130+
trace "Fair distribution of ints"
131+
statCheck (1/11) $ runOneToTen >>> ((==) 1)
30132

‎package.json‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,12 @@
11
{
22
"name": "purescript-quickcheck",
33
"license": "MIT",
4+
"version": "0.1.6",
45
"repository": "[email protected]:purescript-contrib/purescript-quickcheck.git",
6+
"contributors": [
7+
"John A. De Goes <[email protected]> (http://degoes.net)",
8+
"Phil Freeman <[email protected]>"
9+
],
510

611
"devDependencies": {
712
"gulp": "^3.8.8",

0 commit comments

Comments
 (0)