From 02cccecd04877e81b5073a2599de0ac0bbd97454 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Tue, 14 Aug 2012 22:43:40 +0200
Subject: [PATCH] Expand TH with tags field
Also add this new field and the other generic fields to the cluster
object.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Agata Murawska <agatamurawska@google.com>
---
htools/Ganeti/Objects.hs | 5 ++++-
htools/Ganeti/THH.hs | 7 +++++++
2 files changed, 11 insertions(+), 1 deletion(-)
diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs
index 027280183..e9d0acd4a 100644
--- a/htools/Ganeti/Objects.hs
+++ b/htools/Ganeti/Objects.hs
@@ -372,7 +372,10 @@ $(buildObject "Cluster" "cluster" $
, simpleField "primary_ip_family" [t| Int |]
, simpleField "prealloc_wipe_disks" [t| Bool |]
]
- ++ serialFields)
+ ++ serialFields
+ ++ timeStampFields
+ ++ uuidFields
+ ++ tagsFields)
-- * ConfigData definitions
diff --git a/htools/Ganeti/THH.hs b/htools/Ganeti/THH.hs
index 929da6f48..47276d380 100644
--- a/htools/Ganeti/THH.hs
+++ b/htools/Ganeti/THH.hs
@@ -47,6 +47,7 @@ module Ganeti.THH ( declareSADT
, timeStampFields
, uuidFields
, serialFields
+ , tagsFields
, buildObject
, buildObjectSerialisation
, buildParam
@@ -58,6 +59,7 @@ import Control.Monad (liftM, liftM2)
import Data.Char
import Data.List
import qualified Data.Map as M
+import qualified Data.Set as Set
import Language.Haskell.TH
import qualified Text.JSON as JSON
@@ -172,6 +174,11 @@ serialFields =
uuidFields :: [Field]
uuidFields = [ simpleField "uuid" [t| String |] ]
+-- | Tag field description.
+tagsFields :: [Field]
+tagsFields = [ defaultField [| Set.empty |] $
+ simpleField "tags" [t| Set.Set String |] ]
+
-- * Helper functions
-- | Ensure first letter is lowercase.
--
GitLab