We do this not quite generically, which means we have to add another layer in the call chain, and rename the current query function, plus add special-case code for each query type. Hopefully we will be able to improve on this in the future.
A (good) side effect of this patch is that we get the desired ordering when names are requested, matching the Python code. Signed-off-by: Iustin Pop <[email protected]> --- htools/Ganeti/Query/Query.hs | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/htools/Ganeti/Query/Query.hs b/htools/Ganeti/Query/Query.hs index a17a920..875e870 100644 --- a/htools/Ganeti/Query/Query.hs +++ b/htools/Ganeti/Query/Query.hs @@ -57,6 +57,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Map as Map import Ganeti.BasicTypes +import Ganeti.Config import Ganeti.JSON import Ganeti.Rpc import Ganeti.Query.Language @@ -66,6 +67,7 @@ import Ganeti.Query.Types import Ganeti.Query.Node import Ganeti.Query.Group import Ganeti.Objects +import Ganeti.Utils -- * Helper functions @@ -146,13 +148,23 @@ query :: ConfigData -- ^ The current configuration -> Bool -- ^ Whether to collect live data -> Query -- ^ The query (item, fields, filter) -> IO (Result QueryResult) -- ^ Result +query cfg live qry = queryInner cfg live qry $ getRequestedNames qry -query cfg live (Query QRNode fields qfilter) = runResultT $ do +-- | Inner query execution function. +queryInner :: ConfigData -- ^ The current configuration + -> Bool -- ^ Whether to collect live data + -> Query -- ^ The query (item, fields, filter) + -> [String] -- ^ Requested names + -> IO (Result QueryResult) -- ^ Result + +queryInner cfg live (Query QRNode fields qfilter) wanted = runResultT $ do cfilter <- resultT $ compileFilter nodeFieldsMap qfilter let selected = getSelectedFields nodeFieldsMap fields (fdefs, fgetters) = unzip selected - nodes = Map.elems . fromContainer $ configNodes cfg live' = live && needsLiveData fgetters + nodes <- resultT $ case wanted of + [] -> Ok . Map.elems . fromContainer $ configNodes cfg + _ -> mapM (getNode cfg) wanted -- runs first pass of the filter, without a runtime context; this -- will limit the nodes that we'll contact for runtime data fnodes <- resultT $ filterM (\n -> evaluateFilter cfg Nothing n cfilter) nodes @@ -163,21 +175,23 @@ query cfg live (Query QRNode fields qfilter) = runResultT $ do nruntimes return QueryResult { qresFields = fdefs, qresData = fdata } -query cfg _ (Query QRGroup fields qfilter) = return $ do +queryInner cfg _ (Query QRGroup fields qfilter) wanted = return $ do -- FIXME: want_diskparams is defaulted to false and not taken as parameter -- This is because the type for DiskParams is right now too generic for merges -- (or else I cannot see how to do this with curent implementation) cfilter <- compileFilter groupFieldsMap qfilter let selected = getSelectedFields groupFieldsMap fields (fdefs, fgetters) = unzip selected - groups = Map.elems . fromContainer $ configNodegroups cfg + groups <- case wanted of + [] -> Ok . Map.elems . fromContainer $ configNodegroups cfg + _ -> mapM (getGroup cfg) wanted -- there is no live data for groups, so filtering is much simpler fgroups <- filterM (\n -> evaluateFilter cfg Nothing n cfilter) groups let fdata = map (\node -> map (execGetter cfg GroupRuntime node) fgetters) fgroups return QueryResult {qresFields = fdefs, qresData = fdata } -query _ _ (Query qkind _ _) = +queryInner _ _ (Query qkind _ _) _ = return . Bad $ "Query '" ++ show qkind ++ "' not supported" -- | Query fields call. -- 1.7.10.4
