Commit b20cbf06 authored by Iustin Pop's avatar Iustin Pop
Browse files

Adjust htools code to new Luxi argument format

This partially undoes commit 92678b3c

, more specifically it removes the
Store data type and the associated code, since all Luxi arguments are
now lists.

Furthermore, since the qfilter field on Query is complex (it's
actually a tree structure), and we don't support it, turn it into a
plain () type, which always gets encoded as JSNull ('null'), so that
we can remove the optional field handling from Luxi (all fields are
always required).
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarMichael Hanselmann <hansmi@google.com>
parent b8d51bb2
......@@ -95,14 +95,14 @@ queryNodesMsg :: L.LuxiOp
queryNodesMsg =
L.Query L.QRNode ["name", "mtotal", "mnode", "mfree", "dtotal", "dfree",
"ctotal", "offline", "drained", "vm_capable",
"group.uuid"] Nothing
"group.uuid"] ()
-- | The input data for instance query.
queryInstancesMsg :: L.LuxiOp
queryInstancesMsg =
L.Query L.QRInstance ["name", "disk_usage", "be/memory", "be/vcpus",
"status", "pnode", "snodes", "tags", "oper_ram",
"be/auto_balance", "disk_template"] Nothing
"be/auto_balance", "disk_template"] ()
-- | The input data for cluster query.
queryClusterInfoMsg :: L.LuxiOp
......@@ -111,7 +111,7 @@ queryClusterInfoMsg = L.QueryClusterInfo
-- | The input data for node group query.
queryGroupsMsg :: L.LuxiOp
queryGroupsMsg =
L.Query L.QRGroup ["uuid", "name", "alloc_policy"] Nothing
L.Query L.QRGroup ["uuid", "name", "alloc_policy"] ()
-- | Wraper over 'callMethod' doing node query.
queryNodes :: L.Client -> IO (Result JSValue)
......
......@@ -76,70 +76,70 @@ $(makeJSONInstance ''QrViaLuxi)
-- | Currently supported Luxi operations and JSON serialization.
$(genLuxiOp "LuxiOp"
[("Query" ,
[ ("what", [t| QrViaLuxi |], [| id |])
, ("fields", [t| [String] |], [| id |])
, ("qfilter", [t| Maybe (String, [[String]]) |], [| id |])
], SDict)
[ ("what", [t| QrViaLuxi |], [| id |])
, ("fields", [t| [String] |], [| id |])
, ("qfilter", [t| () |], [| const JSNull |])
])
, ("QueryNodes",
[ ("names", [t| [String] |], [| id |])
, ("fields", [t| [String] |], [| id |])
, ("lock", [t| Bool |], [| id |])
], SList)
])
, ("QueryGroups",
[ ("names", [t| [String] |], [| id |])
, ("fields", [t| [String] |], [| id |])
, ("lock", [t| Bool |], [| id |])
], SList)
])
, ("QueryInstances",
[ ("names", [t| [String] |], [| id |])
, ("fields", [t| [String] |], [| id |])
, ("lock", [t| Bool |], [| id |])
], SList)
])
, ("QueryJobs",
[ ("ids", [t| [Int] |], [| map show |])
, ("fields", [t| [String] |], [| id |])
], SList)
])
, ("QueryExports",
[ ("nodes", [t| [String] |], [| id |])
, ("lock", [t| Bool |], [| id |])
], SList)
])
, ("QueryConfigValues",
[ ("fields", [t| [String] |], [| id |]) ],
SList)
, ("QueryClusterInfo", [], SList)
[ ("fields", [t| [String] |], [| id |]) ]
)
, ("QueryClusterInfo", [])
, ("QueryTags",
[ ("kind", [t| String |], [| id |])
, ("name", [t| String |], [| id |])
], SList)
])
, ("SubmitJob",
[ ("job", [t| [OpCode] |], [| id |]) ],
SList)
[ ("job", [t| [OpCode] |], [| id |]) ]
)
, ("SubmitManyJobs",
[ ("ops", [t| [[OpCode]] |], [| id |]) ],
SList)
[ ("ops", [t| [[OpCode]] |], [| id |]) ]
)
, ("WaitForJobChange",
[ ("job", [t| Int |], [| id |])
, ("fields", [t| [String]|], [| id |])
, ("prev_job", [t| JSValue |], [| id |])
, ("prev_log", [t| JSValue |], [| id |])
, ("tmout", [t| Int |], [| id |])
], SList)
])
, ("ArchiveJob",
[ ("job", [t| Int |], [| show |]) ],
SList)
[ ("job", [t| Int |], [| show |]) ]
)
, ("AutoArchiveJobs",
[ ("age", [t| Int |], [| id |])
, ("tmout", [t| Int |], [| id |])
], SList)
])
, ("CancelJob",
[("job", [t| Int |], [| show |]) ],
SList)
[ ("job", [t| Int |], [| show |]) ]
)
, ("SetDrainFlag",
[ ("flag", [t| Bool |], [| id |]) ],
SList)
[ ("flag", [t| Bool |], [| id |]) ]
)
, ("SetWatcherPause",
[ ("duration", [t| Double |], [| (: []) |]) ],
SList)
[ ("duration", [t| Double |], [| id |]) ]
)
])
-- | The serialisation of LuxiOps into strings in messages.
......
......@@ -29,8 +29,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-}
module Ganeti.THH ( Store(..)
, declareSADT
module Ganeti.THH ( declareSADT
, makeJSONInstance
, genOpID
, genOpCode
......@@ -429,9 +428,6 @@ genStrOfKey = genConstrToStr ensureLower
-- | LuxiOp parameter type.
type LuxiParam = (String, Q Type, Q Exp)
-- | Storage options for JSON.
data Store = SList | SDict
-- | Generates the LuxiOp data type.
--
-- This takes a Luxi operation definition and builds both the
......@@ -448,9 +444,9 @@ data Store = SList | SDict
-- * operation; this is the operation performed on the parameter before
-- serialization
--
genLuxiOp :: String -> [(String, [LuxiParam], Store)] -> Q [Dec]
genLuxiOp :: String -> [(String, [LuxiParam])] -> Q [Dec]
genLuxiOp name cons = do
decl_d <- mapM (\(cname, fields, _) -> do
decl_d <- mapM (\(cname, fields) -> do
fields' <- mapM (\(_, qt, _) ->
qt >>= \t -> return (NotStrict, t))
fields
......@@ -460,42 +456,25 @@ genLuxiOp name cons = do
(savesig, savefn) <- genSaveLuxiOp cons
return [declD, savesig, savefn]
-- | Generates a Q Exp for an element, depending of the JSON return type.
helperLuxiField :: Store -> String -> Q Exp -> Q Exp
helperLuxiField SList name val = [| [ JSON.showJSON $val ] |]
helperLuxiField SDict name val = [| [(name, JSON.showJSON $val)] |]
-- | Generates the \"save\" expression for a single luxi parameter.
saveLuxiField :: Store -> Name -> LuxiParam -> Q Exp
saveLuxiField store fvar (fname, qt, fn) = do
t <- qt
let fvare = varE fvar
(if isOptional t
then [| case $fvare of
Just v' ->
$(helperLuxiField store fname $ liftM2 appFn fn [| v' |])
Nothing -> []
|]
else helperLuxiField store fname $ liftM2 appFn fn fvare)
-- | Generates final JSON Q Exp for constructor.
helperLuxiConstructor :: Store -> Q Exp -> Q Exp
helperLuxiConstructor SDict val = [| JSON.showJSON $ JSON.makeObj $val |]
helperLuxiConstructor SList val = [| JSON.JSArray $val |]
saveLuxiField :: Name -> LuxiParam -> Q Exp
saveLuxiField fvar (_, qt, fn) =
[| JSON.showJSON ( $(liftM2 appFn fn $ varE fvar) ) |]
-- | Generates the \"save\" clause for entire LuxiOp constructor.
saveLuxiConstructor :: (String, [LuxiParam], Store) -> Q Clause
saveLuxiConstructor (sname, fields, store) = do
saveLuxiConstructor :: (String, [LuxiParam]) -> Q Clause
saveLuxiConstructor (sname, fields) = do
let cname = mkName sname
fnames = map (\(nm, _, _) -> mkName nm) fields
pat = conP cname (map varP fnames)
flist = map (uncurry $ saveLuxiField store) (zip fnames fields)
flist' = appE [| concat |] (listE flist)
finval = helperLuxiConstructor store flist'
flist = map (uncurry saveLuxiField) (zip fnames fields)
finval = if null flist
then [| JSON.showJSON () |]
else [| JSON.showJSON $(listE flist) |]
clause [pat] (normalB finval) []
-- | Generates the main save LuxiOp function.
genSaveLuxiOp :: [(String, [LuxiParam], Store)]-> Q (Dec, Dec)
genSaveLuxiOp :: [(String, [LuxiParam])]-> Q (Dec, Dec)
genSaveLuxiOp opdefs = do
sigt <- [t| $(conT (mkName "LuxiOp")) -> JSON.JSValue |]
let fname = mkName "opToArgs"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment