Skip to content

Commit

Permalink
Updates for 0.7
Browse files Browse the repository at this point in the history
  • Loading branch information
paf31 committed Jun 6, 2015
1 parent f70074f commit 14286c6
Show file tree
Hide file tree
Showing 7 changed files with 93 additions and 80 deletions.
28 changes: 15 additions & 13 deletions src/Test/QuickCheck.purs
Original file line number Diff line number Diff line change
Expand Up @@ -17,12 +17,14 @@
-- | ```
module Test.QuickCheck where

import Prelude

import Console (CONSOLE(), log)
import Control.Monad (replicateM)
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Exception (EXCEPTION(), throwException, error)
import Control.Monad.Eff.Random (RANDOM(), random)
import Data.Int (Int(), fromNumber, toNumber)
import Data.Int (fromNumber, toNumber)
import Data.List (List(..), replicateM)
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Gen
import Test.QuickCheck.LCG
Expand All @@ -35,7 +37,7 @@ type QC a = forall eff. Eff (console :: CONSOLE, random :: RANDOM, err :: EXCEPT
-- | This function generates a new random seed, runs 100 tests and
-- | prints the test results to the console.
quickCheck :: forall prop. (Testable prop) => prop -> QC Unit
quickCheck prop = quickCheck' (fromNumber 100) prop
quickCheck prop = quickCheck' 100 prop

-- | A variant of the `quickCheck` function which accepts an extra parameter
-- | representing the number of tests which should be run.
Expand All @@ -49,22 +51,22 @@ quickCheck' n prop = do

where

throwOnFirstFailure :: Int -> [Result] -> QC Unit
throwOnFirstFailure _ [] = return unit
throwOnFirstFailure n (Failed msg : _) = throwException $ error $ "Test " ++ show (toNumber n) ++ " failed: \n" ++ msg
throwOnFirstFailure n (_ : rest) = throwOnFirstFailure (n + one) rest
throwOnFirstFailure :: Int -> List Result -> QC Unit
throwOnFirstFailure _ Nil = return unit
throwOnFirstFailure n (Cons (Failed msg) _) = throwException $ error $ "Test " ++ show (toNumber n) ++ " failed: \n" ++ msg
throwOnFirstFailure n (Cons _ rest) = throwOnFirstFailure (n + one) rest

countSuccesses :: [Result] -> Int
countSuccesses [] = zero
countSuccesses (Success : rest) = one + countSuccesses rest
countSuccesses (_ : rest) = countSuccesses rest
countSuccesses :: List Result -> Int
countSuccesses Nil = zero
countSuccesses (Cons Success rest) = one + countSuccesses rest
countSuccesses (Cons _ rest) = countSuccesses rest

-- | Test a property, returning all test results as an array.
-- |
-- | The first argument is the _random seed_ to be passed to the random generator.
-- | The second argument is the number of tests to run.
quickCheckPure :: forall prop. (Testable prop) => Int -> Int -> prop -> [Result]
quickCheckPure s n prop = evalGen (replicateM n (test prop)) { newSeed: s, size: fromNumber 10 }
quickCheckPure :: forall prop. (Testable prop) => Int -> Int -> prop -> List Result
quickCheckPure s n prop = evalGen (replicateM n (test prop)) { newSeed: s, size: 10 }

-- | The `Testable` class represents _testable properties_.
-- |
Expand Down
45 changes: 21 additions & 24 deletions src/Test/QuickCheck/Arbitrary.purs
Original file line number Diff line number Diff line change
@@ -1,12 +1,15 @@
module Test.QuickCheck.Arbitrary where

import Data.Array (map)
import Data.Char (Char(), toCharCode, fromCharCode)
import Prelude

import Data.Array ((:))
import Data.Char (toCharCode, fromCharCode)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.String (charCodeAt, fromCharArray, split)
import Data.Tuple (Tuple(..))
import Data.Int (Int(), fromNumber, toNumber)
import Data.Int (fromNumber, toNumber)
import Data.Foldable (foldl)
import Test.QuickCheck.Gen

-- | The `Arbitrary` class represents those types whose values can be
Expand All @@ -32,11 +35,11 @@ class Coarbitrary t where
instance arbBoolean :: Arbitrary Boolean where
arbitrary = do
n <- uniform
return $ (n * 2) < 1
return $ (n * 2.0) < 1.0

instance coarbBoolean :: Coarbitrary Boolean where
coarbitrary true = perturbGen 1
coarbitrary false = perturbGen 2
coarbitrary true = perturbGen 1.0
coarbitrary false = perturbGen 2.0

instance arbNumber :: Arbitrary Number where
arbitrary = uniform
Expand All @@ -45,7 +48,7 @@ instance coarbNumber :: Coarbitrary Number where
coarbitrary = perturbGen

instance arbInt :: Arbitrary Int where
arbitrary = chooseInt (fromNumber (-1000000)) (fromNumber 1000000)
arbitrary = chooseInt (-1000000) 1000000

instance coarbInt :: Coarbitrary Int where
coarbitrary = perturbGen <<< toNumber
Expand All @@ -57,7 +60,7 @@ instance coarbString :: Coarbitrary String where
coarbitrary s = coarbitrary $ (charCodeAt zero <$> split "" s)

instance arbChar :: Arbitrary Char where
arbitrary = fromCharCode <<< fromNumber <<< (* 65535) <$> uniform
arbitrary = fromCharCode <$> chooseInt 0 65536

instance coarbChar :: Coarbitrary Char where
coarbitrary c = coarbitrary $ toCharCode c
Expand All @@ -66,40 +69,34 @@ instance arbUnit :: Arbitrary Unit where
arbitrary = return unit

instance coarbUnit :: Coarbitrary Unit where
coarbitrary _ = perturbGen 1
coarbitrary _ = perturbGen 1.0

instance arbOrdering :: Arbitrary Ordering where
arbitrary = do
n <- chooseInt (fromNumber 1) (fromNumber 3)
return $ case toNumber n of
1 -> LT
2 -> EQ
3 -> GT
arbitrary = oneOf (pure LT) [pure EQ, pure GT]

instance coarbOrdering :: Coarbitrary Ordering where
coarbitrary LT = perturbGen 1
coarbitrary EQ = perturbGen 2
coarbitrary GT = perturbGen 3
coarbitrary LT = perturbGen 1.0
coarbitrary EQ = perturbGen 2.0
coarbitrary GT = perturbGen 3.0

instance arbArray :: (Arbitrary a) => Arbitrary [a] where
instance arbArray :: (Arbitrary a) => Arbitrary (Array a) where
arbitrary = do
b <- arbitrary
if b then return [] else do
a <- arbitrary
as <- arbitrary
return (a : as)

instance coarbArray :: (Coarbitrary a) => Coarbitrary [a] where
coarbitrary [] = id
coarbitrary (x : xs) = coarbitrary xs <<< coarbitrary x
instance coarbArray :: (Coarbitrary a) => Coarbitrary (Array a) where
coarbitrary = foldl (\f x -> f <<< coarbitrary x) id

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
coarbitrary (map f (xs :: Array a)) gen

instance arbTuple :: (Arbitrary a, Arbitrary b) => Arbitrary (Tuple a b) where
arbitrary = Tuple <$> arbitrary <*> arbitrary
Expand All @@ -113,7 +110,7 @@ instance arbMaybe :: (Arbitrary a) => Arbitrary (Maybe a) where
if b then pure Nothing else Just <$> arbitrary

instance coarbMaybe :: (Coarbitrary a) => Coarbitrary (Maybe a) where
coarbitrary Nothing = perturbGen 1
coarbitrary Nothing = perturbGen 1.0
coarbitrary (Just a) = coarbitrary a

instance arbEither :: (Arbitrary a, Arbitrary b) => Arbitrary (Either a b) where
Expand Down
19 changes: 11 additions & 8 deletions src/Test/QuickCheck/Data/AlphaNumString.purs
Original file line number Diff line number Diff line change
@@ -1,26 +1,29 @@
module Test.QuickCheck.Data.AlphaNumString where

import Prelude

import Data.Int (fromNumber, toNumber)
import Data.String (fromCharArray, length)
import Data.String (fromCharArray, toCharArray, length)
import Data.String.Unsafe (charAt)
import Math (round)
import Test.QuickCheck.Gen
import Test.QuickCheck.Arbitrary

-- | A newtype for `String` whose `Arbitrary` instance generated random
-- | alphanumeric strings.
newtype AlphaNumString = AlphaNumString String

runAlphaNumString :: AlphaNumString -> String
runAlphaNumString (AlphaNumString s) = s

instance arbAlphaNumString :: Arbitrary AlphaNumString where
arbitrary = do
arrNum <- arbitrary
return $ AlphaNumString <<< fromCharArray $ lookup <$> arrNum
arbitrary = AlphaNumString <<< fromCharArray <$> arrayOf anyChar
where
chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
lookup x = let index = fromNumber $ x * (toNumber (length chars) - 1)
in charAt index chars

rest :: Array Char
rest = toCharArray "bcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"

anyChar :: Gen Char
anyChar = oneOf (pure 'a') (map pure rest)

instance coarbAlphaNumString :: Coarbitrary AlphaNumString where
coarbitrary (AlphaNumString s) = coarbitrary s
13 changes: 7 additions & 6 deletions src/Test/QuickCheck/Data/ApproxNumber.purs
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
module Test.QuickCheck.Data.ApproxNumber where

import Prelude

import Test.QuickCheck.Arbitrary

-- | A newtype for `Number` whose `Eq` instance uses an epsilon value to allow
Expand All @@ -19,24 +21,23 @@ instance coarbitraryApproxNumber :: Coarbitrary ApproxNumber where
coarbitrary (ApproxNumber n) = coarbitrary n

instance eqApproxNumber :: Eq ApproxNumber where
(==) (ApproxNumber x) (ApproxNumber y) = x =~= y
(/=) (ApproxNumber x) (ApproxNumber y) = not (x =~= y)
eq (ApproxNumber x) (ApproxNumber y) = x =~= y

instance ordApproxNumber :: Ord ApproxNumber where
compare (ApproxNumber x) (ApproxNumber y) = compare x y

instance semiringApproxNumber :: Semiring ApproxNumber where
(+) (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x + y)
add (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x + y)
zero = ApproxNumber zero
(*) (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x * y)
mul (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x * y)
one = ApproxNumber one

instance moduloSemiringApproxNumber :: ModuloSemiring ApproxNumber where
(/) (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x / y)
div (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x / y)
mod (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x `mod` y)

instance ringApproxNumber :: Ring ApproxNumber where
(-) (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x - y)
sub (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x - y)

instance divisionRingApproxNumber :: DivisionRing ApproxNumber
instance numApproxNumber :: Num ApproxNumber
12 changes: 12 additions & 0 deletions src/Test/QuickCheck/Gen.js
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
/* global exports */
"use strict";

// module Test.QuickCheck.Gen

exports.float32ToInt32 = function(n) {
var arr = new ArrayBuffer(4);
var fv = new Float32Array(arr);
var iv = new Int32Array(arr);
fv[0] = n;
return iv[0];
};
46 changes: 21 additions & 25 deletions src/Test/QuickCheck/Gen.purs
Original file line number Diff line number Diff line change
Expand Up @@ -26,15 +26,18 @@ module Test.QuickCheck.Gen
, showSample'
) where

import Prelude

import Console (CONSOLE(), print)
import Control.Monad.Eff (Eff())
import Data.Array ((!!), length, range)
import Data.Foldable (fold)
import Data.Int (Int(), fromNumber, toNumber)
import Data.Int (fromNumber, toNumber)
import Data.Maybe (fromMaybe)
import Data.Monoid.Additive (Additive(..), runAdditive)
import Data.Traversable (sequence)
import Data.Tuple (Tuple(..), fst, snd)
import Data.List (List(..))
import Test.QuickCheck.LCG
import qualified Math as M

Expand Down Expand Up @@ -86,44 +89,44 @@ chooseInt a b = fromNumber <$> choose (toNumber a) (toNumber b + 0.999999999)

-- | Create a random generator which selects and executes a random generator from
-- | a non-empty collection of random generators with uniform probability.
oneOf :: forall a. Gen a -> [Gen a] -> Gen a
oneOf :: forall a. Gen a -> Array (Gen a) -> Gen a
oneOf x xs = do
n <- chooseInt zero (length xs)
if n < one then x else fromMaybe x (xs !! (n - one))

-- | Create a random generator which selects and executes a random generator from
-- | a non-empty, weighted collection of random generators.
frequency :: forall a. Tuple Number (Gen a) -> [Tuple Number (Gen a)] -> Gen a
frequency :: forall a. Tuple Number (Gen a) -> List (Tuple Number (Gen a)) -> Gen a
frequency x xs = let
xxs = x : xs
total = runAdditive $ fold (((Additive <<< fst) <$> xxs) :: [Additive Number])
pick n d [] = d
pick n d ((Tuple k x) : xs) = if n <= k then x else pick (n - k) d xs
xxs = Cons x xs
total = runAdditive $ fold (map (Additive <<< fst) xxs :: List (Additive Number))
pick n d Nil = d
pick n d (Cons (Tuple k x) xs) = if n <= k then x else pick (n - k) d xs
in do
n <- choose 0 total
n <- choose zero total
pick n (snd x) xxs

-- | Create a random generator which generates an array of random values.
arrayOf :: forall a. Gen a -> Gen [a]
arrayOf :: forall a. Gen a -> Gen (Array a)
arrayOf g = sized $ \n ->
do k <- chooseInt zero n
vectorOf k g

-- | Create a random generator which generates a non-empty array of random values.
arrayOf1 :: forall a. Gen a -> Gen (Tuple a [a])
arrayOf1 :: forall a. Gen a -> Gen (Tuple a (Array a))
arrayOf1 g = sized $ \n ->
do k <- chooseInt zero n
x <- g
xs <- vectorOf (k - one) g
return $ Tuple x xs

-- | Create a random generator which generates a vector of random values of a specified size.
vectorOf :: forall a. Int -> Gen a -> Gen [a]
vectorOf :: forall a. Int -> Gen a -> Gen (Array a)
vectorOf k g = sequence $ const g <$> range one k

-- | Create a random generator which selects a value from a non-empty collection with
-- | uniform probability.
elements :: forall a. a -> [a] -> Gen a
elements :: forall a. a -> Array a -> Gen a
elements x xs = do
n <- chooseInt zero (length xs)
pure if n == zero then x else fromMaybe x (xs !! (n - one))
Expand All @@ -137,7 +140,7 @@ evalGen :: forall a. Gen a -> GenState -> a
evalGen gen st = (runGen gen st).value

-- | Sample a random generator
sample :: forall r a. Size -> Gen a -> [a]
sample :: forall r a. Size -> Gen a -> Array a
sample sz g = evalGen (vectorOf sz g) { newSeed: zero, size: sz }

-- | Print a random sample to the console
Expand All @@ -146,7 +149,7 @@ showSample' n g = print $ sample n g

-- | Print a random sample of 10 values to the console
showSample :: forall r a. (Show a) => Gen a -> Eff (console :: CONSOLE | r) Unit
showSample = showSample' (fromNumber 10)
showSample = showSample' 10

-- | A random generator which simply outputs the current seed
lcgStep :: Gen Int
Expand All @@ -157,25 +160,18 @@ lcgStep = Gen f where
uniform :: Gen Number
uniform = (\n -> toNumber n / toNumber lcgN) <$> lcgStep

foreign import float32ToInt32
"function float32ToInt32(n) {\
\ var arr = new ArrayBuffer(4);\
\ var fv = new Float32Array(arr);\
\ var iv = new Int32Array(arr);\
\ fv[0] = n;\
\ return iv[0];\
\}" :: Number -> Int
foreign import float32ToInt32 :: Number -> Int

-- | Perturb a random generator by modifying the current seed
perturbGen :: forall a. Number -> Gen a -> Gen a
perturbGen n (Gen f) = Gen $ \s -> f (s { newSeed = lcgNext (float32ToInt32 n) + s.newSeed })

instance functorGen :: Functor Gen where
(<$>) f (Gen g) = Gen $ \s -> case g s of
map f (Gen g) = Gen $ \s -> case g s of
{ value = value, state = state } -> { value: f value, state: state }

instance applyGen :: Apply Gen where
(<*>) (Gen f) (Gen x) = Gen $ \s ->
apply (Gen f) (Gen x) = Gen $ \s ->
case f s of
{ value = f', state = s' } -> case x s' of
{ value = x', state = s'' } -> { value: f' x', state: s'' }
Expand All @@ -184,7 +180,7 @@ instance applicativeGen :: Applicative Gen where
pure a = Gen (\s -> { value: a, state: s })

instance bindGen :: Bind Gen where
(>>=) (Gen f) g = Gen $ \s -> case f s of
bind (Gen f) g = Gen $ \s -> case f s of
{ value = value, state = state } -> runGen (g value) state

instance monadGen :: Monad Gen
Loading

0 comments on commit 14286c6

Please sign in to comment.