On Tue, Aug 21, 2012 at 3:06 PM, Iustin Pop <[email protected]> wrote: > > This can be used for cross-checking with the Python code for > consistency on defined opcodes. > > Signed-off-by: Iustin Pop <[email protected]> > --- > htools/Ganeti/HTools/QC.hs | 6 +----- > htools/Ganeti/OpCodes.hs | 7 ++++++- > htools/Ganeti/THH.hs | 23 +++++++++++++++++++++++ > 3 files changed, 30 insertions(+), 6 deletions(-) > > diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs > index 6a19a2b..ee8ef48 100644 > --- a/htools/Ganeti/HTools/QC.hs > +++ b/htools/Ganeti/HTools/QC.hs > @@ -435,11 +435,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 > diff --git a/htools/Ganeti/OpCodes.hs b/htools/Ganeti/OpCodes.hs > index 3ecc645..bda66a1 100644 > --- a/htools/Ganeti/OpCodes.hs > +++ b/htools/Ganeti/OpCodes.hs > @@ -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 > diff --git a/htools/Ganeti/THH.hs b/htools/Ganeti/THH.hs > index 0480bb0..c70a968 100644 > --- a/htools/Ganeti/THH.hs > +++ b/htools/Ganeti/THH.hs > @@ -33,6 +33,7 @@ module Ganeti.THH ( declareSADT > , declareIADT > , makeJSONInstance > , genOpID > + , genAllOpIDs > , genOpCode > , genStrOfOp > , genStrOfKey > @@ -398,6 +399,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) > > -- > 1.7.7.3 >
LGTM
