Commit a583ec5d authored by Iustin Pop's avatar Iustin Pop

OpCodes: build and export a list of all opcodes

This can be used for cross-checking with the Python code for
consistency on defined opcodes.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarAgata Murawska <agatamurawska@google.com>
parent 94518cdb
......@@ -438,11 +438,7 @@ instance Arbitrary OpCodes.ReplaceDisksMode where
instance Arbitrary OpCodes.OpCode where
arbitrary = do
op_id <- elements [ "OP_TEST_DELAY"
, "OP_INSTANCE_REPLACE_DISKS"
, "OP_INSTANCE_FAILOVER"
, "OP_INSTANCE_MIGRATE"
]
op_id <- elements OpCodes.allOpIDs
case op_id of
"OP_TEST_DELAY" ->
OpCodes.OpTestDelay <$> arbitrary <*> arbitrary
......
......@@ -6,7 +6,7 @@
{-
Copyright (C) 2009, 2010, 2011 Google Inc.
Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
......@@ -29,6 +29,7 @@ module Ganeti.OpCodes
( OpCode(..)
, ReplaceDisksMode(..)
, opID
, allOpIDs
) where
import Text.JSON (readJSON, showJSON, makeObj, JSON)
......@@ -78,8 +79,12 @@ $(genOpCode "OpCode"
])
])
-- | Returns the OP_ID for a given opcode value.
$(genOpID ''OpCode "opID")
-- | A list of all defined/supported opcode IDs.
$(genAllOpIDs ''OpCode "allOpIDs")
instance JSON OpCode where
readJSON = loadOpCode
showJSON = saveOpCode
......@@ -33,6 +33,7 @@ module Ganeti.THH ( declareSADT
, declareIADT
, makeJSONInstance
, genOpID
, genAllOpIDs
, genOpCode
, genStrOfOp
, genStrOfKey
......@@ -399,6 +400,28 @@ genConstrToStr trans_fun name fname = do
genOpID :: Name -> String -> Q [Dec]
genOpID = genConstrToStr deCamelCase
-- | Builds a list with all defined constructor names for a type.
--
-- @
-- vstr :: String
-- vstr = [...]
-- @
--
-- Where the actual values of the string are the constructor names
-- mapped via @trans_fun@.
genAllConstr :: (String -> String) -> Name -> String -> Q [Dec]
genAllConstr trans_fun name vstr = do
cnames <- reifyConsNames name
let svalues = sort $ map trans_fun cnames
vname = mkName vstr
sig = SigD vname (AppT ListT (ConT ''String))
body = NormalB (ListE (map (LitE . StringL) svalues))
return $ [sig, ValD (VarP vname) body []]
-- | Generates a list of all defined opcode IDs.
genAllOpIDs :: Name -> String -> Q [Dec]
genAllOpIDs = genAllConstr deCamelCase
-- | OpCode parameter (field) type.
type OpParam = (String, Q Type, Q Exp)
......
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