Merge pull request #8 from jdegoes/master

add instances for either, maybe, and tuple, and some helper functions

Author: paf31

README.md

@@ -34,24 +34,36 @@
 
     instance arbBoolean :: Arbitrary Boolean
 
+    instance arbEither :: (Arbitrary a, Arbitrary b) => Arbitrary (Either a b)
+
     instance arbFunction :: (CoArbitrary a, Arbitrary b) => Arbitrary (a -> b)
 
+    instance arbMaybe :: (Arbitrary a) => Arbitrary (Maybe a)
+
     instance arbNumber :: Arbitrary Number
 
     instance arbString :: Arbitrary String
 
+    instance arbTuple :: (Arbitrary a, Arbitrary b) => Arbitrary (Tuple a b)
+
     instance coarbAlphaNumString :: CoArbitrary AlphaNumString
 
     instance coarbArray :: (CoArbitrary a) => CoArbitrary [a]
 
     instance coarbBoolean :: CoArbitrary Boolean
 
+    instance coarbEither :: (CoArbitrary a, CoArbitrary b) => CoArbitrary (Either a b)
+
     instance coarbFunction :: (Arbitrary a, CoArbitrary b) => CoArbitrary (a -> b)
 
+    instance coarbMaybe :: (CoArbitrary a) => CoArbitrary (Maybe a)
+
     instance coarbNumber :: CoArbitrary Number
 
     instance coarbString :: CoArbitrary String
 
+    instance coarbTuple :: (CoArbitrary a, CoArbitrary b) => CoArbitrary (Tuple a b)
+
     instance showResult :: Show Result
 
     instance testableBoolean :: Testable Boolean

bower.json

@@ -14,10 +14,14 @@
     "package.json"
   ],
   "dependencies": {
-    "purescript-random": "*",
-    "purescript-exceptions": "0.2.0",
-    "purescript-arrays": "*",
-    "purescript-strings": "*",
-    "purescript-math": "*"
+    "purescript-random":      "*",
+    "purescript-exceptions":  "*",
+    "purescript-arrays":      "*",
+    "purescript-strings":     "*",
+    "purescript-math":        "*",
+    "purescript-tuples":      "*",
+    "purescript-either":      "*",
+    "purescript-maybe":       "*",
+    "purescript-foldable-traversable": "*"
   }
 }

package.json

@@ -1,6 +1,5 @@
 {
   "name":       "purescript-quickcheck",
-  "version":    "0.0.2",
   "license":    "MIT",
   "repository": "[email protected]:purescript-contrib/purescript-quickcheck.git",
 

src/Test/QuickCheck.purs

@@ -6,6 +6,9 @@ import Control.Monad.Eff
 import Control.Monad.Eff.Random
 import Control.Monad.Eff.Exception
 import Data.Array
+import Data.Tuple
+import Data.Maybe
+import Data.Either
 import Math
 
 import qualified Data.String as S
@@ -65,16 +68,37 @@ instance arbAlphaNumString :: Arbitrary AlphaNumString where
 instance coarbAlphaNumString :: CoArbitrary AlphaNumString where
   coarbitrary (AlphaNumString s) = coarbitrary s
 
+instance arbTuple :: (Arbitrary a, Arbitrary b) => Arbitrary (Tuple a b) where
+  arbitrary = Tuple <$> arbitrary <*> arbitrary
+
+instance coarbTuple :: (CoArbitrary a, CoArbitrary b) => CoArbitrary (Tuple a b) where
+  coarbitrary (Tuple a b) = coarbitrary a >>> coarbitrary b
+
+instance arbEither :: (Arbitrary a, Arbitrary b) => Arbitrary (Either a b) where
+  arbitrary = do
+    b <- arbitrary
+    if b then Left <$> arbitrary else Right <$> arbitrary
+
+instance coarbEither :: (CoArbitrary a, CoArbitrary b) => CoArbitrary (Either a b) where
+  coarbitrary (Left a)  = coarbitrary a
+  coarbitrary (Right b) = coarbitrary b
+
+instance arbMaybe :: (Arbitrary a) => Arbitrary (Maybe a) where
+  arbitrary = do
+    b <- arbitrary
+    if b then pure Nothing else Just <$> arbitrary
+
+instance coarbMaybe :: (CoArbitrary a) => CoArbitrary (Maybe a) where
+  coarbitrary Nothing = perturbGen 1
+  coarbitrary (Just a) = coarbitrary a
+
 instance arbFunction :: (CoArbitrary a, Arbitrary b) => Arbitrary (a -> b) where
   arbitrary = repeatable (\a -> coarbitrary a arbitrary)
 
 instance coarbFunction :: (Arbitrary a, CoArbitrary b) => CoArbitrary (a -> b) where
   coarbitrary f gen = do
     xs <- arbitrary
     coarbitrary (map f xs) gen
-    where
-    map _ [] = []
-    map f (x : xs) = f x : map f xs
 
 instance arbArray :: (Arbitrary a) => Arbitrary [a] where
   arbitrary = do

src/Test/QuickCheck/LCG.purs

@@ -6,17 +6,36 @@ module Test.QuickCheck.LCG
     Size(),
     LCG(),
     repeatable,
-    sized,
     stateful,
+    variant,
+    sized,
     resize,
+    choose,
+    chooseInt,
+    oneOf,
+    frequency,
+    listOf,
+    listOf1,
+    vectorOf,
+    elements,
     runGen,
     evalGen,
     perturbGen,
-    uniform
+    uniform,
+    showSample,
+    showSample'
   ) where
 
 import Control.Monad.Eff
 import Control.Monad.Eff.Random
+import Debug.Trace
+import Data.Maybe
+import Data.Tuple
+import Data.Foldable
+import Data.Traversable
+import Data.Monoid.Sum
+import qualified Data.Array as A
+import qualified Math as M
 
 type LCG = Number
 type Size = Number
@@ -30,20 +49,76 @@ data Gen a = Gen (GenState -> GenOut a)
 repeatable :: forall a b. (a -> Gen b) -> Gen (a -> b)
 repeatable f = Gen $ \s -> { value: \a -> (runGen (f a) s).value, state: s }
 
-sized :: forall a. (Number -> Gen a) -> Gen a
-sized f = stateful (\s -> f s.size)
-
 stateful :: forall a. (GenState -> Gen a) -> Gen a
 stateful f = Gen (\s -> runGen (f s) s)
 
-resize :: forall a. Number -> Gen a -> Gen a
-resize sz g = Gen (\s -> runGen g s { size = sz })
+variant :: forall a. LCG -> Gen a -> Gen a
+variant n g = Gen $ \s -> runGen g s { newSeed = n }
+
+sized :: forall a. (Size -> Gen a) -> Gen a
+sized f = stateful (\s -> f s.size)
+
+resize :: forall a. Size -> Gen a -> Gen a
+resize sz g = Gen $ \s -> runGen g s { size = sz }
+
+choose :: Number -> Number -> Gen Number
+choose a b = (*) (max - min) >>> (+) min <$> uniform where
+  min = M.min a b
+  max = M.max a b
+
+chooseInt :: Number -> Number -> Gen Number
+chooseInt a b = M.floor <$> choose (M.ceil a) (M.floor b + 0.999999999)
+
+oneOf :: forall a. Gen a -> [Gen a] -> Gen a
+oneOf x xs = do
+  n <- chooseInt 0 (A.length xs)
+  if n == 0 then x else fromMaybe x (xs A.!! (n - 1))
+
+frequency :: forall a. Tuple Number (Gen a) -> [Tuple Number (Gen a)] -> Gen a
+frequency x xs = let
+    xxs   = x : xs
+    total = runSum $ fold (((Sum <<< fst) <$> xxs) :: [Sum])
+    pick n d [] = d
+    pick n d ((Tuple k x) : xs) = if n <= k then x else pick (n - k) d xs
+  in do
+    n <- chooseInt 1 total
+    pick n (snd x) xxs
+
+listOf :: forall a. Gen a -> Gen [a]
+listOf g = sized $ \n ->
+  do k <- chooseInt 0 n
+     vectorOf k g
+
+listOf1 :: forall a. Gen a -> Gen (Tuple a [a])
+listOf1 g = sized $ \n ->
+  do k  <- chooseInt 0 n
+     x  <- g
+     xs <- vectorOf (k - 1) g
+     return $ Tuple x xs
+
+vectorOf :: forall a. Number -> Gen a -> Gen [a]
+vectorOf k g = sequence $ const g <$> (A.range 1 k)
+
+elements :: forall a. a -> [a] -> Gen a
+elements x xs = do
+  n <- chooseInt 0 (A.length xs)
+  pure if n == 0 then x else fromMaybe x (xs A.!! (n - 1))
 
 runGen :: forall a. Gen a -> GenState -> GenOut a
 runGen (Gen f) = f
 
 evalGen :: forall a. Gen a -> GenState -> a 
 evalGen gen st = (runGen gen st).value
+
+sample :: forall r a. Size -> Gen a -> [a]
+sample sz g = evalGen (vectorOf sz g) { newSeed: 0, size: sz }
+
+showSample' :: forall r a. (Show a) => Size -> Gen a -> Eff (trace :: Trace | r) Unit
+showSample' n g = print $ sample n g
+
+showSample :: forall r a. (Show a) => Gen a -> Eff (trace :: Trace | r) Unit
+showSample = showSample' 10
+
 --
 -- Magic Numbers
 --
@@ -96,5 +171,4 @@ instance bindGen :: Bind Gen where
   (>>=) (Gen f) g = Gen $ \s -> case f s of
     { value = value, state = state } -> runGen (g value) state
 
-instance monadGen :: Monad Gen
-
+instance monadGen :: Monad Gen

src/Test/QuickCheck/README.md

@@ -30,21 +30,39 @@
 
 ### Values
 
+    choose :: Number -> Number -> Gen Number
+
+    chooseInt :: Number -> Number -> Gen Number
+
+    elements :: forall a. a -> [a] -> Gen a
+
     evalGen :: forall a. Gen a -> GenState -> a
 
+    frequency :: forall a. Tuple Number (Gen a) -> [Tuple Number (Gen a)] -> Gen a
+
+    listOf :: forall a. Gen a -> Gen [a]
+
+    listOf1 :: forall a. Gen a -> Gen (Tuple a [a])
+
+    oneOf :: forall a. Gen a -> [Gen a] -> Gen a
+
     perturbGen :: forall a. Number -> Gen a -> Gen a
 
     repeatable :: forall a b. (a -> Gen b) -> Gen (a -> b)
 
-    resize :: forall a. Number -> Gen a -> Gen a
+    resize :: forall a. Size -> Gen a -> Gen a
 
     runGen :: forall a. Gen a -> GenState -> GenOut a
 
-    sized :: forall a. (Number -> Gen a) -> Gen a
+    sized :: forall a. (Size -> Gen a) -> Gen a
 
     stateful :: forall a. (GenState -> Gen a) -> Gen a
 
     uniform :: Gen Number
 
+    variant :: forall a. LCG -> Gen a -> Gen a
+
+    vectorOf :: forall a. Number -> Gen a -> Gen [a]
+