Revision 88b58ed6 src/Ganeti/Query/Instance.hs

b/src/Ganeti/Query/Instance.hs
35 35
import Data.Monoid
36 36
import qualified Data.Map as Map
37 37
import qualified Text.JSON as J
38
import Text.Printf
38 39

  
39 40
import Ganeti.BasicTypes
40 41
import Ganeti.Common
......
50 51
import Ganeti.Rpc
51 52
import Ganeti.Storage.Utils
52 53
import Ganeti.Types
54
import Ganeti.Utils (formatOrdinal)
53 55

  
54 56
-- | The LiveInfo structure packs additional information beside the
55 57
-- 'InstanceInfo'. We also need to know whether the instance information was
......
134 136
  map (buildBeParamField beParamGetter) allBeParamFields ++
135 137
  map (buildHvParamField hvParamGetter) (C.toList C.hvsParameters) ++
136 138

  
139
  -- Aggregate disk parameter fields
140
  [ (FieldDefinition "disk_usage" "DiskUsage" QFTUnit
141
     "Total disk space used by instance on each of its nodes; this is not the\
142
     \ disk size visible to the instance, but the usage on the node",
143
     FieldSimple (rsNormal . getDiskSizeRequirements), QffNormal),
144

  
145
    (FieldDefinition "disk.count" "Disks" QFTNumber
146
     "Number of disks",
147
     FieldSimple (rsNormal . length . instDisks), QffNormal),
148

  
149
    (FieldDefinition "disk.sizes" "Disk_sizes" QFTOther
150
     "List of disk sizes",
151
     FieldSimple (rsNormal . map diskSize . instDisks), QffNormal),
152

  
153
    (FieldDefinition "disk.spindles" "Disk_spindles" QFTOther
154
     "List of disk spindles",
155
     FieldSimple (rsNormal . map (MaybeForJSON . diskSpindles) .
156
                  instDisks),
157
     QffNormal),
158

  
159
    (FieldDefinition "disk.names" "Disk_names" QFTOther
160
     "List of disk names",
161
     FieldSimple (rsNormal . map (MaybeForJSON . diskName) .
162
                  instDisks),
163
     QffNormal),
164

  
165
    (FieldDefinition "disk.uuids" "Disk_UUIDs" QFTOther
166
     "List of disk UUIDs",
167
     FieldSimple (rsNormal . map diskUuid . instDisks), QffNormal)
168
  ] ++
169

  
170
  -- Per-disk parameter fields
171
  fillNumberFields C.maxDisks
172
  [ (fieldDefinitionCompleter "disk.size/%d" "Disk/%d" QFTUnit
173
     "Disk size of %s disk",
174
     getFillableField instDisks diskSize, QffNormal),
175

  
176
    (fieldDefinitionCompleter "disk.spindles/%d" "DiskSpindles/%d" QFTNumber
177
     "Spindles of %s disk",
178
     getFillableOptionalField instDisks diskSpindles, QffNormal),
179

  
180
    (fieldDefinitionCompleter "disk.name/%d" "DiskName/%d" QFTText
181
     "Name of %s disk",
182
     getFillableOptionalField instDisks diskName, QffNormal),
183

  
184
    (fieldDefinitionCompleter "disk.uuid/%d" "DiskUUID/%d" QFTText
185
     "UUID of %s disk",
186
     getFillableField instDisks diskUuid, QffNormal)
187
  ] ++
188

  
137 189
  -- Live fields using special getters
138 190
  [ (FieldDefinition "status" "Status" QFTText
139 191
     statusDocText,
......
153 205

  
154 206
-- * Helper functions for node property retrieval
155 207

  
208
-- | Creates a function which produces a FieldGetter when fed an index. Works
209
-- for fields that may not return a value, expressed through the Maybe monad.
210
getFillableOptionalField :: (J.JSON b)
211
                         => (Instance -> [a]) -- ^ Extracts a list of objects
212
                         -> (a -> Maybe b)    -- ^ Possibly gets a property
213
                                              -- from an object
214
                         -> Int               -- ^ Index in list to use
215
                         -> FieldGetter Instance Runtime -- ^ Result
216
getFillableOptionalField extractor optPropertyGetter index =
217
  FieldSimple(\inst -> rsMaybeUnavail $ do
218
                         obj <- maybeAt index $ extractor inst
219
                         optPropertyGetter obj)
220

  
221
-- | Creates a function which produces a FieldGetter when fed an index.
222
-- Works only for fields that surely return a value.
223
getFillableField :: (J.JSON b)
224
                    => (Instance -> [a]) -- ^ Extracts a list of objects
225
                    -> (a -> b)          -- ^ Gets a property from an object
226
                    -> Int               -- ^ Index in list to use
227
                    -> FieldGetter Instance Runtime -- ^ Result
228
getFillableField extractor propertyGetter index =
229
  let optPropertyGetter = Just . propertyGetter
230
  in getFillableOptionalField extractor optPropertyGetter index
231

  
232
-- | Retrieves a value from an array at an index, using the Maybe monad to
233
-- indicate failure.
234
maybeAt :: Int -> [a] -> Maybe a
235
maybeAt index list
236
  | index >= length list = Nothing
237
  | otherwise            = Just $ list !! index
238

  
239
-- | Primed with format strings for everything but the type, it consumes two
240
-- values and uses them to complete the FieldDefinition.
241
-- Warning: a bit unsafe as it uses printf. Handle with care.
242
fieldDefinitionCompleter :: (PrintfArg t1) => (PrintfArg t2)
243
                         => FieldName
244
                         -> FieldTitle
245
                         -> FieldType
246
                         -> FieldDoc
247
                         -> t1
248
                         -> t2
249
                         -> FieldDefinition
250
fieldDefinitionCompleter fName fTitle fType fDoc firstVal secondVal =
251
  FieldDefinition (printf fName firstVal)
252
                  (printf fTitle firstVal)
253
                  fType
254
                  (printf fDoc secondVal)
255

  
256
-- | Given an incomplete field definition and values that can complete it,
257
-- return a fully functional FieldData. Cannot work for all cases, should be
258
-- extended as necessary.
259
fillIncompleteFields :: (t1 -> t2 -> FieldDefinition,
260
                         t1 -> FieldGetter a b,
261
                         QffMode)
262
                     -> t1
263
                     -> t2
264
                     -> FieldData a b
265
fillIncompleteFields (iDef, iGet, mode) firstVal secondVal =
266
  (iDef firstVal secondVal, iGet firstVal, mode)
267

  
268
-- | Given fields that describe lists, fill their definitions with appropriate
269
-- index representations.
270
fillNumberFields :: (Integral t1)
271
                 => Int
272
                 -> [(t1 -> String -> FieldDefinition,
273
                      t1 -> FieldGetter a b,
274
                      QffMode)]
275
                 -> FieldList a b
276
fillNumberFields numFills fieldsToFill = do
277
  index <- take numFills [0..]
278
  field <- fieldsToFill
279
  return . fillIncompleteFields field index . formatOrdinal $ index + 1
280

  
281
-- * Various helper functions for property retrieval
282

  
156 283
-- | Helper function for primary node retrieval
157 284
getPrimaryNode :: ConfigData -> Instance -> ErrorResult Node
158 285
getPrimaryNode cfg = getInstPrimaryNode cfg . instName

Also available in: Unified diff