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