-- | A definition for ADTs with simple fields.
type SimpleObject = [SimpleConstructor]
+-- | A type alias for a constructor of a regular object.
+type Constructor = (String, [Field])
+
-- * Helper functions
-- | Ensure first letter is lowercase.
-- datatype and the JSON serialisation out of it. We can't use a
-- generic serialisation since we need to be compatible with Ganeti's
-- own, so we have a few quirks to work around.
-genOpCode :: String -- ^ Type name to use
- -> [(String, [Field])] -- ^ Constructor name and parameters
+genOpCode :: String -- ^ Type name to use
+ -> [Constructor] -- ^ Constructor name and parameters
-> Q [Dec]
genOpCode name cons = do
let tname = mkName name
-- | Generates the function pattern returning the list of fields for a
-- given constructor.
-genOpConsFields :: (String, [Field]) -> Clause
+genOpConsFields :: Constructor -> Clause
genOpConsFields (cname, fields) =
let op_id = deCamelCase cname
fvals = map (LitE . StringL) . sort . nub $
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
+genAllOpFields :: String -- ^ Function name
+ -> [Constructor] -- ^ Object definition
-> (Dec, Dec)
genAllOpFields sname opdefs =
let cclauses = map genOpConsFields opdefs
--
-- This builds a per-constructor match clause that contains the
-- respective constructor-serialisation code.
-genSaveOpCode :: Name -- ^ Object ype
- -> String -- ^ Function name
- -> [(String, [Field])] -- ^ Object definition
- -> ((String, [Field]) -> Q Clause) -- ^ Constructor save fn
+genSaveOpCode :: Name -- ^ Object ype
+ -> String -- ^ Function name
+ -> [Constructor] -- ^ Object definition
+ -> (Constructor -> Q Clause) -- ^ Constructor save fn
-> Q (Dec, Dec)
genSaveOpCode tname sname opdefs fn = do
cclauses <- mapM fn opdefs
return $ DoE fstmts'
-- | Generates the loadOpCode function.
-genLoadOpCode :: [(String, [Field])] -> Q (Dec, Dec)
+genLoadOpCode :: [Constructor] -> Q (Dec, Dec)
genLoadOpCode opdefs = do
let fname = mkName "loadOpCode"
arg1 = mkName "v"
--
-- * type
--
-genLuxiOp :: String -> [(String, [Field])] -> Q [Dec]
+genLuxiOp :: String -> [Constructor] -> Q [Dec]
genLuxiOp name cons = do
let tname = mkName name
decl_d <- mapM (\(cname, fields) -> do
[| JSON.showJSON $(varE fvar) |]
-- | Generates the \"save\" clause for entire LuxiOp constructor.
-saveLuxiConstructor :: (String, [Field]) -> Q Clause
+saveLuxiConstructor :: Constructor -> Q Clause
saveLuxiConstructor (sname, fields) = do
let cname = mkName sname
fnames <- mapM (newName . fieldVariable) fields