Statistics
| Branch: | Tag: | Revision:

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

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
  ]