Commit 3929e782 authored by Iustin Pop's avatar Iustin Pop
Browse files

Add a function for all fields of a given OP_ID



This patch changes THH to export a new function which defines all
fields of a given OP_ID. Not very clean, since for an invalid OP_ID we
return empty list, but since it will only be used in tests it should
be good enough.

The generated code looks as follows:

    allOpFields :: String -> [String]
    allOpFields "OP_TEST_DELAY"
                  = ["duration", "on_master", "on_nodes", "repeat"]
    allOpFields "OP_INSTANCE_REPLACE_DISKS"
                  = ["disks", "early_release", "iallocator", "ignore_ipolicy",
                     "instance_name", "mode", "remote_node"]
    …
    allOpFields _ = []
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent fa10983e
......@@ -37,6 +37,7 @@ module Ganeti.OpCodes
, unDiskIndex
, opID
, allOpIDs
, allOpFields
) where
import Text.JSON (readJSON, showJSON, JSON())
......
......@@ -535,10 +535,31 @@ genOpCode name cons = do
cons
let declD = DataD [] tname [] decl_d [''Show, ''Eq]
let (allfsig, allffn) = genAllOpFields "allOpFields" cons
(savesig, savefn) <- genSaveOpCode tname "saveOpCode" cons
(uncurry saveConstructor)
(loadsig, loadfn) <- genLoadOpCode cons
return [declD, loadsig, loadfn, savesig, savefn]
return [declD, allfsig, allffn, loadsig, loadfn, savesig, savefn]
-- | Generates the function pattern returning the list of fields for a
-- given constructor.
genOpConsFields :: (String, [Field]) -> Clause
genOpConsFields (cname, fields) =
let op_id = deCamelCase cname
fvals = map (LitE . StringL) . sort . nub $
concatMap (\f -> fieldName f:fieldExtraKeys f) fields
in Clause [LitP (StringL op_id)] (NormalB $ ListE fvals) []
-- | Generates a list of all fields of an opcode constructor.
genAllOpFields :: String -- ^ Function name
-> [(String, [Field])] -- ^ Object definition
-> (Dec, Dec)
genAllOpFields sname opdefs =
let cclauses = map genOpConsFields opdefs
other = Clause [WildP] (NormalB (ListE [])) []
fname = mkName sname
sigt = AppT (AppT ArrowT (ConT ''String)) (AppT ListT (ConT ''String))
in (SigD fname sigt, FunD fname (cclauses++[other]))
-- | Generates the \"save\" clause for an entire opcode constructor.
--
......
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