Merge branch 'lcg'

Conflicts:
	.gitignore

Author: paf31

.gitignore

@@ -1,6 +1,7 @@
 /.*
 !/.gitignore
-/bower_components/
-/node_modules/
 /output/
+/node_modules/
+/bower_components/
 /tmp/
+/node_modules/

README.md

@@ -1,4 +1,111 @@
-purescript-quickcheck
-=====================
+# Module Documentation
 
-A very basic implementation of QuickCheck in PureScript
+## Module Test.QuickCheck
+
+### Types
+
+    type QC a = forall eff. Eff (err :: Exception Prim.String, random :: Random, trace :: Trace | eff) a
+
+    data Result  where
+      Success :: Result 
+      Failed :: Prim.String -> Result 
+
+
+### Type Classes
+
+    class Arbitrary t where
+      arbitrary :: Gen t
+
+    class CoArbitrary t where
+      coarbitrary :: forall r. t -> Gen r -> Gen r
+
+    class Testable prop where
+      test :: prop -> Gen Result
+
+
+### Type Class Instances
+
+    instance arbArray :: (Arbitrary a) => Arbitrary [a]
+
+    instance arbBoolean :: Arbitrary Prim.Boolean
+
+    instance arbFunction :: (CoArbitrary a, Arbitrary b) => Arbitrary (a -> b)
+
+    instance arbNumber :: Arbitrary Prim.Number
+
+    instance coarbArray :: (CoArbitrary a) => CoArbitrary [a]
+
+    instance coarbBoolean :: CoArbitrary Prim.Boolean
+
+    instance coarbFunction :: (Arbitrary a, CoArbitrary b) => CoArbitrary (a -> b)
+
+    instance coarbNumber :: CoArbitrary Prim.Number
+
+    instance showResult :: Show Result
+
+    instance testableBoolean :: Testable Prim.Boolean
+
+    instance testableFunction :: (Arbitrary t, Testable prop) => Testable (t -> prop)
+
+    instance testableResult :: Testable Result
+
+
+### Values
+
+    (<?>) :: Prim.Boolean -> Prim.String -> Result
+
+    quickCheck :: forall prop. (Testable prop) => prop -> QC {  }
+
+    quickCheck' :: forall prop. (Testable prop) => Prim.Number -> prop -> QC {  }
+
+    quickCheckPure :: forall prop. (Testable prop) => Prim.Number -> Prim.Number -> prop -> [Result]
+
+    repeatable :: forall a b. (a -> Gen b) -> Gen (a -> b)
+
+
+## Module Test.QuickCheck.LCG
+
+### Types
+
+    data Gen a where
+      Gen :: LCG -> { newSeed :: LCG, value :: a } -> Gen a
+
+    type LCG  = Prim.Number
+
+
+### Type Class Instances
+
+    instance applicativeGen :: Applicative Gen
+
+    instance applyGen :: Apply Gen
+
+    instance bindGen :: Bind Gen
+
+    instance functorGen :: Functor Gen
+
+    instance monadGen :: Monad Gen
+
+
+### Values
+
+    evalGen :: forall a. Gen a -> LCG -> a
+
+    float32ToInt32 :: Prim.Number -> Prim.Number
+
+    lcgC :: Prim.Number
+
+    lcgM :: Prim.Number
+
+    lcgN :: Prim.Number
+
+    lcgNext :: Prim.Number -> Prim.Number
+
+    lcgStep :: Gen Prim.Number
+
+    perturbGen :: forall a. Prim.Number -> Gen a -> Gen a
+
+    randomSeed :: forall eff. Eff (random :: Random | eff) Prim.Number
+
+    runGen :: forall a. Gen a -> LCG -> { newSeed :: LCG, value :: a }
+
+    uniform :: Gen Prim.Number

bower.json

@@ -14,11 +14,6 @@
   ],
   "dependencies": {
     "purescript-random": "*",
-    "purescript-arrays": "*",
-    "purescript-maybe": "*",
-    "purescript-either": "*",
-    "purescript-tuples": "*",
-    "purescript-exceptions": "*",
-    "purescript-strings": "*"
+    "purescript-exceptions": "*"
   }
 }

examples/Prelude.purs

@@ -8,13 +8,23 @@ import Test.QuickCheck
 testConst :: Number -> Number -> Number -> Boolean
 testConst a b c = const a b == const a c
 
+mkMessage :: (Number -> Number) -> String
+mkMessage f = "Test failed for function (" 
+  ++ show (f 0) ++ ", " 
+  ++ show (f 1) ++ ", " 
+  ++ show (f 2) ++ ")"
+
 main = do
   Debug.Trace.trace "testConst:"
   quickCheck testConst
 
+  Debug.Trace.trace "id is a left unit for <<<"
+  quickCheck $ \f a -> ((id <<< f) (a :: Number) == (f a) :: Number) <?> mkMessage f
+
   Debug.Trace.trace "Precedence of && and ||:"
   quickCheck $ \a b c -> ((a :: Boolean && b) || c) == ((a || c) && (b || c))
 
   Debug.Trace.trace "Test Eq instance for Ref:"
   quickCheck $ \a -> (Ref a :: Ref Number) == Ref a
   quickCheck $ \a -> not $ (Ref a :: Ref Number /= Ref a)
+

src/Test/QuickCheck.purs

@@ -1,53 +1,71 @@
 module Test.QuickCheck where
 
-import Prelude
-import Data.Array
-import Data.Maybe
-import Data.Either
-import Data.Tuple
 import Debug.Trace
 import Control.Monad.Eff
-import Control.Monad.Eff.Exception
 import Control.Monad.Eff.Random
+import Control.Monad.Eff.Exception
+
+import Test.QuickCheck.LCG
+
+class Arbitrary t where
+  arbitrary :: Gen t
+
+class CoArbitrary t where
+  coarbitrary :: forall r. t -> Gen r -> Gen r
 
 data Result = Success | Failed String
 
-type QC = forall eff. Eff (random :: Random, trace :: Trace, err :: Exception String | eff) {}
+instance showResult :: Show Result where
+  show Success = "Success"
+  show (Failed msg) = "Failed: " ++ msg
 
-class (Show t) <= Arb t where
-  arb :: forall eff. Eff (random :: Random | eff) t
+(<?>) :: Boolean -> String -> Result
+(<?>) true _ = Success
+(<?>) false msg = Failed msg
 
-instance arbNumber :: Arb Number where
-  arb = random 
+instance arbNumber :: Arbitrary Number where
+  arbitrary = uniform 
 
-instance arbBoolean :: Arb Boolean where
-  arb = do
-    n <- random
-    return ((n * 2) < 1)
+instance coarbNumber :: CoArbitrary Number where
+  coarbitrary = perturbGen  
 
-instance arbArray :: (Arb a) => Arb [a] where
-  arb = do
-    b <- arb
-    if b then return [] else do
-      a <- arb
-      as <- arb
-      return (a : as)
+instance arbBoolean :: Arbitrary Boolean where
+  arbitrary = do
+    n <- uniform
+    return $ (n * 2) < 1
+
+instance coarbBoolean :: CoArbitrary Boolean where
+  coarbitrary true (Gen f) = Gen $ \l -> f (l + 1)
+  coarbitrary false (Gen f) = Gen $ \l -> f (l + 2)
 
-instance arbMaybe :: (Arb a) => Arb (Maybe a) where
-  arb = do
-    b <- arb
-    if b then pure Nothing else Just <$> arb
+instance arbFunction :: (CoArbitrary a, Arbitrary b) => Arbitrary (a -> b) where
+  arbitrary = repeatable (\a -> coarbitrary a arbitrary)
 
-instance arbEither :: (Arb a, Arb b) => Arb (Either a b) where
-  arb = do
-    b <- arb
-    if b then Left <$> arb else Right <$> arb
+repeatable :: forall a b. (a -> Gen b) -> Gen (a -> b)
+repeatable f = Gen $ \l -> { value: \a -> (runGen (f a) l).value, newSeed: l }
 
-instance arbTuple :: (Arb a, Arb b) => Arb (Tuple a b) where
-  arb = Tuple <$> arb <*> arb
+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
+    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
 
 class Testable prop where
-  test :: forall eff. prop -> Eff (random :: Random | eff) Result
+  test :: prop -> Gen Result
 
 instance testableResult :: Testable Result where
   test = return
@@ -56,24 +74,41 @@ instance testableBoolean :: Testable Boolean where
   test true = return Success
   test false = return $ Failed "Test returned false"
 
-instance testableFunction :: (Show t, Arb t, Testable prop) => Testable (t -> prop) where
+instance testableFunction :: (Arbitrary t, Testable prop) => Testable (t -> prop) where
   test f = do
-    t <- arb
-    result <- test (f t)
-    case result of
-      Success -> return Success
-      Failed msg -> return $ Failed $ "Failed on input " ++ show t ++ ": \n" ++ msg
-
-quickCheck' :: forall prop. (Testable prop) => Number -> prop -> QC
-quickCheck' n prop = run 1 prop n
+    t <- arbitrary
+    test (f t)
+
+quickCheckPure :: forall prop. (Testable prop) => Number -> Number -> prop -> [Result]
+quickCheckPure seed n prop = evalGen (go n) seed
   where
-  run 2 _ 1 = trace $ "Test passed" 
-  run n _ t | n > t = trace $ show t ++ " tests passed" 
-  run n prop t = do
+  go n | n <= 0 = return []
+  go n = do
     result <- test prop
-    case result of
-      Success -> run (n + 1) prop t
-      Failed msg -> throwException $ "Test " ++ show n ++ " failed: \n" ++ msg
+    rest <- go (n - 1)
+    return $ result : rest
+
+type QC a = forall eff. Eff (trace :: Trace, random :: Random, err :: Exception String | eff) a
+
+quickCheck' :: forall prop. (Testable prop) => Number -> prop -> QC {}
+quickCheck' n prop = do
+  seed <- randomSeed
+  let results = quickCheckPure seed n prop
+  let successes = countSuccesses results
+  trace $ show successes ++ "/" ++ show n ++ " test(s) passed."
+  throwOnFirstFailure 1 results
+
+  where
+
+  throwOnFirstFailure :: Number -> [Result] -> QC {}
+  throwOnFirstFailure _ [] = return {}
+  throwOnFirstFailure n (Failed msg : _) = throwException $ "Test " ++ show n ++ " failed: \n" ++ msg
+  throwOnFirstFailure n (_ : rest) = throwOnFirstFailure (n + 1) rest
+
+  countSuccesses :: [Result] -> Number
+  countSuccesses [] = 0
+  countSuccesses (Success : rest) = 1 + countSuccesses rest
+  countSuccesses (_ : rest) = countSuccesses rest
 
-quickCheck :: forall prop. (Testable prop) => prop -> QC
+quickCheck :: forall prop. (Testable prop) => prop -> QC {}
 quickCheck prop = quickCheck' 100 prop