In this way, they can be used by other haskell modules making
queries to luxid. Querying luxid is not htools specific anyway.
Signed-off-by: Klaus Aehlig <[email protected]>
---
src/Ganeti/HTools/Backend/Luxi.hs | 49 ++++++---------------------------------
src/Ganeti/Luxi.hs | 40 ++++++++++++++++++++++++++++++++
2 files changed, 47 insertions(+), 42 deletions(-)
diff --git a/src/Ganeti/HTools/Backend/Luxi.hs
b/src/Ganeti/HTools/Backend/Luxi.hs
index 5a3cb1d..2e2447b 100644
--- a/src/Ganeti/HTools/Backend/Luxi.hs
+++ b/src/Ganeti/HTools/Backend/Luxi.hs
@@ -57,41 +57,6 @@ import Ganeti.JSON
-- * Utility functions
--- | Get values behind \"data\" part of the result.
-getData :: (Monad m) => JSValue -> m JSValue
-getData (JSObject o) = fromObj (fromJSObject o) "data"
-getData x = fail $ "Invalid input, expected dict entry but got " ++ show x
-
--- | Converts a (status, value) into m value, if possible.
-parseQueryField :: (Monad m) => JSValue -> m (JSValue, JSValue)
-parseQueryField (JSArray [status, result]) = return (status, result)
-parseQueryField o =
- fail $ "Invalid query field, expected (status, value) but got " ++ show o
-
--- | Parse a result row.
-parseQueryRow :: (Monad m) => JSValue -> m [(JSValue, JSValue)]
-parseQueryRow (JSArray arr) = mapM parseQueryField arr
-parseQueryRow o =
- fail $ "Invalid query row result, expected array but got " ++ show o
-
--- | Parse an overall query result and get the [(status, value)] list
--- for each element queried.
-parseQueryResult :: (Monad m) => JSValue -> m [[(JSValue, JSValue)]]
-parseQueryResult (JSArray arr) = mapM parseQueryRow arr
-parseQueryResult o =
- fail $ "Invalid query result, expected array but got " ++ show o
-
--- | Prepare resulting output as parsers expect it.
-extractArray :: (Monad m) => JSValue -> m [[(JSValue, JSValue)]]
-extractArray v =
- getData v >>= parseQueryResult
-
--- | Testing result status for more verbose error message.
-fromJValWithStatus :: (Text.JSON.JSON a, Monad m) => (JSValue, JSValue) -> m a
-fromJValWithStatus (st, v) = do
- st' <- fromJVal st
- Qlang.checkRS st' v >>= fromJVal
-
annotateConvert :: String -> String -> String -> Result a -> Result a
annotateConvert otype oname oattr =
annotateResult $ otype ++ " '" ++ oname ++
@@ -106,7 +71,7 @@ genericConvert :: (Text.JSON.JSON a) =>
-> (JSValue, JSValue) -- ^ The value we're trying to convert
-> Result a -- ^ The annotated result
genericConvert otype oname oattr =
- annotateConvert otype oname oattr . fromJValWithStatus
+ annotateConvert otype oname oattr . L.fromJValWithStatus
convertArrayMaybe :: (Text.JSON.JSON a) =>
String -- ^ The object type
@@ -172,7 +137,7 @@ queryGroups = liftM errToResult . L.callMethod
queryGroupsMsg
getInstances :: NameAssoc
-> JSValue
-> Result [(String, Instance.Instance)]
-getInstances ktn arr = extractArray arr >>= mapM (parseInstance ktn)
+getInstances ktn arr = L.extractArray arr >>= mapM (parseInstance ktn)
-- | Construct an instance from a JSON object.
parseInstance :: NameAssoc
@@ -182,7 +147,7 @@ parseInstance ktn [ name, disk, mem, vcpus
, status, pnode, snodes, tags, oram
, auto_balance, disk_template, su
, dsizes, dspindles, forthcoming ] = do
- xname <- annotateResult "Parsing new instance" (fromJValWithStatus name)
+ xname <- annotateResult "Parsing new instance" (L.fromJValWithStatus name)
let convert a = genericConvert "Instance" xname a
xdisk <- convert "disk_usage" disk
xmem <- case oram of -- FIXME: remove the "guessing"
@@ -212,7 +177,7 @@ parseInstance _ v = fail ("Invalid instance query result: "
++ show v)
-- | Parse a node list in JSON format.
getNodes :: NameAssoc -> JSValue -> Result [(String, Node.Node)]
-getNodes ktg arr = extractArray arr >>= mapM (parseNode ktg)
+getNodes ktg arr = L.extractArray arr >>= mapM (parseNode ktg)
-- | Construct a node from a JSON object.
parseNode :: NameAssoc -> [(JSValue, JSValue)] -> Result (String, Node.Node)
@@ -220,7 +185,7 @@ parseNode ktg [ name, mtotal, mnode, mfree, dtotal, dfree
, ctotal, cnos, offline, drained, vm_capable, spindles, g_uuid
, tags, excl_stor, sptotal, spfree, cpu_speed ]
= do
- xname <- annotateResult "Parsing new node" (fromJValWithStatus name)
+ xname <- annotateResult "Parsing new node" (L.fromJValWithStatus name)
let convert a = genericConvert "Node" xname a
xoffline <- convert "offline" offline
xdrained <- convert "drained" drained
@@ -272,12 +237,12 @@ getClusterData _ = Bad "Cannot parse cluster info, not a JSON
record"
-- | Parses the cluster groups.
getGroups :: JSValue -> Result [(String, Group.Group)]
-getGroups jsv = extractArray jsv >>= mapM parseGroup
+getGroups jsv = L.extractArray jsv >>= mapM parseGroup
-- | Parses a given group information.
parseGroup :: [(JSValue, JSValue)] -> Result (String, Group.Group)
parseGroup [uuid, name, apol, ipol, tags] = do
- xname <- annotateResult "Parsing new group" (fromJValWithStatus name)
+ xname <- annotateResult "Parsing new group" (L.fromJValWithStatus name)
let convert a = genericConvert "Group" xname a
xuuid <- convert "uuid" uuid
xapol <- convert "alloc_policy" apol
diff --git a/src/Ganeti/Luxi.hs b/src/Ganeti/Luxi.hs
index 16570d1..4439cef 100644
--- a/src/Ganeti/Luxi.hs
+++ b/src/Ganeti/Luxi.hs
@@ -60,6 +60,8 @@ module Ganeti.Luxi
, recvMsgExt
, sendMsg
, allLuxiCalls
+ , extractArray
+ , fromJValWithStatus
) where
import Control.Applicative (optional, liftA, (<|>))
@@ -381,3 +383,41 @@ queryJobsStatus s jids = do
LuxiError "Missing job status field"
else Ok (map head vals)
J.Error x -> Bad $ LuxiError x
+
+-- * Utility functions
+
+-- | Get values behind \"data\" part of the result.
+getData :: (Monad m) => JSValue -> m JSValue
+getData (JSObject o) = fromObj (fromJSObject o) "data"
+getData x = fail $ "Invalid input, expected dict entry but got " ++ show x
+
+-- | Converts a (status, value) into m value, if possible.
+parseQueryField :: (Monad m) => JSValue -> m (JSValue, JSValue)
+parseQueryField (JSArray [status, result]) = return (status, result)
+parseQueryField o =
+ fail $ "Invalid query field, expected (status, value) but got " ++ show o
+
+-- | Parse a result row.
+parseQueryRow :: (Monad m) => JSValue -> m [(JSValue, JSValue)]
+parseQueryRow (JSArray arr) = mapM parseQueryField arr
+parseQueryRow o =
+ fail $ "Invalid query row result, expected array but got " ++ show o
+
+-- | Parse an overall query result and get the [(status, value)] list
+-- for each element queried.
+parseQueryResult :: (Monad m) => JSValue -> m [[(JSValue, JSValue)]]
+parseQueryResult (JSArray arr) = mapM parseQueryRow arr
+parseQueryResult o =
+ fail $ "Invalid query result, expected array but got " ++ show o
+
+-- | Prepare resulting output as parsers expect it.
+extractArray :: (Monad m) => JSValue -> m [[(JSValue, JSValue)]]
+extractArray v =
+ getData v >>= parseQueryResult
+
+-- | Testing result status for more verbose error message.
+fromJValWithStatus :: (J.JSON a, Monad m) => (JSValue, JSValue) -> m a
+fromJValWithStatus (st, v) = do
+ st' <- fromJVal st
+ Qlang.checkRS st' v >>= fromJVal
+
--
2.4.3.573.g4eafbef
