Revision 0ec8cce2

b/man/htools.rst
180 180
  - node spindle count
181 181
  - node tags
182 182
  - exclusive storage value (``Y`` if active, ``N`` otherwise)
183
  - node free spindles
183 184

  
184 185
  The third section contains instance data, with the fields:
185 186

  
b/src/Ganeti/HTools/Backend/Luxi.hs
83 83
  st' <- fromJVal st
84 84
  Qlang.checkRS st' v >>= fromJVal
85 85

  
86
annotateConvert :: String -> String -> String -> Result a -> Result a
87
annotateConvert otype oname oattr =
88
  annotateResult $ otype ++ " '" ++ oname ++
89
    "', error while reading attribute '" ++ oattr ++ "'"
90

  
86 91
-- | Annotate errors when converting values with owner/attribute for
87 92
-- better debugging.
88 93
genericConvert :: (Text.JSON.JSON a) =>
......
92 97
               -> (JSValue, JSValue) -- ^ The value we're trying to convert
93 98
               -> Result a           -- ^ The annotated result
94 99
genericConvert otype oname oattr =
95
  annotateResult (otype ++ " '" ++ oname ++
96
                  "', error while reading attribute '" ++
97
                  oattr ++ "'") . fromJValWithStatus
100
  annotateConvert otype oname oattr . fromJValWithStatus
101

  
102
convertArrayMaybe :: (Text.JSON.JSON a) =>
103
                  String             -- ^ The object type
104
               -> String             -- ^ The object name
105
               -> String             -- ^ The attribute we're trying to convert
106
               -> (JSValue, JSValue) -- ^ The value we're trying to convert
107
               -> Result [Maybe a]   -- ^ The annotated result
108
convertArrayMaybe otype oname oattr (st, v) = do
109
  st' <- fromJVal st
110
  Qlang.checkRS st' v >>=
111
    annotateConvert otype oname oattr . arrayMaybeFromJVal
98 112

  
99 113
-- * Data querying functionality
100 114

  
......
114 128
     ["name", "disk_usage", "be/memory", "be/vcpus",
115 129
      "status", "pnode", "snodes", "tags", "oper_ram",
116 130
      "be/auto_balance", "disk_template",
117
      "be/spindle_use"] Qlang.EmptyFilter
131
      "be/spindle_use", "disk.sizes", "disk.spindles"] Qlang.EmptyFilter
118 132

  
119 133
-- | The input data for cluster query.
120 134
queryClusterInfoMsg :: L.LuxiOp
......
155 169
              -> Result (String, Instance.Instance)
156 170
parseInstance ktn [ name, disk, mem, vcpus
157 171
                  , status, pnode, snodes, tags, oram
158
                  , auto_balance, disk_template, su ] = do
172
                  , auto_balance, disk_template, su
173
                  , dsizes, dspindles ] = do
159 174
  xname <- annotateResult "Parsing new instance" (fromJValWithStatus name)
160 175
  let convert a = genericConvert "Instance" xname a
161 176
  xdisk <- convert "disk_usage" disk
......
173 188
  xauto_balance <- convert "auto_balance" auto_balance
174 189
  xdt <- convert "disk_template" disk_template
175 190
  xsu <- convert "be/spindle_use" su
176
  let inst = Instance.create xname xmem xdisk [Instance.Disk xdisk Nothing]
191
  xdsizes <- convert "disk.sizes" dsizes
192
  xdspindles <- convertArrayMaybe "Instance" xname "disk.spindles" dspindles
193
  let disks = zipWith Instance.Disk xdsizes xdspindles
194
      inst = Instance.create xname xmem xdisk disks
177 195
             xvcpus xrunning xtags xauto_balance xpnode snode xdt xsu []
178 196
  return (xname, inst)
179 197

  
b/src/Ganeti/JSON.hs
40 40
  , asJSObject
41 41
  , asObjectList
42 42
  , tryFromObj
43
  , arrayMaybeFromJVal
43 44
  , tryArrayMaybeFromObj
44 45
  , toArray
45 46
  , optionalJSField
......
142 143
                      JSRecord -> String -> a -> m a
143 144
fromObjWithDefault o k d = liftM (fromMaybe d) $ maybeFromObj o k
144 145

  
146
arrayMaybeFromJVal :: (J.JSON a, Monad m) => J.JSValue -> m [Maybe a]
147
arrayMaybeFromJVal (J.JSArray xs) =
148
  mapM parse xs
149
    where
150
      parse J.JSNull = return Nothing
151
      parse x = liftM Just $ fromJVal x
152
arrayMaybeFromJVal v =
153
  fail $ "Expecting array, got '" ++ show (pp_value v) ++ "'"
154

  
145 155
-- | Reads an array of optional items
146 156
arrayMaybeFromObj :: (J.JSON a, Monad m) =>
147 157
                     JSRecord -> String -> m [Maybe a]
148 158
arrayMaybeFromObj o k =
149 159
  case lookup k o of
150
    Just (J.JSArray xs) -> mapM parse xs
151
      where
152
        parse J.JSNull = return Nothing
153
        parse x = liftM Just $ fromJVal x
160
    Just a -> arrayMaybeFromJVal a
154 161
    _ -> fail $ buildNoKeyError o k
155 162

  
156 163
-- | Wrapper for arrayMaybeFromObj with better diagnostic

Also available in: Unified diff