Revision 260d0bda htools/Ganeti/HTools/Luxi.hs
| b/htools/Ganeti/HTools/Luxi.hs | ||
|---|---|---|
| 69 | 69 |
fail $ "Invalid query result, expected array but got " ++ show o |
| 70 | 70 |
|
| 71 | 71 |
-- | Prepare resulting output as parsers expect it. |
| 72 |
extractArray :: (Monad m) => JSValue -> m [JSValue]
|
|
| 72 |
extractArray :: (Monad m) => JSValue -> m [[(JSValue, JSValue)]]
|
|
| 73 | 73 |
extractArray v = |
| 74 |
getData v >>= parseQueryResult >>= (return . map (JSArray . map snd)) |
|
| 74 |
getData v >>= parseQueryResult |
|
| 75 |
|
|
| 76 |
-- | Testing result status for more verbose error message. |
|
| 77 |
fromJValWithStatus :: (Text.JSON.JSON a, Monad m) => (JSValue, JSValue) -> m a |
|
| 78 |
fromJValWithStatus (st, v) = do |
|
| 79 |
st' <- fromJVal st |
|
| 80 |
L.checkRS st' v >>= fromJVal |
|
| 75 | 81 |
|
| 76 | 82 |
-- | Annotate errors when converting values with owner/attribute for |
| 77 | 83 |
-- better debugging. |
| 78 | 84 |
genericConvert :: (Text.JSON.JSON a) => |
| 79 |
String -- ^ The object type |
|
| 80 |
-> String -- ^ The object name |
|
| 81 |
-> String -- ^ The attribute we're trying to convert |
|
| 82 |
-> JSValue -- ^ The value we try to convert
|
|
| 83 |
-> Result a -- ^ The annotated result |
|
| 85 |
String -- ^ The object type
|
|
| 86 |
-> String -- ^ The object name
|
|
| 87 |
-> String -- ^ The attribute we're trying to convert
|
|
| 88 |
-> (JSValue, JSValue) -- ^ The value we're trying to convert
|
|
| 89 |
-> Result a -- ^ The annotated result
|
|
| 84 | 90 |
genericConvert otype oname oattr = |
| 85 | 91 |
annotateResult (otype ++ " '" ++ oname ++ |
| 86 | 92 |
"', error while reading attribute '" ++ |
| 87 |
oattr ++ "'") . fromJVal |
|
| 93 |
oattr ++ "'") . fromJValWithStatus
|
|
| 88 | 94 |
|
| 89 | 95 |
-- * Data querying functionality |
| 90 | 96 |
|
| ... | ... | |
| 135 | 141 |
|
| 136 | 142 |
-- | Construct an instance from a JSON object. |
| 137 | 143 |
parseInstance :: NameAssoc |
| 138 |
-> JSValue
|
|
| 144 |
-> [(JSValue, JSValue)]
|
|
| 139 | 145 |
-> Result (String, Instance.Instance) |
| 140 |
parseInstance ktn (JSArray [ name, disk, mem, vcpus
|
|
| 141 |
, status, pnode, snodes, tags, oram
|
|
| 142 |
, auto_balance, disk_template ]) = do
|
|
| 143 |
xname <- annotateResult "Parsing new instance" (fromJVal name) |
|
| 146 |
parseInstance ktn [ name, disk, mem, vcpus |
|
| 147 |
, status, pnode, snodes, tags, oram |
|
| 148 |
, auto_balance, disk_template ] = do
|
|
| 149 |
xname <- annotateResult "Parsing new instance" (fromJValWithStatus name)
|
|
| 144 | 150 |
let convert a = genericConvert "Instance" xname a |
| 145 | 151 |
xdisk <- convert "disk_usage" disk |
| 146 |
xmem <- (case oram of |
|
| 147 |
JSRational _ _ -> convert "oper_ram" oram
|
|
| 152 |
xmem <- (case oram of -- FIXME: remove the "guessing"
|
|
| 153 |
(_, JSRational _ _) -> convert "oper_ram" oram
|
|
| 148 | 154 |
_ -> convert "be/memory" mem) |
| 149 | 155 |
xvcpus <- convert "be/vcpus" vcpus |
| 150 | 156 |
xpnode <- convert "pnode" pnode >>= lookupNode ktn xname |
| ... | ... | |
| 166 | 172 |
getNodes ktg arr = extractArray arr >>= mapM (parseNode ktg) |
| 167 | 173 |
|
| 168 | 174 |
-- | Construct a node from a JSON object. |
| 169 |
parseNode :: NameAssoc -> JSValue -> Result (String, Node.Node)
|
|
| 170 |
parseNode ktg (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree
|
|
| 171 |
, ctotal, offline, drained, vm_capable, g_uuid ])
|
|
| 175 |
parseNode :: NameAssoc -> [(JSValue, JSValue)] -> Result (String, Node.Node)
|
|
| 176 |
parseNode ktg [ name, mtotal, mnode, mfree, dtotal, dfree |
|
| 177 |
, ctotal, offline, drained, vm_capable, g_uuid ]
|
|
| 172 | 178 |
= do |
| 173 |
xname <- annotateResult "Parsing new node" (fromJVal name) |
|
| 179 |
xname <- annotateResult "Parsing new node" (fromJValWithStatus name)
|
|
| 174 | 180 |
let convert a = genericConvert "Node" xname a |
| 175 | 181 |
xoffline <- convert "offline" offline |
| 176 | 182 |
xdrained <- convert "drained" drained |
| ... | ... | |
| 203 | 209 |
getGroups jsv = extractArray jsv >>= mapM parseGroup |
| 204 | 210 |
|
| 205 | 211 |
-- | Parses a given group information. |
| 206 |
parseGroup :: JSValue -> Result (String, Group.Group)
|
|
| 207 |
parseGroup (JSArray [uuid, name, apol]) = do
|
|
| 208 |
xname <- annotateResult "Parsing new group" (fromJVal name) |
|
| 212 |
parseGroup :: [(JSValue, JSValue)] -> Result (String, Group.Group)
|
|
| 213 |
parseGroup [uuid, name, apol] = do
|
|
| 214 |
xname <- annotateResult "Parsing new group" (fromJValWithStatus name)
|
|
| 209 | 215 |
let convert a = genericConvert "Group" xname a |
| 210 | 216 |
xuuid <- convert "uuid" uuid |
| 211 | 217 |
xapol <- convert "alloc_policy" apol |
Also available in: Unified diff