root / test / hs / Test / Ganeti / BasicTypes.hs @ 896cc964
History | View | Annotate | Download (5.1 kB)
1 |
{-# LANGUAGE TemplateHaskell, FlexibleInstances, TypeSynonymInstances #-} |
---|---|
2 |
{-# OPTIONS_GHC -fno-warn-orphans #-} |
3 |
|
4 |
{-| Unittests for ganeti-htools. |
5 |
|
6 |
-} |
7 |
|
8 |
{- |
9 |
|
10 |
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc. |
11 |
|
12 |
This program is free software; you can redistribute it and/or modify |
13 |
it under the terms of the GNU General Public License as published by |
14 |
the Free Software Foundation; either version 2 of the License, or |
15 |
(at your option) any later version. |
16 |
|
17 |
This program is distributed in the hope that it will be useful, but |
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
20 |
General Public License for more details. |
21 |
|
22 |
You should have received a copy of the GNU General Public License |
23 |
along with this program; if not, write to the Free Software |
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
25 |
02110-1301, USA. |
26 |
|
27 |
-} |
28 |
|
29 |
module Test.Ganeti.BasicTypes (testBasicTypes) where |
30 |
|
31 |
import Test.QuickCheck hiding (Result) |
32 |
import Test.QuickCheck.Function |
33 |
|
34 |
import Control.Applicative |
35 |
import Control.Monad |
36 |
|
37 |
import Test.Ganeti.TestHelper |
38 |
import Test.Ganeti.TestCommon |
39 |
|
40 |
import Ganeti.BasicTypes |
41 |
|
42 |
-- Since we actually want to test these, don't tell us not to use them :) |
43 |
|
44 |
{-# ANN module "HLint: ignore Functor law" #-} |
45 |
{-# ANN module "HLint: ignore Monad law, left identity" #-} |
46 |
{-# ANN module "HLint: ignore Monad law, right identity" #-} |
47 |
{-# ANN module "HLint: ignore Use >=>" #-} |
48 |
{-# ANN module "HLint: ignore Use ." #-} |
49 |
|
50 |
-- * Arbitrary instances |
51 |
|
52 |
instance (Arbitrary a) => Arbitrary (Result a) where |
53 |
arbitrary = oneof [ Bad <$> arbitrary |
54 |
, Ok <$> arbitrary |
55 |
] |
56 |
|
57 |
-- * Test cases |
58 |
|
59 |
-- | Tests the functor identity law: |
60 |
-- |
61 |
-- > fmap id == id |
62 |
prop_functor_id :: Result Int -> Property |
63 |
prop_functor_id ri = |
64 |
fmap id ri ==? ri |
65 |
|
66 |
-- | Tests the functor composition law: |
67 |
-- |
68 |
-- > fmap (f . g) == fmap f . fmap g |
69 |
prop_functor_composition :: Result Int |
70 |
-> Fun Int Int -> Fun Int Int -> Property |
71 |
prop_functor_composition ri (Fun _ f) (Fun _ g) = |
72 |
fmap (f . g) ri ==? (fmap f . fmap g) ri |
73 |
|
74 |
-- | Tests the applicative identity law: |
75 |
-- |
76 |
-- > pure id <*> v = v |
77 |
prop_applicative_identity :: Result Int -> Property |
78 |
prop_applicative_identity v = |
79 |
pure id <*> v ==? v |
80 |
|
81 |
-- | Tests the applicative composition law: |
82 |
-- |
83 |
-- > pure (.) <*> u <*> v <*> w = u <*> (v <*> w) |
84 |
prop_applicative_composition :: Result (Fun Int Int) |
85 |
-> Result (Fun Int Int) |
86 |
-> Result Int |
87 |
-> Property |
88 |
prop_applicative_composition u v w = |
89 |
let u' = fmap apply u |
90 |
v' = fmap apply v |
91 |
in pure (.) <*> u' <*> v' <*> w ==? u' <*> (v' <*> w) |
92 |
|
93 |
-- | Tests the applicative homomorphism law: |
94 |
-- |
95 |
-- > pure f <*> pure x = pure (f x) |
96 |
prop_applicative_homomorphism :: Fun Int Int -> Int -> Property |
97 |
prop_applicative_homomorphism (Fun _ f) x = |
98 |
((pure f <*> pure x)::Result Int) ==? pure (f x) |
99 |
|
100 |
-- | Tests the applicative interchange law: |
101 |
-- |
102 |
-- > u <*> pure y = pure ($ y) <*> u |
103 |
prop_applicative_interchange :: Result (Fun Int Int) |
104 |
-> Int -> Property |
105 |
prop_applicative_interchange f y = |
106 |
let u = fmap apply f -- need to extract the actual function from Fun |
107 |
in u <*> pure y ==? pure ($ y) <*> u |
108 |
|
109 |
-- | Tests the applicative\/functor correspondence: |
110 |
-- |
111 |
-- > fmap f x = pure f <*> x |
112 |
prop_applicative_functor :: Fun Int Int -> Result Int -> Property |
113 |
prop_applicative_functor (Fun _ f) x = |
114 |
fmap f x ==? pure f <*> x |
115 |
|
116 |
-- | Tests the applicative\/monad correspondence: |
117 |
-- |
118 |
-- > pure = return |
119 |
-- |
120 |
-- > (<*>) = ap |
121 |
prop_applicative_monad :: Int -> Result (Fun Int Int) -> Property |
122 |
prop_applicative_monad v f = |
123 |
let v' = pure v :: Result Int |
124 |
f' = fmap apply f -- need to extract the actual function from Fun |
125 |
in v' ==? return v .&&. (f' <*> v') ==? f' `ap` v' |
126 |
|
127 |
-- | Tests the monad laws: |
128 |
-- |
129 |
-- > return a >>= k == k a |
130 |
-- |
131 |
-- > m >>= return == m |
132 |
-- |
133 |
-- > m >>= (\x -> k x >>= h) == (m >>= k) >>= h |
134 |
prop_monad_laws :: Int -> Result Int |
135 |
-> Fun Int (Result Int) |
136 |
-> Fun Int (Result Int) |
137 |
-> Property |
138 |
prop_monad_laws a m (Fun _ k) (Fun _ h) = |
139 |
conjoin |
140 |
[ printTestCase "return a >>= k == k a" ((return a >>= k) ==? k a) |
141 |
, printTestCase "m >>= return == m" ((m >>= return) ==? m) |
142 |
, printTestCase "m >>= (\\x -> k x >>= h) == (m >>= k) >>= h)" |
143 |
((m >>= (\x -> k x >>= h)) ==? ((m >>= k) >>= h)) |
144 |
] |
145 |
|
146 |
-- | Tests the monad plus laws: |
147 |
-- |
148 |
-- > mzero >>= f = mzero |
149 |
-- |
150 |
-- > v >> mzero = mzero |
151 |
prop_monadplus_mzero :: Result Int -> Fun Int (Result Int) -> Property |
152 |
prop_monadplus_mzero v (Fun _ f) = |
153 |
printTestCase "mzero >>= f = mzero" ((mzero >>= f) ==? mzero) .&&. |
154 |
-- FIXME: since we have "many" mzeros, we can't test for equality, |
155 |
-- just that we got back a 'Bad' value; I'm not sure if this means |
156 |
-- our MonadPlus instance is not sound or not... |
157 |
printTestCase "v >> mzero = mzero" (isBad (v >> mzero)) |
158 |
|
159 |
testSuite "BasicTypes" |
160 |
[ 'prop_functor_id |
161 |
, 'prop_functor_composition |
162 |
, 'prop_applicative_identity |
163 |
, 'prop_applicative_composition |
164 |
, 'prop_applicative_homomorphism |
165 |
, 'prop_applicative_interchange |
166 |
, 'prop_applicative_functor |
167 |
, 'prop_applicative_monad |
168 |
, 'prop_monad_laws |
169 |
, 'prop_monadplus_mzero |
170 |
] |