Revision f94a9680 htools/Ganeti/Query/Filter.hs
b/htools/Ganeti/Query/Filter.hs | ||
---|---|---|
69 | 69 |
-- | Compiles a filter based on field names to one based on getters. |
70 | 70 |
compileFilter :: FieldMap a b |
71 | 71 |
-> Filter FilterField |
72 |
-> ErrorResult (Filter (FieldGetter a b)) |
|
72 |
-> ErrorResult (Filter (FieldGetter a b, QffMode))
|
|
73 | 73 |
compileFilter fm = |
74 | 74 |
traverse (\field -> maybe |
75 | 75 |
(Bad . ParameterError $ "Can't find field named '" ++ |
76 | 76 |
field ++ "'") |
77 |
(Ok . snd) (field `Map.lookup` fm)) |
|
77 |
(\(_, g, q) -> Ok (g, q)) (field `Map.lookup` fm)) |
|
78 |
|
|
79 |
-- | Processes a field value given a QffMode. |
|
80 |
qffField :: QffMode -> JSValue -> ErrorResult JSValue |
|
81 |
qffField QffNormal v = Ok v |
|
82 |
qffField QffTimestamp v = |
|
83 |
case v of |
|
84 |
JSArray [secs@(JSRational _ _), JSRational _ _] -> return secs |
|
85 |
_ -> Bad $ ProgrammerError |
|
86 |
"Internal error: Getter returned non-timestamp for QffTimestamp" |
|
78 | 87 |
|
79 | 88 |
-- | Wraps a getter, filter pair. If the getter is 'FieldRuntime' but |
80 | 89 |
-- we don't have a runtime context, we skip the filtering, returning |
... | ... | |
82 | 91 |
wrapGetter :: ConfigData |
83 | 92 |
-> Maybe b |
84 | 93 |
-> a |
85 |
-> FieldGetter a b
|
|
94 |
-> (FieldGetter a b, QffMode)
|
|
86 | 95 |
-> (JSValue -> ErrorResult Bool) |
87 | 96 |
-> ErrorResult Bool |
88 |
wrapGetter cfg b a getter faction =
|
|
97 |
wrapGetter cfg b a (getter, qff) faction =
|
|
89 | 98 |
case tryGetter cfg b a getter of |
90 | 99 |
Nothing -> Ok True -- runtime missing, accepting the value |
91 | 100 |
Just v -> |
92 | 101 |
case v of |
93 |
ResultEntry RSNormal (Just fval) -> faction fval
|
|
102 |
ResultEntry RSNormal (Just fval) -> qffField qff fval >>= faction
|
|
94 | 103 |
ResultEntry RSNormal Nothing -> |
95 | 104 |
Bad $ ProgrammerError |
96 | 105 |
"Internal error: Getter returned RSNormal/Nothing" |
... | ... | |
149 | 158 |
-- 'any' and 'all' do not play nice with monadic values, resulting in |
150 | 159 |
-- either too much memory use or in too many thunks being created. |
151 | 160 |
evaluateFilter :: ConfigData -> Maybe b -> a |
152 |
-> Filter (FieldGetter a b) |
|
161 |
-> Filter (FieldGetter a b, QffMode)
|
|
153 | 162 |
-> ErrorResult Bool |
154 | 163 |
evaluateFilter _ _ _ EmptyFilter = Ok True |
155 | 164 |
evaluateFilter c mb a (AndFilter flts) = helper flts |
Also available in: Unified diff