Revision 4cbe9bda

b/Makefile.am
58 58
	htools/Ganeti \
59 59
	htools/Ganeti/Confd \
60 60
	htools/Ganeti/HTools \
61
	htools/Ganeti/HTools/Program
61
	htools/Ganeti/HTools/Program \
62
	htools/Ganeti/Query
62 63

  
63 64
DIRS = \
64 65
	autotools \
......
415 416
	htools/Ganeti/OpCodes.hs \
416 417
	htools/Ganeti/Rpc.hs \
417 418
	htools/Ganeti/Qlang.hs \
419
	htools/Ganeti/Query/Query.hs \
418 420
	htools/Ganeti/Queryd.hs \
419 421
	htools/Ganeti/Runtime.hs \
420 422
	htools/Ganeti/Ssconf.hs \
......
1464 1466
	rm -rf $(APIDOC_HS_DIR)/*
1465 1467
	@mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/HTools/Program
1466 1468
	@mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/Confd
1469
	@mkdir_p@ $(APIDOC_HS_DIR)/Ganeti/Query
1467 1470
	$(HSCOLOUR) -print-css > $(APIDOC_HS_DIR)/Ganeti/hscolour.css
1468 1471
	$(LN_S) ../hscolour.css $(APIDOC_HS_DIR)/Ganeti/HTools/hscolour.css
1469 1472
	$(LN_S) ../hscolour.css $(APIDOC_HS_DIR)/Ganeti/Confd/hscolour.css
b/htools/Ganeti/Qlang.hs
28 28
module Ganeti.Qlang
29 29
    ( Filter(..)
30 30
    , FilterValue(..)
31
    , Fields
31 32
    , Query(..)
32 33
    , QueryResult(..)
33 34
    , QueryFields(..)
34 35
    , QueryFieldsResult(..)
36
    , FieldType(..)
35 37
    , FieldDefinition(..)
36 38
    , ResultEntry(..)
39
    , ResultStatus(..)
37 40
    , ItemType(..)
38 41
    , checkRS
39 42
    ) where
......
46 49

  
47 50
import qualified Ganeti.Constants as C
48 51
import Ganeti.THH
52
import Ganeti.HTools.JSON
49 53

  
50 54
-- * THH declarations, that require ordering.
51 55

  
......
93 97
  ])
94 98
$(makeJSONInstance ''ItemType)
95 99

  
96
-- * Main Qlang queries and responses.
97

  
98
-- | Query2 query.
99
data Query = Query ItemType Fields (Maybe Filter)
100

  
101
-- | Query2 result.
102
data QueryResult = QueryResult [ FieldDefinition ] [ ResultEntry ]
103

  
104
-- | Query2 Fields query.
105
-- (to get supported fields names, descriptions, and types)
106
data QueryFields = QueryFields ItemType Fields
107

  
108
-- | Query2 Fields result.
109
data QueryFieldsResult = QueryFieldsResult [ FieldDefinition ]
110

  
111 100
-- * Sub data types for query2 queries and responses.
112 101

  
113 102
-- | List of requested fields.
......
249 238
-- | Regexp to apply to the filter value, for filteriong purposes.
250 239
type FilterRegexp = String
251 240

  
252
-- | Definition of a field.
253
data FieldDefinition = FieldDefinition FieldName FieldTitle FieldType FieldDoc
254

  
255 241
-- | Name of a field.
256 242
type FieldName = String
257 243
-- | Title of a field, when represented in tabular format.
......
259 245
-- | Human redable description of a field.
260 246
type FieldDoc = String
261 247

  
248
-- | Definition of a field.
249
$(buildObject "FieldDefinition" "fdef"
250
  [ simpleField "name"  [t| FieldName  |] -- FIXME: the name has restrictions
251
  , simpleField "title" [t| FieldTitle |]
252
  , simpleField "kind"  [t| FieldType  |]
253
  , simpleField "doc"   [t| FieldDoc   |]
254
  ])
255

  
262 256
--- | Single field entry result.
263 257
data ResultEntry = ResultEntry ResultStatus (Maybe ResultValue)
258
                   deriving (Show, Read, Eq)
259

  
260
instance JSON ResultEntry where
261
  showJSON (ResultEntry rs rv) =
262
    showJSON (showJSON rs, maybe JSNull showJSON rv)
263
  readJSON v = do
264
    (rs, rv) <- readJSON v
265
    rv' <- case rv of
266
             JSNull -> return Nothing
267
             x -> readJSON x
268
    return $ ResultEntry rs rv'
269

  
270
-- | The type of one result row.
271
type ResultRow = [ ResultEntry ]
264 272

  
265 273
-- | Value of a field, in json encoding.
266 274
-- (its type will be depending on ResultStatus and FieldType)
267 275
type ResultValue = JSValue
276

  
277
-- * Main Qlang queries and responses.
278

  
279
-- | Query2 query.
280
data Query = Query ItemType Fields Filter
281

  
282
-- | Query2 result.
283
$(buildObject "QueryResult" "qres"
284
  [ simpleField "fields" [t| [ FieldDefinition ] |]
285
  , simpleField "data"   [t| [ ResultRow       ] |]
286
  ])
287

  
288
-- | Query2 Fields query.
289
-- (to get supported fields names, descriptions, and types)
290
data QueryFields = QueryFields ItemType Fields
291

  
292
-- | Query2 Fields result.
293
data QueryFieldsResult = QueryFieldsResult [ FieldDefinition ]
b/htools/Ganeti/Query/Query.hs
1
{-| Implementation of the Ganeti Query2 functionality.
2

  
3
 -}
4

  
5
{-
6

  
7
Copyright (C) 2012 Google Inc.
8

  
9
This program is free software; you can redistribute it and/or modify
10
it under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2 of the License, or
12
(at your option) any later version.
13

  
14
This program is distributed in the hope that it will be useful, but
15
WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17
General Public License for more details.
18

  
19
You should have received a copy of the GNU General Public License
20
along with this program; if not, write to the Free Software
21
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22
02110-1301, USA.
23

  
24
-}
25

  
26
module Ganeti.Query.Query
27
    ( query
28
    ) where
29

  
30
import Ganeti.BasicTypes
31
import Ganeti.Qlang
32
import Ganeti.Objects
33

  
34
-- | Main query execution function.
35
query :: ConfigData   -- ^ The current configuration
36
      -> Query        -- ^ The query (item, fields, filter)
37
      -> IO (Result QueryResult) -- ^ Result
38
query _ (Query qkind _ _) =
39
  return . Bad $ "Query '" ++ show qkind ++ "' not supported"
b/htools/Ganeti/Queryd.hs
48 48
import Ganeti.BasicTypes
49 49
import Ganeti.Logging
50 50
import Ganeti.Luxi
51

  
51
import qualified Ganeti.Qlang as Qlang
52
import Ganeti.Query.Query
52 53

  
53 54
-- | A type for functions that can return the configuration when
54 55
-- executed.
......
126 127
               TagInstance -> instTags <$> Config.getInstance cfg name
127 128
  in return (J.showJSON <$> tags)
128 129

  
130
handleCall cfg (Query qkind qfields qfilter) = do
131
  result <- query cfg (Qlang.Query qkind qfields qfilter)
132
  return $ J.showJSON <$> result
133

  
129 134
handleCall _ op =
130 135
  return . Bad $ "Luxi call '" ++ strOfOp op ++ "' not implemented"
131 136

  

Also available in: Unified diff