Revision 91c1a265 src/Ganeti/Query/Filter.hs

b/src/Ganeti/Query/Filter.hs
25 25

  
26 26
{-
27 27

  
28
Copyright (C) 2012 Google Inc.
28
Copyright (C) 2012, 2013 Google Inc.
29 29

  
30 30
This program is free software; you can redistribute it and/or modify
31 31
it under the terms of the GNU General Public License as published by
......
79 79
-- | Processes a field value given a QffMode.
80 80
qffField :: QffMode -> JSValue -> ErrorResult JSValue
81 81
qffField QffNormal    v = Ok v
82
qffField QffHostname  v = Ok v
82 83
qffField QffTimestamp v =
83 84
  case v of
84 85
    JSArray [secs@(JSRational _ _), JSRational _ _] -> return secs
......
92 93
           -> Maybe b
93 94
           -> a
94 95
           -> (FieldGetter a b, QffMode)
95
           -> (JSValue -> ErrorResult Bool)
96
           -> (QffMode -> JSValue -> ErrorResult Bool)
96 97
           -> ErrorResult Bool
97 98
wrapGetter cfg b a (getter, qff) faction =
98 99
  case tryGetter cfg b a getter of
99 100
    Nothing -> Ok True -- runtime missing, accepting the value
100 101
    Just v ->
101 102
      case v of
102
        ResultEntry RSNormal (Just fval) -> qffField qff fval >>= faction
103
        ResultEntry RSNormal (Just fval) -> qffField qff fval >>= faction qff
103 104
        ResultEntry RSNormal Nothing ->
104 105
          Bad $ ProgrammerError
105 106
                "Internal error: Getter returned RSNormal/Nothing"
106 107
        _ -> Ok True -- filter has no data to work, accepting it
107 108

  
109
-- | Wrapper alias over field functions to ignore their first Qff argument.
110
ignoreMode :: a -> QffMode -> a
111
ignoreMode = const
112

  
108 113
-- | Helper to evaluate a filter getter (and the value it generates) in
109 114
-- a boolean context.
110 115
trueFilter :: JSValue -> ErrorResult Bool
......
118 123
-- and for them to be used in multiple contexts.
119 124
type Comparator = (Eq a, Ord a) => a -> a -> Bool
120 125

  
126
-- | Equality checker.
127
--
128
-- This will handle hostnames correctly, if the mode is set to
129
-- 'QffHostname'.
130
eqFilter :: FilterValue -> QffMode -> JSValue -> ErrorResult Bool
131
-- send 'QffNormal' queries to 'binOpFilter'
132
eqFilter flv QffNormal    jsv = binOpFilter (==) flv jsv
133
-- and 'QffTimestamp' as well
134
eqFilter flv QffTimestamp jsv = binOpFilter (==) flv jsv
135
-- error out if we set 'QffHostname' on a non-string field
136
eqFilter _ QffHostname (JSRational _ _) =
137
  Bad . ProgrammerError $ "QffHostname field returned a numeric value"
138
-- test strings via 'compareNameComponent'
139
eqFilter (QuotedString y) QffHostname (JSString x) =
140
  Ok $ goodLookupResult (fromJSString x `compareNameComponent` y)
141
-- send all other combinations (all errors) to 'binOpFilter', which
142
-- has good error messages
143
eqFilter flv _ jsv = binOpFilter (==) flv jsv
144

  
121 145
-- | Helper to evaluate a filder getter (and the value it generates)
122 146
-- in a boolean context. Note the order of arguments is reversed from
123 147
-- the filter definitions (due to the call chain), make sure to
......
178 202
evaluateFilter c mb a (NotFilter flt)  =
179 203
  not <$> evaluateFilter c mb a flt
180 204
evaluateFilter c mb a (TrueFilter getter)  =
181
  wrapGetter c mb a getter trueFilter
205
  wrapGetter c mb a getter $ ignoreMode trueFilter
182 206
evaluateFilter c mb a (EQFilter getter val) =
183
  wrapGetter c mb a getter (binOpFilter (==) val)
207
  wrapGetter c mb a getter (eqFilter val)
184 208
evaluateFilter c mb a (LTFilter getter val) =
185
  wrapGetter c mb a getter (binOpFilter (<) val)
209
  wrapGetter c mb a getter $ ignoreMode (binOpFilter (<) val)
186 210
evaluateFilter c mb a (LEFilter getter val) =
187
  wrapGetter c mb a getter (binOpFilter (<=) val)
211
  wrapGetter c mb a getter $ ignoreMode (binOpFilter (<=) val)
188 212
evaluateFilter c mb a (GTFilter getter val) =
189
  wrapGetter c mb a getter (binOpFilter (>) val)
213
  wrapGetter c mb a getter $ ignoreMode (binOpFilter (>) val)
190 214
evaluateFilter c mb a (GEFilter getter val) =
191
  wrapGetter c mb a getter (binOpFilter (>=) val)
215
  wrapGetter c mb a getter $ ignoreMode (binOpFilter (>=) val)
192 216
evaluateFilter c mb a (RegexpFilter getter re) =
193
  wrapGetter c mb a getter (regexpFilter re)
217
  wrapGetter c mb a getter $ ignoreMode (regexpFilter re)
194 218
evaluateFilter c mb a (ContainsFilter getter val) =
195
  wrapGetter c mb a getter (containsFilter val)
219
  wrapGetter c mb a getter $ ignoreMode (containsFilter val)
196 220

  
197 221
-- | Runs a getter with potentially missing runtime context.
198 222
tryGetter :: ConfigData -> Maybe b -> a -> FieldGetter a b -> Maybe ResultEntry

Also available in: Unified diff