From 2238176806afd69a0d24db069f0bce0a838e0a20 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Mon, 19 Nov 2012 10:46:50 +0100
Subject: [PATCH] Move the 'Hypervisor' type from Objects to Types
This is a very basic type and 'Objects' is a heavy-weight module. By
moving it to 'types' we simplify (in the future) the import chains.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Adeodato Simo <dato@google.com>
---
htest/Test/Ganeti/Objects.hs | 3 ---
htest/Test/Ganeti/Types.hs | 8 ++++++++
htools/Ganeti/Config.hs | 1 +
htools/Ganeti/Objects.hs | 14 --------------
htools/Ganeti/Rpc.hs | 1 +
htools/Ganeti/Types.hs | 12 ++++++++++++
6 files changed, 22 insertions(+), 17 deletions(-)
diff --git a/htest/Test/Ganeti/Objects.hs b/htest/Test/Ganeti/Objects.hs
index de21d0c15..aa4e16a0c 100644
--- a/htest/Test/Ganeti/Objects.hs
+++ b/htest/Test/Ganeti/Objects.hs
@@ -28,7 +28,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.Objects
( testObjects
- , Hypervisor(..)
, Node(..)
, genEmptyCluster
) where
@@ -51,8 +50,6 @@ import Ganeti.JSON
-- * Arbitrary instances
-$(genArbitrary ''Hypervisor)
-
$(genArbitrary ''PartialNDParams)
instance Arbitrary Node where
diff --git a/htest/Test/Ganeti/Types.hs b/htest/Test/Ganeti/Types.hs
index f0ba40a61..d3dbd6996 100644
--- a/htest/Test/Ganeti/Types.hs
+++ b/htest/Test/Ganeti/Types.hs
@@ -32,6 +32,7 @@ module Test.Ganeti.Types
, DiskTemplate(..)
, InstanceStatus(..)
, NonEmpty(..)
+ , Hypervisor(..)
) where
import Data.List (sort)
@@ -69,6 +70,8 @@ $(genArbitrary ''DdmSimple)
$(genArbitrary ''CVErrorCode)
+$(genArbitrary ''Hypervisor)
+
instance (Arbitrary a) => Arbitrary (Types.NonEmpty a) where
arbitrary = do
QuickCheck.NonEmpty lst <- arbitrary
@@ -151,6 +154,10 @@ case_CVErrorCode_pyequiv = do
all_hs_codes = sort $ map Types.cVErrorCodeToRaw [minBound..maxBound]
assertEqual "for CVErrorCode equivalence" all_py_codes all_hs_codes
+-- | Test 'Hypervisor' serialisation.
+prop_Hypervisor_serialisation :: Hypervisor -> Property
+prop_Hypervisor_serialisation = testSerialisation
+
testSuite "Types"
[ 'prop_AllocPolicy_serialisation
, 'prop_DiskTemplate_serialisation
@@ -166,4 +173,5 @@ testSuite "Types"
, 'prop_DdmSimple_serialisation
, 'prop_CVErrorCode_serialisation
, 'case_CVErrorCode_pyequiv
+ , 'prop_Hypervisor_serialisation
]
diff --git a/htools/Ganeti/Config.hs b/htools/Ganeti/Config.hs
index c2c692905..2561cb000 100644
--- a/htools/Ganeti/Config.hs
+++ b/htools/Ganeti/Config.hs
@@ -59,6 +59,7 @@ import qualified Ganeti.Constants as C
import Ganeti.Errors
import Ganeti.JSON
import Ganeti.Objects
+import Ganeti.Types
-- | Type alias for the link and ip map.
type LinkIpMap = M.Map String (M.Map String String)
diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs
index 021f9ed22..1b98db35d 100644
--- a/htools/Ganeti/Objects.hs
+++ b/htools/Ganeti/Objects.hs
@@ -50,7 +50,6 @@ module Ganeti.Objects
, FilledBeParams(..)
, fillBeParams
, allBeParamFields
- , Hypervisor(..)
, AdminState(..)
, adminStateFromRaw
, Instance(..)
@@ -329,19 +328,6 @@ $(buildObjectSerialisation "Disk"
, defaultField [| DiskRdWr |] $ simpleField "mode" [t| DiskMode |]
])
--- * Hypervisor definitions
-
--- | This may be due to change when we add hypervisor parameters.
-$(declareSADT "Hypervisor"
- [ ( "Kvm", 'C.htKvm )
- , ( "XenPvm", 'C.htXenPvm )
- , ( "Chroot", 'C.htChroot )
- , ( "XenHvm", 'C.htXenHvm )
- , ( "Lxc", 'C.htLxc )
- , ( "Fake", 'C.htFake )
- ])
-$(makeJSONInstance ''Hypervisor)
-
-- * Instance definitions
$(declareSADT "AdminState"
diff --git a/htools/Ganeti/Rpc.hs b/htools/Ganeti/Rpc.hs
index f328b0e0c..d20d4c0ca 100644
--- a/htools/Ganeti/Rpc.hs
+++ b/htools/Ganeti/Rpc.hs
@@ -82,6 +82,7 @@ import qualified Ganeti.Path as P
import qualified Ganeti.Constants as C
import Ganeti.Objects
import Ganeti.THH
+import Ganeti.Types
import Ganeti.Compat
-- * Base RPC functionality and types
diff --git a/htools/Ganeti/Types.hs b/htools/Ganeti/Types.hs
index 99eceae14..786955108 100644
--- a/htools/Ganeti/Types.hs
+++ b/htools/Ganeti/Types.hs
@@ -54,6 +54,7 @@ module Ganeti.Types
, DdmSimple(..)
, CVErrorCode(..)
, cVErrorCodeToRaw
+ , Hypervisor(..)
) where
import qualified Text.JSON as JSON
@@ -206,3 +207,14 @@ $(THH.declareSADT "DdmSimple"
, ("DdmSimpleRemove", 'C.ddmRemove)
])
$(THH.makeJSONInstance ''DdmSimple)
+
+-- | Hypervisor type definitions.
+$(THH.declareSADT "Hypervisor"
+ [ ( "Kvm", 'C.htKvm )
+ , ( "XenPvm", 'C.htXenPvm )
+ , ( "Chroot", 'C.htChroot )
+ , ( "XenHvm", 'C.htXenHvm )
+ , ( "Lxc", 'C.htLxc )
+ , ( "Fake", 'C.htFake )
+ ])
+$(THH.makeJSONInstance ''Hypervisor)
--
GitLab