Commit 9d74cb04 authored by Agata Murawska's avatar Agata Murawska Committed by Iustin Pop
Browse files

TH simplification for Luxi



This patch simplifies the generation of save constructors for LuxiOp
by always using showJSON over an array of JSValues, instead of having
to pass showJSON in most cases, except the 5-tuple case.
Signed-off-by: default avatarAgata Murawska <agatamurawska@google.com>
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarIustin Pop <iustin@google.com>
[iustin@google.com: fixed a few issues]
parent 05ff7a00
......@@ -68,72 +68,55 @@ $(genLuxiOp "LuxiOp"
[ ("names", [t| [String] |], [| id |])
, ("fields", [t| [String] |], [| id |])
, ("lock", [t| Bool |], [| id |])
],
[| J.showJSON |])
])
, ("QueryGroups",
[ ("names", [t| [String] |], [| id |])
, ("fields", [t| [String] |], [| id |])
, ("lock", [t| Bool |], [| id |])
],
[| J.showJSON |])
])
, ("QueryInstances",
[ ("names", [t| [String] |], [| id |])
, ("fields", [t| [String] |], [| id |])
, ("lock", [t| Bool |], [| id |])
],
[| J.showJSON |])
])
, ("QueryJobs",
[ ("ids", [t| [Int] |], [| map show |])
, ("fields", [t| [String] |], [| id |])
],
[| J.showJSON |])
])
, ("QueryExports",
[ ("nodes", [t| [String] |], [| id |])
, ("lock", [t| Bool |], [| id |])
],
[| J.showJSON |])
])
, ("QueryConfigValues",
[ ("fields", [t| [String] |], [| id |]) ],
[| J.showJSON |])
, ("QueryClusterInfo",
[],
[| J.showJSON |])
[ ("fields", [t| [String] |], [| id |]) ])
, ("QueryClusterInfo", [])
, ("QueryTags",
[ ("kind", [t| String |], [| id |])
, ("name", [t| String |], [| id |])
],
[| J.showJSON |])
])
, ("SubmitJob",
[ ("job", [t| [OpCode] |], [| id |]) ],
[| J.showJSON |])
[ ("job", [t| [OpCode] |], [| id |]) ])
, ("SubmitManyJobs",
[ ("ops", [t| [[OpCode]] |], [| id |]) ],
[| J.showJSON |])
[ ("ops", [t| [[OpCode]] |], [| id |]) ])
, ("WaitForJobChange",
[ ("job", [t| Int |], [| J.showJSON |])
, ("fields", [t| [String]|], [| J.showJSON |])
, ("prev_job", [t| JSValue |], [| J.showJSON |])
, ("prev_log", [t| JSValue |], [| J.showJSON |])
, ("tmout", [t| Int |], [| J.showJSON |])
],
[| \(j, f, pj, pl, t) -> JSArray [j, f, pj, pl, t] |])
[ ("job", [t| Int |], [| id |])
, ("fields", [t| [String]|], [| id |])
, ("prev_job", [t| JSValue |], [| id |])
, ("prev_log", [t| JSValue |], [| id |])
, ("tmout", [t| Int |], [| id |])
])
, ("ArchiveJob",
[ ("job", [t| Int |], [| show |]) ],
[| J.showJSON |])
[ ("job", [t| Int |], [| show |]) ])
, ("AutoArchiveJobs",
[ ("age", [t| Int |], [| id |])
, ("tmout", [t| Int |], [| id |])
],
[| J.showJSON |])
])
, ("CancelJob",
[("job", [t| Int |], [| show |]) ],
[| J.showJSON |])
[("job", [t| Int |], [| show |]) ])
, ("SetDrainFlag",
[ ("flag", [t| Bool |], [| id |]) ],
[| J.showJSON |])
[ ("flag", [t| Bool |], [| id |]) ])
, ("SetWatcherPause",
[ ("duration", [t| Double |], [| (: []) |]) ],
[| J.showJSON |])
[ ("duration", [t| Double |], [| (: []) |]) ])
])
-- | The serialisation of LuxiOps into strings in messages.
......
......@@ -444,9 +444,9 @@ type LuxiParam = (String, Q Type, Q Exp)
-- * operation; this is the operation performed on the parameter before
-- serialization
--
genLuxiOp :: String -> [(String, [LuxiParam], Q Exp)] -> 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
......@@ -457,18 +457,20 @@ genLuxiOp name cons = do
return [declD, savesig, savefn]
-- | Generates the \"save\" clause for entire LuxiOp constructor.
saveLuxiConstructor :: (String, [LuxiParam], Q Exp) -> Q Clause
saveLuxiConstructor (sname, fields, finfn) =
saveLuxiConstructor :: (String, [LuxiParam]) -> Q Clause
saveLuxiConstructor (sname, fields) =
let cname = mkName sname
fnames = map (\(nm, _, _) -> mkName nm) fields
pat = conP cname (map varP fnames)
flist = map (\(nm, _, fn) -> liftM2 appFn fn $ varNameE nm) fields
finval = appE finfn (tupE flist)
in
clause [pat] (normalB finval) []
flist = map (\(nm, _, fn) -> liftM2 appFn fn $ (varNameE nm)) fields
showlist = map (\x -> [| JSON.showJSON $x |]) flist
finval = case showlist of
[] -> [| JSON.showJSON () |]
_ -> [| JSON.showJSON $(listE showlist) |]
in clause [pat] (normalB finval) []
-- | Generates the main save LuxiOp function.
genSaveLuxiOp :: [(String, [LuxiParam], Q Exp)] -> 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