Statistics
| Branch: | Tag: | Revision:

root / test / hs / Test / Ganeti / BasicTypes.hs @ 4e4433e8

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
  ]