Commit 04dd53a3 authored by Iustin Pop's avatar Iustin Pop
Browse files

Add type classes for common objects



These mirror the TaggableObject in Python, in the sense that we will
be able to define generic functions for querying such fields.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarAgata Murawska <agatamurawska@google.com>
parent 4cbe9bda
......@@ -72,11 +72,16 @@ module Ganeti.Objects
, ClusterNicParams
, Cluster(..)
, ConfigData(..)
, TimeStampObject(..)
, UuidObject(..)
, SerialNoObject(..)
, TagsObject(..)
) where
import Data.List (foldl')
import Data.Maybe
import qualified Data.Map as Map
import qualified Data.Set as Set
import Text.JSON (makeObj, showJSON, readJSON, JSON, JSValue(..))
import qualified Text.JSON as J
......@@ -103,6 +108,23 @@ type HvParams = Container JSValue
-- the values are always strings.
type OsParams = Container String
-- | Class of objects that have timestamps.
class TimeStampObject a where
cTimeOf :: a -> Double
mTimeOf :: a -> Double
-- | Class of objects that have an UUID.
class UuidObject a where
uuidOf :: a -> String
-- | Class of object that have a serial number.
class SerialNoObject a where
serialOf :: a -> Int
-- | Class of objects that have tags.
class TagsObject a where
tagsOf :: a -> Set.Set String
-- * NIC definitions
$(declareSADT "NICMode"
......@@ -325,6 +347,19 @@ $(buildObject "Instance" "inst" $
++ serialFields
++ tagsFields)
instance TimeStampObject Instance where
cTimeOf = instCtime
mTimeOf = instMtime
instance UuidObject Instance where
uuidOf = instUuid
instance SerialNoObject Instance where
serialOf = instSerial
instance TagsObject Instance where
tagsOf = instTags
-- * IPolicy definitions
$(buildParam "ISpec" "ispec" $
......@@ -407,6 +442,19 @@ $(buildObject "Node" "node" $
++ serialFields
++ tagsFields)
instance TimeStampObject Node where
cTimeOf = nodeCtime
mTimeOf = nodeMtime
instance UuidObject Node where
uuidOf = nodeUuid
instance SerialNoObject Node where
serialOf = nodeSerial
instance TagsObject Node where
tagsOf = nodeTags
-- * NodeGroup definitions
-- | The Group allocation policy type.
......@@ -440,6 +488,19 @@ $(buildObject "NodeGroup" "group" $
++ serialFields
++ tagsFields)
instance TimeStampObject NodeGroup where
cTimeOf = groupCtime
mTimeOf = groupMtime
instance UuidObject NodeGroup where
uuidOf = groupUuid
instance SerialNoObject NodeGroup where
serialOf = groupSerial
instance TagsObject NodeGroup where
tagsOf = groupTags
-- | IP family type
$(declareIADT "IpFamily"
[ ("IpFamilyV4", 'C.ip4Family)
......@@ -509,11 +570,24 @@ $(buildObject "Cluster" "cluster" $
, simpleField "prealloc_wipe_disks" [t| Bool |]
, simpleField "ipolicy" [t| FilledIPolicy |]
]
++ serialFields
++ timeStampFields
++ uuidFields
++ serialFields
++ tagsFields)
instance TimeStampObject Cluster where
cTimeOf = clusterCtime
mTimeOf = clusterMtime
instance UuidObject Cluster where
uuidOf = clusterUuid
instance SerialNoObject Cluster where
serialOf = clusterSerial
instance TagsObject Cluster where
tagsOf = clusterTags
-- * ConfigData definitions
$(buildObject "ConfigData" "config" $
......@@ -525,3 +599,6 @@ $(buildObject "ConfigData" "config" $
, simpleField "instances" [t| Container Instance |]
]
++ serialFields)
instance SerialNoObject ConfigData where
serialOf = configSerial
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment