Revision de36f091 src/Ganeti/OpParams.hs
b/src/Ganeti/OpParams.hs | ||
---|---|---|
33 | 33 |
|
34 | 34 |
module Ganeti.OpParams |
35 | 35 |
( TagType(..) |
36 |
, TagObject(..) |
|
37 |
, tagObjectFrom |
|
38 |
, tagNameOf |
|
39 |
, decodeTagObject |
|
40 |
, encodeTagObject |
|
41 | 36 |
, ReplaceDisksMode(..) |
42 | 37 |
, DiskIndex |
43 | 38 |
, mkDiskIndex |
... | ... | |
317 | 312 |
]) |
318 | 313 |
$(makeJSONInstance ''TagType) |
319 | 314 |
|
320 |
-- | Data type holding a tag object (type and object name). |
|
321 |
data TagObject = TagInstance String |
|
322 |
| TagNode String |
|
323 |
| TagGroup String |
|
324 |
| TagCluster |
|
325 |
deriving (Show, Eq) |
|
326 |
|
|
327 |
-- | Tag type for a given tag object. |
|
328 |
tagTypeOf :: TagObject -> TagType |
|
329 |
tagTypeOf (TagInstance {}) = TagTypeInstance |
|
330 |
tagTypeOf (TagNode {}) = TagTypeNode |
|
331 |
tagTypeOf (TagGroup {}) = TagTypeGroup |
|
332 |
tagTypeOf (TagCluster {}) = TagTypeCluster |
|
333 |
|
|
334 |
-- | Gets the potential tag object name. |
|
335 |
tagNameOf :: TagObject -> Maybe String |
|
336 |
tagNameOf (TagInstance s) = Just s |
|
337 |
tagNameOf (TagNode s) = Just s |
|
338 |
tagNameOf (TagGroup s) = Just s |
|
339 |
tagNameOf TagCluster = Nothing |
|
340 |
|
|
341 |
-- | Builds a 'TagObject' from a tag type and name. |
|
342 |
tagObjectFrom :: (Monad m) => TagType -> JSValue -> m TagObject |
|
343 |
tagObjectFrom TagTypeInstance (JSString s) = |
|
344 |
return . TagInstance $ fromJSString s |
|
345 |
tagObjectFrom TagTypeNode (JSString s) = return . TagNode $ fromJSString s |
|
346 |
tagObjectFrom TagTypeGroup (JSString s) = return . TagGroup $ fromJSString s |
|
347 |
tagObjectFrom TagTypeCluster JSNull = return TagCluster |
|
348 |
tagObjectFrom t v = |
|
349 |
fail $ "Invalid tag type/name combination: " ++ show t ++ "/" ++ |
|
350 |
show (pp_value v) |
|
351 |
|
|
352 |
-- | Name of the tag \"name\" field. |
|
353 |
tagNameField :: String |
|
354 |
tagNameField = "name" |
|
355 |
|
|
356 |
-- | Custom encoder for 'TagObject' as represented in an opcode. |
|
357 |
encodeTagObject :: TagObject -> (JSValue, [(String, JSValue)]) |
|
358 |
encodeTagObject t = ( showJSON (tagTypeOf t) |
|
359 |
, [(tagNameField, maybe JSNull showJSON (tagNameOf t))] ) |
|
360 |
|
|
361 |
-- | Custom decoder for 'TagObject' as represented in an opcode. |
|
362 |
decodeTagObject :: (Monad m) => [(String, JSValue)] -> JSValue -> m TagObject |
|
363 |
decodeTagObject obj kind = do |
|
364 |
ttype <- fromJVal kind |
|
365 |
tname <- fromObj obj tagNameField |
|
366 |
tagObjectFrom ttype tname |
|
367 |
|
|
368 | 315 |
-- ** Disks |
369 | 316 |
|
370 | 317 |
-- | Replace disks type. |
Also available in: Unified diff