|
1 | | -module PreludeTests where |
| 1 | +module Main where |
2 | 2 |
|
3 | 3 | import Control.Monad.Eff |
4 | 4 | import Data.Eq |
5 | 5 | import Debug.Trace |
6 | 6 | 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 |
15 | 7 |
|
16 | | -between :: forall a. (Ord a) => a -> a -> a -> Boolean |
17 | | -between min max = \n -> n >= min && n <= max |
| 8 | +testConst :: Number -> Number -> Number -> Boolean |
| 9 | +testConst a b c = const a b == const a c |
18 | 10 |
|
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] |
| 11 | +mkMessage :: (Number -> Number) -> String |
| 12 | +mkMessage f = "Test failed for function (" |
| 13 | + ++ show (f 0) ++ ", " |
| 14 | + ++ show (f 1) ++ ", " |
| 15 | + ++ show (f 2) ++ ")" |
116 | 16 |
|
117 | 17 | main = do |
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 |
| 18 | + Debug.Trace.trace "testConst:" |
| 19 | + quickCheck testConst |
123 | 20 |
|
124 | | - trace "smallCheck" |
125 | | - smallCheck $ runDetABC >>> (flip elem ["A", "B", "C"]) |
| 21 | + Debug.Trace.trace "id is a left unit for <<<" |
| 22 | + quickCheck $ \f a -> ((id <<< f) (a :: Number) == (f a) :: Number) <?> mkMessage f |
126 | 23 |
|
127 | | - trace "Fair distribution of booleans" |
128 | | - statCheck (1/2) $ (==) true |
| 24 | + Debug.Trace.trace "Precedence of && and ||:" |
| 25 | + quickCheck $ \a b c -> ((a :: Boolean && b) || c) == ((a || c) && (b || c)) |
129 | 26 |
|
130 | | - trace "Fair distribution of ints" |
131 | | - statCheck (1/11) $ runOneToTen >>> ((==) 1) |
| 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) |
132 | 30 |
|
0 commit comments