Revision 04dd53a3 htools/Ganeti/Objects.hs
b/htools/Ganeti/Objects.hs | ||
---|---|---|
72 | 72 |
, ClusterNicParams |
73 | 73 |
, Cluster(..) |
74 | 74 |
, ConfigData(..) |
75 |
, TimeStampObject(..) |
|
76 |
, UuidObject(..) |
|
77 |
, SerialNoObject(..) |
|
78 |
, TagsObject(..) |
|
75 | 79 |
) where |
76 | 80 |
|
77 | 81 |
import Data.List (foldl') |
78 | 82 |
import Data.Maybe |
79 | 83 |
import qualified Data.Map as Map |
84 |
import qualified Data.Set as Set |
|
80 | 85 |
import Text.JSON (makeObj, showJSON, readJSON, JSON, JSValue(..)) |
81 | 86 |
import qualified Text.JSON as J |
82 | 87 |
|
... | ... | |
103 | 108 |
-- the values are always strings. |
104 | 109 |
type OsParams = Container String |
105 | 110 |
|
111 |
-- | Class of objects that have timestamps. |
|
112 |
class TimeStampObject a where |
|
113 |
cTimeOf :: a -> Double |
|
114 |
mTimeOf :: a -> Double |
|
115 |
|
|
116 |
-- | Class of objects that have an UUID. |
|
117 |
class UuidObject a where |
|
118 |
uuidOf :: a -> String |
|
119 |
|
|
120 |
-- | Class of object that have a serial number. |
|
121 |
class SerialNoObject a where |
|
122 |
serialOf :: a -> Int |
|
123 |
|
|
124 |
-- | Class of objects that have tags. |
|
125 |
class TagsObject a where |
|
126 |
tagsOf :: a -> Set.Set String |
|
127 |
|
|
106 | 128 |
-- * NIC definitions |
107 | 129 |
|
108 | 130 |
$(declareSADT "NICMode" |
... | ... | |
325 | 347 |
++ serialFields |
326 | 348 |
++ tagsFields) |
327 | 349 |
|
350 |
instance TimeStampObject Instance where |
|
351 |
cTimeOf = instCtime |
|
352 |
mTimeOf = instMtime |
|
353 |
|
|
354 |
instance UuidObject Instance where |
|
355 |
uuidOf = instUuid |
|
356 |
|
|
357 |
instance SerialNoObject Instance where |
|
358 |
serialOf = instSerial |
|
359 |
|
|
360 |
instance TagsObject Instance where |
|
361 |
tagsOf = instTags |
|
362 |
|
|
328 | 363 |
-- * IPolicy definitions |
329 | 364 |
|
330 | 365 |
$(buildParam "ISpec" "ispec" $ |
... | ... | |
407 | 442 |
++ serialFields |
408 | 443 |
++ tagsFields) |
409 | 444 |
|
445 |
instance TimeStampObject Node where |
|
446 |
cTimeOf = nodeCtime |
|
447 |
mTimeOf = nodeMtime |
|
448 |
|
|
449 |
instance UuidObject Node where |
|
450 |
uuidOf = nodeUuid |
|
451 |
|
|
452 |
instance SerialNoObject Node where |
|
453 |
serialOf = nodeSerial |
|
454 |
|
|
455 |
instance TagsObject Node where |
|
456 |
tagsOf = nodeTags |
|
457 |
|
|
410 | 458 |
-- * NodeGroup definitions |
411 | 459 |
|
412 | 460 |
-- | The Group allocation policy type. |
... | ... | |
440 | 488 |
++ serialFields |
441 | 489 |
++ tagsFields) |
442 | 490 |
|
491 |
instance TimeStampObject NodeGroup where |
|
492 |
cTimeOf = groupCtime |
|
493 |
mTimeOf = groupMtime |
|
494 |
|
|
495 |
instance UuidObject NodeGroup where |
|
496 |
uuidOf = groupUuid |
|
497 |
|
|
498 |
instance SerialNoObject NodeGroup where |
|
499 |
serialOf = groupSerial |
|
500 |
|
|
501 |
instance TagsObject NodeGroup where |
|
502 |
tagsOf = groupTags |
|
503 |
|
|
443 | 504 |
-- | IP family type |
444 | 505 |
$(declareIADT "IpFamily" |
445 | 506 |
[ ("IpFamilyV4", 'C.ip4Family) |
... | ... | |
509 | 570 |
, simpleField "prealloc_wipe_disks" [t| Bool |] |
510 | 571 |
, simpleField "ipolicy" [t| FilledIPolicy |] |
511 | 572 |
] |
512 |
++ serialFields |
|
513 | 573 |
++ timeStampFields |
514 | 574 |
++ uuidFields |
575 |
++ serialFields |
|
515 | 576 |
++ tagsFields) |
516 | 577 |
|
578 |
instance TimeStampObject Cluster where |
|
579 |
cTimeOf = clusterCtime |
|
580 |
mTimeOf = clusterMtime |
|
581 |
|
|
582 |
instance UuidObject Cluster where |
|
583 |
uuidOf = clusterUuid |
|
584 |
|
|
585 |
instance SerialNoObject Cluster where |
|
586 |
serialOf = clusterSerial |
|
587 |
|
|
588 |
instance TagsObject Cluster where |
|
589 |
tagsOf = clusterTags |
|
590 |
|
|
517 | 591 |
-- * ConfigData definitions |
518 | 592 |
|
519 | 593 |
$(buildObject "ConfigData" "config" $ |
... | ... | |
525 | 599 |
, simpleField "instances" [t| Container Instance |] |
526 | 600 |
] |
527 | 601 |
++ serialFields) |
602 |
|
|
603 |
instance SerialNoObject ConfigData where |
|
604 |
serialOf = configSerial |
Also available in: Unified diff