From d5a93a8002fbe1deb2bfd15cc38f7bf6efed59b3 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Tue, 14 Aug 2012 23:22:24 +0200
Subject: [PATCH] Remove container field special cases
Since we now handle Containers uniformly, we can remove all traces of
the special handling for this field type.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Agata Murawska <agatamurawska@google.com>
---
htools/Ganeti/Objects.hs | 14 +++++++-------
htools/Ganeti/THH.hs | 19 ++-----------------
2 files changed, 9 insertions(+), 24 deletions(-)
diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs
index e9d0acd4a..f4e0798a0 100644
--- a/htools/Ganeti/Objects.hs
+++ b/htools/Ganeti/Objects.hs
@@ -357,9 +357,9 @@ $(buildObject "Cluster" "cluster" $
, simpleField "enabled_hypervisors" [t| [String] |]
-- , simpleField "hvparams" [t| [(String, [(String, String)])] |]
-- , simpleField "os_hvp" [t| [(String, String)] |]
- , containerField $ simpleField "beparams" [t| FilledBEParams |]
+ , simpleField "beparams" [t| Container FilledBEParams |]
-- , simpleField "osparams" [t| [(String, String)] |]
- , containerField $ simpleField "nicparams" [t| FilledNICParams |]
+ , simpleField "nicparams" [t| Container FilledNICParams |]
-- , simpleField "ndparams" [t| FilledNDParams |]
, simpleField "candidate_pool_size" [t| Int |]
, simpleField "modify_etc_hosts" [t| Bool |]
@@ -381,10 +381,10 @@ $(buildObject "Cluster" "cluster" $
$(buildObject "ConfigData" "config" $
-- timeStampFields ++
- [ simpleField "version" [t| Int |]
- , simpleField "cluster" [t| Cluster |]
- , containerField $ simpleField "nodes" [t| Node |]
- , containerField $ simpleField "nodegroups" [t| NodeGroup |]
- , containerField $ simpleField "instances" [t| Instance |]
+ [ simpleField "version" [t| Int |]
+ , simpleField "cluster" [t| Cluster |]
+ , simpleField "nodes" [t| Container Node |]
+ , simpleField "nodegroups" [t| Container NodeGroup |]
+ , simpleField "instances" [t| Container Instance |]
]
++ serialFields)
diff --git a/htools/Ganeti/THH.hs b/htools/Ganeti/THH.hs
index 6ff37e05c..291228f0a 100644
--- a/htools/Ganeti/THH.hs
+++ b/htools/Ganeti/THH.hs
@@ -42,7 +42,6 @@ module Ganeti.THH ( declareSADT
, defaultField
, optionalField
, renameField
- , containerField
, customField
, timeStampFields
, uuidFields
@@ -51,7 +50,6 @@ module Ganeti.THH ( declareSADT
, buildObject
, buildObjectSerialisation
, buildParam
- , Container
) where
import Control.Monad (liftM, liftM2)
@@ -62,8 +60,6 @@ import Language.Haskell.TH
import qualified Text.JSON as JSON
-import Ganeti.HTools.JSON
-
-- * Exported types
-- | Serialised field data type.
@@ -73,7 +69,6 @@ data Field = Field { fieldName :: String
, fieldShow :: Maybe (Q Exp)
, fieldDefault :: Maybe (Q Exp)
, fieldConstr :: Maybe String
- , fieldIsContainer :: Bool
, fieldIsOptional :: Bool
}
@@ -86,7 +81,6 @@ simpleField fname ftype =
, fieldShow = Nothing
, fieldDefault = Nothing
, fieldConstr = Nothing
- , fieldIsContainer = False
, fieldIsOptional = False
}
@@ -103,10 +97,6 @@ defaultField defval field = field { fieldDefault = Just defval }
optionalField :: Field -> Field
optionalField field = field { fieldIsOptional = True }
--- | Marks a field as a container.
-containerField :: Field -> Field
-containerField field = field { fieldIsContainer = True }
-
-- | Sets custom functions on a field.
customField :: Name -- ^ The name of the read function
-> Name -- ^ The name of the show function
@@ -130,8 +120,7 @@ fieldVariable f =
_ -> map (\c -> if c == '-' then '_' else c) $ fieldName f
actualFieldType :: Field -> Q Type
-actualFieldType f | fieldIsContainer f = [t| Container $t |]
- | fieldIsOptional f = [t| Maybe $t |]
+actualFieldType f | fieldIsOptional f = [t| Maybe $t |]
| otherwise = t
where t = fieldType f
@@ -150,8 +139,6 @@ loadFn :: Field -- ^ The field definition
-> Q Exp -- ^ The value of the field as existing in the JSON message
-> Q Exp -- ^ The entire object in JSON object format
-> Q Exp -- ^ Resulting expression
-loadFn (Field { fieldIsContainer = True }) expr _ =
- [| $expr |]
loadFn (Field { fieldRead = Just readfn }) expr o = [| $expr >>= $readfn $o |]
loadFn _ expr _ = expr
@@ -623,7 +610,6 @@ genSaveObject save_fn sname fields = do
saveObjectField :: Name -> Field -> Q Exp
saveObjectField fvar field
- | isContainer = [| [( $nameE , JSON.showJSON $fvarE)] |]
| fisOptional = [| case $(varE fvar) of
Nothing -> []
Just v -> [( $nameE, JSON.showJSON v)]
@@ -633,8 +619,7 @@ saveObjectField fvar field
Just fn -> [| let (actual, extra) = $fn $fvarE
in extra ++ [( $nameE, JSON.showJSON actual)]
|]
- where isContainer = fieldIsContainer field
- fisOptional = fieldIsOptional field
+ where fisOptional = fieldIsOptional field
nameE = stringE (fieldName field)
fvarE = varE fvar
--
GitLab