Revision a583ec5d
| b/htools/Ganeti/HTools/QC.hs | ||
|---|---|---|
| 438 | 438 |
|
| 439 | 439 |
instance Arbitrary OpCodes.OpCode where |
| 440 | 440 |
arbitrary = do |
| 441 |
op_id <- elements [ "OP_TEST_DELAY" |
|
| 442 |
, "OP_INSTANCE_REPLACE_DISKS" |
|
| 443 |
, "OP_INSTANCE_FAILOVER" |
|
| 444 |
, "OP_INSTANCE_MIGRATE" |
|
| 445 |
] |
|
| 441 |
op_id <- elements OpCodes.allOpIDs |
|
| 446 | 442 |
case op_id of |
| 447 | 443 |
"OP_TEST_DELAY" -> |
| 448 | 444 |
OpCodes.OpTestDelay <$> arbitrary <*> arbitrary |
| b/htools/Ganeti/OpCodes.hs | ||
|---|---|---|
| 6 | 6 |
|
| 7 | 7 |
{-
|
| 8 | 8 |
|
| 9 |
Copyright (C) 2009, 2010, 2011 Google Inc. |
|
| 9 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
|
|
| 10 | 10 |
|
| 11 | 11 |
This program is free software; you can redistribute it and/or modify |
| 12 | 12 |
it under the terms of the GNU General Public License as published by |
| ... | ... | |
| 29 | 29 |
( OpCode(..) |
| 30 | 30 |
, ReplaceDisksMode(..) |
| 31 | 31 |
, opID |
| 32 |
, allOpIDs |
|
| 32 | 33 |
) where |
| 33 | 34 |
|
| 34 | 35 |
import Text.JSON (readJSON, showJSON, makeObj, JSON) |
| ... | ... | |
| 78 | 79 |
]) |
| 79 | 80 |
]) |
| 80 | 81 |
|
| 82 |
-- | Returns the OP_ID for a given opcode value. |
|
| 81 | 83 |
$(genOpID ''OpCode "opID") |
| 82 | 84 |
|
| 85 |
-- | A list of all defined/supported opcode IDs. |
|
| 86 |
$(genAllOpIDs ''OpCode "allOpIDs") |
|
| 87 |
|
|
| 83 | 88 |
instance JSON OpCode where |
| 84 | 89 |
readJSON = loadOpCode |
| 85 | 90 |
showJSON = saveOpCode |
| b/htools/Ganeti/THH.hs | ||
|---|---|---|
| 33 | 33 |
, declareIADT |
| 34 | 34 |
, makeJSONInstance |
| 35 | 35 |
, genOpID |
| 36 |
, genAllOpIDs |
|
| 36 | 37 |
, genOpCode |
| 37 | 38 |
, genStrOfOp |
| 38 | 39 |
, genStrOfKey |
| ... | ... | |
| 399 | 400 |
genOpID :: Name -> String -> Q [Dec] |
| 400 | 401 |
genOpID = genConstrToStr deCamelCase |
| 401 | 402 |
|
| 403 |
-- | Builds a list with all defined constructor names for a type. |
|
| 404 |
-- |
|
| 405 |
-- @ |
|
| 406 |
-- vstr :: String |
|
| 407 |
-- vstr = [...] |
|
| 408 |
-- @ |
|
| 409 |
-- |
|
| 410 |
-- Where the actual values of the string are the constructor names |
|
| 411 |
-- mapped via @trans_fun@. |
|
| 412 |
genAllConstr :: (String -> String) -> Name -> String -> Q [Dec] |
|
| 413 |
genAllConstr trans_fun name vstr = do |
|
| 414 |
cnames <- reifyConsNames name |
|
| 415 |
let svalues = sort $ map trans_fun cnames |
|
| 416 |
vname = mkName vstr |
|
| 417 |
sig = SigD vname (AppT ListT (ConT ''String)) |
|
| 418 |
body = NormalB (ListE (map (LitE . StringL) svalues)) |
|
| 419 |
return $ [sig, ValD (VarP vname) body []] |
|
| 420 |
|
|
| 421 |
-- | Generates a list of all defined opcode IDs. |
|
| 422 |
genAllOpIDs :: Name -> String -> Q [Dec] |
|
| 423 |
genAllOpIDs = genAllConstr deCamelCase |
|
| 424 |
|
|
| 402 | 425 |
-- | OpCode parameter (field) type. |
| 403 | 426 |
type OpParam = (String, Q Type, Q Exp) |
| 404 | 427 |
|
Also available in: Unified diff