Revision d12f50b2 htools/Ganeti/HTools/Luxi.hs
| b/htools/Ganeti/HTools/Luxi.hs | ||
|---|---|---|
| 39 | 39 |
import qualified Ganeti.HTools.Group as Group |
| 40 | 40 |
import qualified Ganeti.HTools.Node as Node |
| 41 | 41 |
import qualified Ganeti.HTools.Instance as Instance |
| 42 |
import Ganeti.HTools.Utils (fromJVal, annotateResult, tryFromObj, asJSObject) |
|
| 42 |
import Ganeti.HTools.Utils (fromJVal, annotateResult, tryFromObj, asJSObject, |
|
| 43 |
fromObj) |
|
| 43 | 44 |
|
| 44 | 45 |
-- * Utility functions |
| 45 | 46 |
|
| 46 |
-- | Ensure a given JSValue is actually a JSArray. |
|
| 47 |
toArray :: (Monad m) => JSValue -> m [JSValue] |
|
| 48 |
toArray v = |
|
| 49 |
case v of |
|
| 50 |
JSArray arr -> return arr |
|
| 51 |
o -> fail ("Invalid input, expected array but got " ++ show o)
|
|
| 52 |
|
|
| 53 | 47 |
-- | Get values behind \"data\" part of the result. |
| 54 | 48 |
getData :: (Monad m) => JSValue -> m JSValue |
| 55 |
getData v = |
|
| 56 |
case v of |
|
| 57 |
JSObject o -> |
|
| 58 |
case fromJSObject o of |
|
| 59 |
[("data", jsdata), ("fields", _)] -> return jsdata
|
|
| 60 |
x -> fail $ "Invalid input, expected two-element list but got " |
|
| 61 |
++ show x |
|
| 62 |
x -> fail ("Invalid input, expected dict entry but got " ++ show x)
|
|
| 63 |
|
|
| 64 |
-- | Get [(status, value)] list for each element queried. |
|
| 65 |
toPairs :: (Monad m) => JSValue -> m [[(JSValue, JSValue)]] |
|
| 66 |
toPairs (JSArray arr) = do |
|
| 67 |
arr' <- mapM toArray arr -- list of resulting elements |
|
| 68 |
arr'' <- mapM (mapM toArray) arr' -- list of list of [status, value] |
|
| 69 |
return $ map (map (\a -> (a!!0, a!!1))) arr'' -- FIXME: hackish |
|
| 70 |
toPairs o = fail ("Invalid input, expected array but got " ++ show o)
|
|
| 49 |
getData (JSObject o) = fromObj (fromJSObject o) "data" |
|
| 50 |
getData x = fail $ "Invalid input, expected dict entry but got " ++ show x |
|
| 51 |
|
|
| 52 |
-- | Converts a (status, value) into m value, if possible. |
|
| 53 |
parseQueryField :: (Monad m) => JSValue -> m (JSValue, JSValue) |
|
| 54 |
parseQueryField (JSArray [status, result]) = return (status, result) |
|
| 55 |
parseQueryField o = |
|
| 56 |
fail $ "Invalid query field, expected (status, value) but got " ++ show o |
|
| 57 |
|
|
| 58 |
-- | Parse a result row. |
|
| 59 |
parseQueryRow :: (Monad m) => JSValue -> m [(JSValue, JSValue)] |
|
| 60 |
parseQueryRow (JSArray arr) = mapM parseQueryField arr |
|
| 61 |
parseQueryRow o = |
|
| 62 |
fail $ "Invalid query row result, expected array but got " ++ show o |
|
| 63 |
|
|
| 64 |
-- | Parse an overall query result and get the [(status, value)] list |
|
| 65 |
-- for each element queried. |
|
| 66 |
parseQueryResult :: (Monad m) => JSValue -> m [[(JSValue, JSValue)]] |
|
| 67 |
parseQueryResult (JSArray arr) = mapM parseQueryRow arr |
|
| 68 |
parseQueryResult o = |
|
| 69 |
fail $ "Invalid query result, expected array but got " ++ show o |
|
| 71 | 70 |
|
| 72 | 71 |
-- | Prepare resulting output as parsers expect it. |
| 73 | 72 |
extractArray :: (Monad m) => JSValue -> m [JSValue] |
| 74 |
extractArray v = do |
|
| 75 |
arr <- getData v >>= toPairs |
|
| 76 |
return $ map (JSArray. map snd) arr |
|
| 73 |
extractArray v = |
|
| 74 |
getData v >>= parseQueryResult >>= (return . map (JSArray . map snd)) |
|
| 77 | 75 |
|
| 78 | 76 |
-- | Annotate errors when converting values with owner/attribute for |
| 79 | 77 |
-- better debugging. |
Also available in: Unified diff