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