## root / test / hs / Test / Ganeti / BasicTypes.hs @ 14933c17

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 |
] |