root / htools / Ganeti / Qlang.hs @ a583ec5d
History | View | Annotate | Download (9.4 kB)
1 | ac13f473 | Guido Trotter | {-# LANGUAGE TemplateHaskell #-} |
---|---|---|---|
2 | ac13f473 | Guido Trotter | |
3 | ac13f473 | Guido Trotter | {-| Implementation of the Ganeti Query2 language. |
4 | ac13f473 | Guido Trotter | |
5 | ac13f473 | Guido Trotter | -} |
6 | ac13f473 | Guido Trotter | |
7 | ac13f473 | Guido Trotter | {- |
8 | ac13f473 | Guido Trotter | |
9 | ac13f473 | Guido Trotter | Copyright (C) 2012 Google Inc. |
10 | ac13f473 | Guido Trotter | |
11 | ac13f473 | Guido Trotter | This program is free software; you can redistribute it and/or modify |
12 | ac13f473 | Guido Trotter | it under the terms of the GNU General Public License as published by |
13 | ac13f473 | Guido Trotter | the Free Software Foundation; either version 2 of the License, or |
14 | ac13f473 | Guido Trotter | (at your option) any later version. |
15 | ac13f473 | Guido Trotter | |
16 | ac13f473 | Guido Trotter | This program is distributed in the hope that it will be useful, but |
17 | ac13f473 | Guido Trotter | WITHOUT ANY WARRANTY; without even the implied warranty of |
18 | ac13f473 | Guido Trotter | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
19 | ac13f473 | Guido Trotter | General Public License for more details. |
20 | ac13f473 | Guido Trotter | |
21 | ac13f473 | Guido Trotter | You should have received a copy of the GNU General Public License |
22 | ac13f473 | Guido Trotter | along with this program; if not, write to the Free Software |
23 | ac13f473 | Guido Trotter | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
24 | ac13f473 | Guido Trotter | 02110-1301, USA. |
25 | ac13f473 | Guido Trotter | |
26 | ac13f473 | Guido Trotter | -} |
27 | ac13f473 | Guido Trotter | |
28 | dc6a0f82 | Iustin Pop | module Ganeti.Qlang |
29 | b647b6d7 | Iustin Pop | ( Filter(..) |
30 | e8a25d62 | Iustin Pop | , FilterValue(..) |
31 | b647b6d7 | Iustin Pop | , Query(..) |
32 | b647b6d7 | Iustin Pop | , QueryResult(..) |
33 | b647b6d7 | Iustin Pop | , QueryFields(..) |
34 | b647b6d7 | Iustin Pop | , QueryFieldsResult(..) |
35 | b647b6d7 | Iustin Pop | , FieldDefinition(..) |
36 | b647b6d7 | Iustin Pop | , ResultEntry(..) |
37 | 8a9ee1e9 | Iustin Pop | , ItemType(..) |
38 | ac13f473 | Guido Trotter | ) where |
39 | ac13f473 | Guido Trotter | |
40 | e8a25d62 | Iustin Pop | import Control.Applicative |
41 | e8a25d62 | Iustin Pop | import Data.Ratio (numerator, denominator) |
42 | e8a25d62 | Iustin Pop | import Text.JSON.Pretty (pp_value) |
43 | ac13f473 | Guido Trotter | import Text.JSON.Types |
44 | ac13f473 | Guido Trotter | import Text.JSON |
45 | ac13f473 | Guido Trotter | |
46 | ac13f473 | Guido Trotter | import qualified Ganeti.Constants as C |
47 | ac13f473 | Guido Trotter | import Ganeti.THH |
48 | ac13f473 | Guido Trotter | |
49 | ac13f473 | Guido Trotter | -- * THH declarations, that require ordering. |
50 | ac13f473 | Guido Trotter | |
51 | ac13f473 | Guido Trotter | -- | Status of a query field. |
52 | ac13f473 | Guido Trotter | $(declareIADT "ResultStatus" |
53 | ac13f473 | Guido Trotter | [ ("RSNormal", 'C.rsNormal ) |
54 | ac13f473 | Guido Trotter | , ("RSUnknown", 'C.rsUnknown ) |
55 | ac13f473 | Guido Trotter | , ("RSNoData", 'C.rsNodata ) |
56 | ac13f473 | Guido Trotter | , ("RSUnavail", 'C.rsUnavail ) |
57 | ac13f473 | Guido Trotter | , ("RSOffline", 'C.rsOffline ) |
58 | ac13f473 | Guido Trotter | ]) |
59 | ac13f473 | Guido Trotter | $(makeJSONInstance ''ResultStatus) |
60 | ac13f473 | Guido Trotter | |
61 | ac13f473 | Guido Trotter | -- | Type of a query field. |
62 | ac13f473 | Guido Trotter | $(declareSADT "FieldType" |
63 | ac13f473 | Guido Trotter | [ ("QFTUnknown", 'C.qftUnknown ) |
64 | ac13f473 | Guido Trotter | , ("QFTText", 'C.qftText ) |
65 | ac13f473 | Guido Trotter | , ("QFTBool", 'C.qftBool ) |
66 | ac13f473 | Guido Trotter | , ("QFTNumber", 'C.qftNumber ) |
67 | ac13f473 | Guido Trotter | , ("QFTUnit", 'C.qftUnit ) |
68 | ac13f473 | Guido Trotter | , ("QFTTimestamp", 'C.qftTimestamp ) |
69 | ac13f473 | Guido Trotter | , ("QFTOther", 'C.qftOther ) |
70 | ac13f473 | Guido Trotter | ]) |
71 | ac13f473 | Guido Trotter | $(makeJSONInstance ''FieldType) |
72 | ac13f473 | Guido Trotter | |
73 | dc6a0f82 | Iustin Pop | -- | Supported items on which Qlang works. |
74 | ac13f473 | Guido Trotter | $(declareSADT "ItemType" |
75 | ac13f473 | Guido Trotter | [ ("QRCluster", 'C.qrCluster ) |
76 | ac13f473 | Guido Trotter | , ("QRInstance", 'C.qrInstance ) |
77 | ac13f473 | Guido Trotter | , ("QRNode", 'C.qrNode ) |
78 | ac13f473 | Guido Trotter | , ("QRLock", 'C.qrLock ) |
79 | ac13f473 | Guido Trotter | , ("QRGroup", 'C.qrGroup ) |
80 | ac13f473 | Guido Trotter | , ("QROs", 'C.qrOs ) |
81 | ac13f473 | Guido Trotter | , ("QRJob", 'C.qrJob ) |
82 | ac13f473 | Guido Trotter | , ("QRExport", 'C.qrExport ) |
83 | ac13f473 | Guido Trotter | ]) |
84 | ac13f473 | Guido Trotter | $(makeJSONInstance ''ItemType) |
85 | ac13f473 | Guido Trotter | |
86 | dc6a0f82 | Iustin Pop | -- * Main Qlang queries and responses. |
87 | ac13f473 | Guido Trotter | |
88 | ac13f473 | Guido Trotter | -- | Query2 query. |
89 | ac13f473 | Guido Trotter | data Query = Query ItemType Fields (Maybe Filter) |
90 | ac13f473 | Guido Trotter | |
91 | ac13f473 | Guido Trotter | -- | Query2 result. |
92 | ac13f473 | Guido Trotter | data QueryResult = QueryResult [ FieldDefinition ] [ ResultEntry ] |
93 | ac13f473 | Guido Trotter | |
94 | ac13f473 | Guido Trotter | -- | Query2 Fields query. |
95 | ac13f473 | Guido Trotter | -- (to get supported fields names, descriptions, and types) |
96 | ac13f473 | Guido Trotter | data QueryFields = QueryFields ItemType Fields |
97 | ac13f473 | Guido Trotter | |
98 | ac13f473 | Guido Trotter | -- | Query2 Fields result. |
99 | ac13f473 | Guido Trotter | data QueryFieldsResult = QueryFieldsResult [ FieldDefinition ] |
100 | ac13f473 | Guido Trotter | |
101 | ac13f473 | Guido Trotter | -- * Sub data types for query2 queries and responses. |
102 | ac13f473 | Guido Trotter | |
103 | ac13f473 | Guido Trotter | -- | List of requested fields. |
104 | ac13f473 | Guido Trotter | type Fields = [ String ] |
105 | ac13f473 | Guido Trotter | |
106 | ac13f473 | Guido Trotter | -- | Query2 filter expression. |
107 | ac13f473 | Guido Trotter | data Filter |
108 | e8a25d62 | Iustin Pop | = EmptyFilter -- ^ No filter at all |
109 | e8a25d62 | Iustin Pop | | AndFilter [ Filter ] -- ^ & [<expression>, ...] |
110 | e8a25d62 | Iustin Pop | | OrFilter [ Filter ] -- ^ | [<expression>, ...] |
111 | e8a25d62 | Iustin Pop | | NotFilter Filter -- ^ ! <expression> |
112 | e8a25d62 | Iustin Pop | | TrueFilter FilterField -- ^ ? <field> |
113 | e8a25d62 | Iustin Pop | | EQFilter FilterField FilterValue -- ^ (=|!=) <field> <value> |
114 | e8a25d62 | Iustin Pop | | LTFilter FilterField FilterValue -- ^ < <field> <value> |
115 | e8a25d62 | Iustin Pop | | GTFilter FilterField FilterValue -- ^ > <field> <value> |
116 | e8a25d62 | Iustin Pop | | LEFilter FilterField FilterValue -- ^ <= <field> <value> |
117 | e8a25d62 | Iustin Pop | | GEFilter FilterField FilterValue -- ^ >= <field> <value> |
118 | e8a25d62 | Iustin Pop | | RegexpFilter FilterField FilterRegexp -- ^ =~ <field> <regexp> |
119 | e8a25d62 | Iustin Pop | | ContainsFilter FilterField FilterValue -- ^ =[] <list-field> <value> |
120 | e8a25d62 | Iustin Pop | deriving (Show, Read, Eq) |
121 | e8a25d62 | Iustin Pop | |
122 | e8a25d62 | Iustin Pop | -- | Serialiser for the 'Filter' data type. |
123 | e8a25d62 | Iustin Pop | showFilter :: Filter -> JSValue |
124 | e8a25d62 | Iustin Pop | showFilter (EmptyFilter) = JSNull |
125 | e8a25d62 | Iustin Pop | showFilter (AndFilter exprs) = |
126 | e8a25d62 | Iustin Pop | JSArray $ (showJSON C.qlangOpAnd):(map showJSON exprs) |
127 | e8a25d62 | Iustin Pop | showFilter (OrFilter exprs) = |
128 | e8a25d62 | Iustin Pop | JSArray $ (showJSON C.qlangOpOr):(map showJSON exprs) |
129 | e8a25d62 | Iustin Pop | showFilter (NotFilter flt) = |
130 | e8a25d62 | Iustin Pop | JSArray [showJSON C.qlangOpNot, showJSON flt] |
131 | e8a25d62 | Iustin Pop | showFilter (TrueFilter field) = |
132 | e8a25d62 | Iustin Pop | JSArray [showJSON C.qlangOpTrue, showJSON field] |
133 | e8a25d62 | Iustin Pop | showFilter (EQFilter field value) = |
134 | e8a25d62 | Iustin Pop | JSArray [showJSON C.qlangOpEqual, showJSON field, showJSON value] |
135 | e8a25d62 | Iustin Pop | showFilter (LTFilter field value) = |
136 | e8a25d62 | Iustin Pop | JSArray [showJSON C.qlangOpLt, showJSON field, showJSON value] |
137 | e8a25d62 | Iustin Pop | showFilter (GTFilter field value) = |
138 | e8a25d62 | Iustin Pop | JSArray [showJSON C.qlangOpGt, showJSON field, showJSON value] |
139 | e8a25d62 | Iustin Pop | showFilter (LEFilter field value) = |
140 | e8a25d62 | Iustin Pop | JSArray [showJSON C.qlangOpLe, showJSON field, showJSON value] |
141 | e8a25d62 | Iustin Pop | showFilter (GEFilter field value) = |
142 | e8a25d62 | Iustin Pop | JSArray [showJSON C.qlangOpGe, showJSON field, showJSON value] |
143 | e8a25d62 | Iustin Pop | showFilter (RegexpFilter field regexp) = |
144 | e8a25d62 | Iustin Pop | JSArray [showJSON C.qlangOpRegexp, showJSON field, showJSON regexp] |
145 | e8a25d62 | Iustin Pop | showFilter (ContainsFilter field value) = |
146 | e8a25d62 | Iustin Pop | JSArray [showJSON C.qlangOpContains, showJSON field, showJSON value] |
147 | e8a25d62 | Iustin Pop | |
148 | e8a25d62 | Iustin Pop | -- | Deserializer for the 'Filter' data type. |
149 | e8a25d62 | Iustin Pop | readFilter :: JSValue -> Result Filter |
150 | e8a25d62 | Iustin Pop | readFilter JSNull = Ok EmptyFilter |
151 | e8a25d62 | Iustin Pop | readFilter (JSArray (JSString op:args)) = |
152 | e8a25d62 | Iustin Pop | readFilterArray (fromJSString op) args |
153 | e8a25d62 | Iustin Pop | readFilter v = |
154 | e8a25d62 | Iustin Pop | Error $ "Cannot deserialise filter: expected array [string, args], got " ++ |
155 | e8a25d62 | Iustin Pop | show (pp_value v) |
156 | e8a25d62 | Iustin Pop | |
157 | e8a25d62 | Iustin Pop | -- | Helper to deserialise an array corresponding to a single filter |
158 | e8a25d62 | Iustin Pop | -- and return the built filter. Note this looks generic but is (at |
159 | e8a25d62 | Iustin Pop | -- least currently) only used for the NotFilter. |
160 | e8a25d62 | Iustin Pop | readFilterArg :: (Filter -> Filter) -- ^ Constructor |
161 | e8a25d62 | Iustin Pop | -> [JSValue] -- ^ Single argument |
162 | e8a25d62 | Iustin Pop | -> Result Filter |
163 | e8a25d62 | Iustin Pop | readFilterArg constr [flt] = constr <$> readJSON flt |
164 | e8a25d62 | Iustin Pop | readFilterArg _ v = Error $ "Cannot deserialise field, expected [filter]\ |
165 | e8a25d62 | Iustin Pop | \ but got " ++ show (pp_value (showJSON v)) |
166 | e8a25d62 | Iustin Pop | |
167 | e8a25d62 | Iustin Pop | -- | Helper to deserialise an array corresponding to a single field |
168 | e8a25d62 | Iustin Pop | -- and return the built filter. |
169 | e8a25d62 | Iustin Pop | readFilterField :: (FilterField -> Filter) -- ^ Constructor |
170 | e8a25d62 | Iustin Pop | -> [JSValue] -- ^ Single argument |
171 | e8a25d62 | Iustin Pop | -> Result Filter |
172 | e8a25d62 | Iustin Pop | readFilterField constr [field] = constr <$> readJSON field |
173 | e8a25d62 | Iustin Pop | readFilterField _ v = Error $ "Cannot deserialise field, expected [fieldname]\ |
174 | e8a25d62 | Iustin Pop | \ but got " ++ show (pp_value (showJSON v)) |
175 | e8a25d62 | Iustin Pop | |
176 | e8a25d62 | Iustin Pop | -- | Helper to deserialise an array corresponding to a field and |
177 | e8a25d62 | Iustin Pop | -- value, returning the built filter. |
178 | e8a25d62 | Iustin Pop | readFilterFieldValue :: (JSON a) => |
179 | e8a25d62 | Iustin Pop | (FilterField -> a -> Filter) -- ^ Constructor |
180 | e8a25d62 | Iustin Pop | -> [JSValue] -- ^ Arguments array |
181 | e8a25d62 | Iustin Pop | -> Result Filter |
182 | e8a25d62 | Iustin Pop | readFilterFieldValue constr [field, value] = |
183 | e8a25d62 | Iustin Pop | constr <$> readJSON field <*> readJSON value |
184 | e8a25d62 | Iustin Pop | readFilterFieldValue _ v = |
185 | e8a25d62 | Iustin Pop | Error $ "Cannot deserialise field/value pair, expected [fieldname, value]\ |
186 | e8a25d62 | Iustin Pop | \ but got " ++ show (pp_value (showJSON v)) |
187 | e8a25d62 | Iustin Pop | |
188 | e8a25d62 | Iustin Pop | -- | Inner deserialiser for 'Filter'. |
189 | e8a25d62 | Iustin Pop | readFilterArray :: String -> [JSValue] -> Result Filter |
190 | e8a25d62 | Iustin Pop | readFilterArray op args |
191 | e8a25d62 | Iustin Pop | | op == C.qlangOpAnd = AndFilter <$> mapM readJSON args |
192 | e8a25d62 | Iustin Pop | | op == C.qlangOpOr = OrFilter <$> mapM readJSON args |
193 | e8a25d62 | Iustin Pop | | op == C.qlangOpNot = readFilterArg NotFilter args |
194 | e8a25d62 | Iustin Pop | | op == C.qlangOpTrue = readFilterField TrueFilter args |
195 | e8a25d62 | Iustin Pop | | op == C.qlangOpEqual = readFilterFieldValue EQFilter args |
196 | e8a25d62 | Iustin Pop | | op == C.qlangOpLt = readFilterFieldValue LTFilter args |
197 | e8a25d62 | Iustin Pop | | op == C.qlangOpGt = readFilterFieldValue GTFilter args |
198 | e8a25d62 | Iustin Pop | | op == C.qlangOpLe = readFilterFieldValue LEFilter args |
199 | e8a25d62 | Iustin Pop | | op == C.qlangOpGe = readFilterFieldValue GEFilter args |
200 | e8a25d62 | Iustin Pop | | op == C.qlangOpRegexp = readFilterFieldValue RegexpFilter args |
201 | e8a25d62 | Iustin Pop | | op == C.qlangOpContains = readFilterFieldValue ContainsFilter args |
202 | e8a25d62 | Iustin Pop | | otherwise = Error $ "Unknown filter operand '" ++ op ++ "'" |
203 | e8a25d62 | Iustin Pop | |
204 | e8a25d62 | Iustin Pop | instance JSON Filter where |
205 | e8a25d62 | Iustin Pop | showJSON = showFilter |
206 | e8a25d62 | Iustin Pop | readJSON = readFilter |
207 | ac13f473 | Guido Trotter | |
208 | ac13f473 | Guido Trotter | -- | Field name to filter on. |
209 | ac13f473 | Guido Trotter | type FilterField = String |
210 | ac13f473 | Guido Trotter | |
211 | ac13f473 | Guido Trotter | -- | Value to compare the field value to, for filtering purposes. |
212 | e8a25d62 | Iustin Pop | data FilterValue = QuotedString String |
213 | e8a25d62 | Iustin Pop | | NumericValue Integer |
214 | e8a25d62 | Iustin Pop | deriving (Read, Show, Eq) |
215 | e8a25d62 | Iustin Pop | |
216 | e8a25d62 | Iustin Pop | -- | Serialiser for 'FilterValue'. The Python code just sends this to |
217 | e8a25d62 | Iustin Pop | -- JSON as-is, so we'll do the same. |
218 | e8a25d62 | Iustin Pop | showFilterValue :: FilterValue -> JSValue |
219 | e8a25d62 | Iustin Pop | showFilterValue (QuotedString str) = showJSON str |
220 | e8a25d62 | Iustin Pop | showFilterValue (NumericValue val) = showJSON val |
221 | e8a25d62 | Iustin Pop | |
222 | e8a25d62 | Iustin Pop | -- | Decoder for 'FilterValue'. We have to see what it contains, since |
223 | e8a25d62 | Iustin Pop | -- the context doesn't give us hints on what to expect. |
224 | e8a25d62 | Iustin Pop | readFilterValue :: JSValue -> Result FilterValue |
225 | e8a25d62 | Iustin Pop | readFilterValue (JSString a) = Ok . QuotedString $ fromJSString a |
226 | e8a25d62 | Iustin Pop | readFilterValue (JSRational _ x) = |
227 | e8a25d62 | Iustin Pop | if denominator x /= 1 |
228 | e8a25d62 | Iustin Pop | then Error $ "Cannot deserialise numeric filter value,\ |
229 | e8a25d62 | Iustin Pop | \ expecting integral but\ |
230 | e8a25d62 | Iustin Pop | \ got a fractional value: " ++ show x |
231 | e8a25d62 | Iustin Pop | else Ok . NumericValue $ numerator x |
232 | e8a25d62 | Iustin Pop | readFilterValue v = Error $ "Cannot deserialise filter value, expecting\ |
233 | e8a25d62 | Iustin Pop | \ string or integer, got " ++ show (pp_value v) |
234 | e8a25d62 | Iustin Pop | |
235 | e8a25d62 | Iustin Pop | instance JSON FilterValue where |
236 | e8a25d62 | Iustin Pop | showJSON = showFilterValue |
237 | e8a25d62 | Iustin Pop | readJSON = readFilterValue |
238 | ac13f473 | Guido Trotter | |
239 | ac13f473 | Guido Trotter | -- | Regexp to apply to the filter value, for filteriong purposes. |
240 | ac13f473 | Guido Trotter | type FilterRegexp = String |
241 | ac13f473 | Guido Trotter | |
242 | ac13f473 | Guido Trotter | -- | Definition of a field. |
243 | ac13f473 | Guido Trotter | data FieldDefinition = FieldDefinition FieldName FieldTitle FieldType FieldDoc |
244 | ac13f473 | Guido Trotter | |
245 | ac13f473 | Guido Trotter | -- | Name of a field. |
246 | ac13f473 | Guido Trotter | type FieldName = String |
247 | ac13f473 | Guido Trotter | -- | Title of a field, when represented in tabular format. |
248 | ac13f473 | Guido Trotter | type FieldTitle = String |
249 | ac13f473 | Guido Trotter | -- | Human redable description of a field. |
250 | ac13f473 | Guido Trotter | type FieldDoc = String |
251 | ac13f473 | Guido Trotter | |
252 | ac13f473 | Guido Trotter | --- | Single field entry result. |
253 | ac13f473 | Guido Trotter | data ResultEntry = ResultEntry ResultStatus (Maybe ResultValue) |
254 | ac13f473 | Guido Trotter | |
255 | ac13f473 | Guido Trotter | -- | Value of a field, in json encoding. |
256 | ac13f473 | Guido Trotter | -- (its type will be depending on ResultStatus and FieldType) |
257 | ac13f473 | Guido Trotter | type ResultValue = JSValue |