Revision 4b71f30c
b/htools/Ganeti/Luxi.hs | ||
---|---|---|
113 | 113 |
-- | Currently supported Luxi operations and JSON serialization. |
114 | 114 |
$(genLuxiOp "LuxiOp" |
115 | 115 |
[(luxiReqQuery, |
116 |
[ ("what", [t| QrViaLuxi |], [| id |])
|
|
117 |
, ("fields", [t| [String] |], [| id |])
|
|
118 |
, ("qfilter", [t| Qlang.Filter |], [| id |])
|
|
116 |
[ ("what", [t| QrViaLuxi |]) |
|
117 |
, ("fields", [t| [String] |]) |
|
118 |
, ("qfilter", [t| Qlang.Filter |]) |
|
119 | 119 |
]) |
120 | 120 |
, (luxiReqQueryNodes, |
121 |
[ ("names", [t| [String] |], [| id |])
|
|
122 |
, ("fields", [t| [String] |], [| id |])
|
|
123 |
, ("lock", [t| Bool |], [| id |])
|
|
121 |
[ ("names", [t| [String] |]) |
|
122 |
, ("fields", [t| [String] |]) |
|
123 |
, ("lock", [t| Bool |]) |
|
124 | 124 |
]) |
125 | 125 |
, (luxiReqQueryGroups, |
126 |
[ ("names", [t| [String] |], [| id |])
|
|
127 |
, ("fields", [t| [String] |], [| id |])
|
|
128 |
, ("lock", [t| Bool |], [| id |])
|
|
126 |
[ ("names", [t| [String] |]) |
|
127 |
, ("fields", [t| [String] |]) |
|
128 |
, ("lock", [t| Bool |]) |
|
129 | 129 |
]) |
130 | 130 |
, (luxiReqQueryInstances, |
131 |
[ ("names", [t| [String] |], [| id |])
|
|
132 |
, ("fields", [t| [String] |], [| id |])
|
|
133 |
, ("lock", [t| Bool |], [| id |])
|
|
131 |
[ ("names", [t| [String] |]) |
|
132 |
, ("fields", [t| [String] |]) |
|
133 |
, ("lock", [t| Bool |]) |
|
134 | 134 |
]) |
135 | 135 |
, (luxiReqQueryJobs, |
136 |
[ ("ids", [t| [Int] |], [| id |])
|
|
137 |
, ("fields", [t| [String] |], [| id |])
|
|
136 |
[ ("ids", [t| [Int] |]) |
|
137 |
, ("fields", [t| [String] |]) |
|
138 | 138 |
]) |
139 | 139 |
, (luxiReqQueryExports, |
140 |
[ ("nodes", [t| [String] |], [| id |])
|
|
141 |
, ("lock", [t| Bool |], [| id |])
|
|
140 |
[ ("nodes", [t| [String] |]) |
|
141 |
, ("lock", [t| Bool |]) |
|
142 | 142 |
]) |
143 | 143 |
, (luxiReqQueryConfigValues, |
144 |
[ ("fields", [t| [String] |], [| id |]) ]
|
|
144 |
[ ("fields", [t| [String] |]) ] |
|
145 | 145 |
) |
146 | 146 |
, (luxiReqQueryClusterInfo, []) |
147 | 147 |
, (luxiReqQueryTags, |
148 |
[ ("kind", [t| String |], [| id |])
|
|
149 |
, ("name", [t| String |], [| id |])
|
|
148 |
[ ("kind", [t| String |]) |
|
149 |
, ("name", [t| String |]) |
|
150 | 150 |
]) |
151 | 151 |
, (luxiReqSubmitJob, |
152 |
[ ("job", [t| [OpCode] |], [| id |]) ]
|
|
152 |
[ ("job", [t| [OpCode] |]) ] |
|
153 | 153 |
) |
154 | 154 |
, (luxiReqSubmitManyJobs, |
155 |
[ ("ops", [t| [[OpCode]] |], [| id |]) ]
|
|
155 |
[ ("ops", [t| [[OpCode]] |]) ] |
|
156 | 156 |
) |
157 | 157 |
, (luxiReqWaitForJobChange, |
158 |
[ ("job", [t| Int |], [| id |])
|
|
159 |
, ("fields", [t| [String]|], [| id |])
|
|
160 |
, ("prev_job", [t| JSValue |], [| id |])
|
|
161 |
, ("prev_log", [t| JSValue |], [| id |])
|
|
162 |
, ("tmout", [t| Int |], [| id |])
|
|
158 |
[ ("job", [t| Int |]) |
|
159 |
, ("fields", [t| [String]|]) |
|
160 |
, ("prev_job", [t| JSValue |]) |
|
161 |
, ("prev_log", [t| JSValue |]) |
|
162 |
, ("tmout", [t| Int |]) |
|
163 | 163 |
]) |
164 | 164 |
, (luxiReqArchiveJob, |
165 |
[ ("job", [t| Int |], [| id |]) ]
|
|
165 |
[ ("job", [t| Int |]) ] |
|
166 | 166 |
) |
167 | 167 |
, (luxiReqAutoArchiveJobs, |
168 |
[ ("age", [t| Int |], [| id |])
|
|
169 |
, ("tmout", [t| Int |], [| id |])
|
|
168 |
[ ("age", [t| Int |]) |
|
169 |
, ("tmout", [t| Int |]) |
|
170 | 170 |
]) |
171 | 171 |
, (luxiReqCancelJob, |
172 |
[ ("job", [t| Int |], [| id |]) ]
|
|
172 |
[ ("job", [t| Int |]) ] |
|
173 | 173 |
) |
174 | 174 |
, (luxiReqSetDrainFlag, |
175 |
[ ("flag", [t| Bool |], [| id |]) ]
|
|
175 |
[ ("flag", [t| Bool |]) ] |
|
176 | 176 |
) |
177 | 177 |
, (luxiReqSetWatcherPause, |
178 |
[ ("duration", [t| Double |], [| id |]) ]
|
|
178 |
[ ("duration", [t| Double |]) ] |
|
179 | 179 |
) |
180 | 180 |
]) |
181 | 181 |
|
b/htools/Ganeti/THH.hs | ||
---|---|---|
52 | 52 |
, buildParam |
53 | 53 |
) where |
54 | 54 |
|
55 |
import Control.Monad (liftM, liftM2)
|
|
55 |
import Control.Monad (liftM) |
|
56 | 56 |
import Data.Char |
57 | 57 |
import Data.List |
58 | 58 |
import qualified Data.Set as Set |
... | ... | |
499 | 499 |
genStrOfKey = genConstrToStr ensureLower |
500 | 500 |
|
501 | 501 |
-- | LuxiOp parameter type. |
502 |
type LuxiParam = (String, Q Type, Q Exp)
|
|
502 |
type LuxiParam = (String, Q Type) |
|
503 | 503 |
|
504 | 504 |
-- | Generates the LuxiOp data type. |
505 | 505 |
-- |
... | ... | |
508 | 508 |
-- We can't use anything less generic, because the way different |
509 | 509 |
-- operations are serialized differs on both parameter- and top-level. |
510 | 510 |
-- |
511 |
-- There are three things to be defined for each parameter:
|
|
511 |
-- There are two things to be defined for each parameter:
|
|
512 | 512 |
-- |
513 | 513 |
-- * name |
514 | 514 |
-- |
515 | 515 |
-- * type |
516 | 516 |
-- |
517 |
-- * operation; this is the operation performed on the parameter before |
|
518 |
-- serialization |
|
519 |
-- |
|
520 | 517 |
genLuxiOp :: String -> [(String, [LuxiParam])] -> Q [Dec] |
521 | 518 |
genLuxiOp name cons = do |
522 | 519 |
decl_d <- mapM (\(cname, fields) -> do |
523 |
fields' <- mapM (\(_, qt, _) ->
|
|
520 |
fields' <- mapM (\(_, qt) -> |
|
524 | 521 |
qt >>= \t -> return (NotStrict, t)) |
525 | 522 |
fields |
526 | 523 |
return $ NormalC (mkName cname) fields') |
... | ... | |
534 | 531 |
|
535 | 532 |
-- | Generates the \"save\" expression for a single luxi parameter. |
536 | 533 |
saveLuxiField :: Name -> LuxiParam -> Q Exp |
537 |
saveLuxiField fvar (_, qt, fn) =
|
|
538 |
[| JSON.showJSON ( $(liftM2 appFn fn $ varE fvar) ) |]
|
|
534 |
saveLuxiField fvar (_, qt) = |
|
535 |
[| JSON.showJSON $(varE fvar) |]
|
|
539 | 536 |
|
540 | 537 |
-- | Generates the \"save\" clause for entire LuxiOp constructor. |
541 | 538 |
saveLuxiConstructor :: (String, [LuxiParam]) -> Q Clause |
542 | 539 |
saveLuxiConstructor (sname, fields) = do |
543 | 540 |
let cname = mkName sname |
544 |
fnames = map (\(nm, _, _) -> mkName nm) fields
|
|
541 |
fnames = map (mkName . fst) fields
|
|
545 | 542 |
pat = conP cname (map varP fnames) |
546 | 543 |
flist = map (uncurry saveLuxiField) (zip fnames fields) |
547 | 544 |
finval = if null flist |
Also available in: Unified diff