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