1 {-# LANGUAGE TemplateHaskell, FlexibleInstances, TypeSynonymInstances #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
4 {-| Unittests for ganeti-htools.
10 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
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.
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.
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
29 module Test.Ganeti.BasicTypes (testBasicTypes) where
31 import Test.QuickCheck hiding (Result)
32 import Test.QuickCheck.Function
34 import Control.Applicative
37 import Test.Ganeti.TestHelper
38 import Test.Ganeti.TestCommon
40 import Ganeti.BasicTypes
42 -- Since we actually want to test these, don't tell us not to use them :)
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 ." #-}
50 -- * Arbitrary instances
52 instance (Arbitrary a) => Arbitrary (Result a) where
53 arbitrary = oneof [ Bad <$> arbitrary
59 -- | Tests the functor identity law (fmap id == id).
60 prop_functor_id :: Result Int -> Property
64 -- | Tests the functor composition law (fmap (f . g) == fmap f . fmap g).
65 prop_functor_composition :: Result Int
66 -> Fun Int Int -> Fun Int Int -> Property
67 prop_functor_composition ri (Fun _ f) (Fun _ g) =
68 fmap (f . g) ri ==? (fmap f . fmap g) ri
70 -- | Tests the applicative identity law (pure id <*> v = v).
71 prop_applicative_identity :: Result Int -> Property
72 prop_applicative_identity v =
75 -- | Tests the applicative composition law (pure (.) <*> u <*> v <*> w
76 -- = u <*> (v <*> w)).
77 prop_applicative_composition :: Result (Fun Int Int)
78 -> Result (Fun Int Int)
81 prop_applicative_composition u v w =
84 in pure (.) <*> u' <*> v' <*> w ==? u' <*> (v' <*> w)
86 -- | Tests the applicative homomorphism law (pure f <*> pure x = pure (f x)).
87 prop_applicative_homomorphism :: Fun Int Int -> Int -> Property
88 prop_applicative_homomorphism (Fun _ f) x =
89 ((pure f <*> pure x)::Result Int) ==? pure (f x)
91 -- | Tests the applicative interchange law (u <*> pure y = pure ($ y) <*> u).
92 prop_applicative_interchange :: Result (Fun Int Int)
94 prop_applicative_interchange f y =
95 let u = fmap apply f -- need to extract the actual function from Fun
96 in u <*> pure y ==? pure ($ y) <*> u
98 -- | Tests the applicative\/functor correspondence (fmap f x = pure f <*> x).
99 prop_applicative_functor :: Fun Int Int -> Result Int -> Property
100 prop_applicative_functor (Fun _ f) x =
101 fmap f x ==? pure f <*> x
103 -- | Tests the applicative\/monad correspondence (pure = return and
105 prop_applicative_monad :: Int -> Result (Fun Int Int) -> Property
106 prop_applicative_monad v f =
107 let v' = pure v :: Result Int
108 f' = fmap apply f -- need to extract the actual function from Fun
109 in v' ==? return v .&&. (f' <*> v') ==? f' `ap` v'
111 -- | Tests the monad laws (return a >>= k == k a, m >>= return == m, m
112 -- >>= (\x -> k x >>= h) == (m >>= k) >>= h).
113 prop_monad_laws :: Int -> Result Int
114 -> Fun Int (Result Int)
115 -> Fun Int (Result Int)
117 prop_monad_laws a m (Fun _ k) (Fun _ h) =
119 [ printTestCase "return a >>= k == k a" ((return a >>= k) ==? k a)
120 , printTestCase "m >>= return == m" ((m >>= return) ==? m)
121 , printTestCase "m >>= (\\x -> k x >>= h) == (m >>= k) >>= h)"
122 ((m >>= (\x -> k x >>= h)) ==? ((m >>= k) >>= h))
125 -- | Tests the monad plus laws ( mzero >>= f = mzero, v >> mzero = mzero).
126 prop_monadplus_mzero :: Result Int -> Fun Int (Result Int) -> Property
127 prop_monadplus_mzero v (Fun _ f) =
128 printTestCase "mzero >>= f = mzero" ((mzero >>= f) ==? mzero) .&&.
129 -- FIXME: since we have "many" mzeros, we can't test for equality,
130 -- just that we got back a 'Bad' value; I'm not sure if this means
131 -- our MonadPlus instance is not sound or not...
132 printTestCase "v >> mzero = mzero" (isBad (v >> mzero))
134 testSuite "BasicTypes"
136 , 'prop_functor_composition
137 , 'prop_applicative_identity
138 , 'prop_applicative_composition
139 , 'prop_applicative_homomorphism
140 , 'prop_applicative_interchange
141 , 'prop_applicative_functor
142 , 'prop_applicative_monad
144 , 'prop_monadplus_mzero