Synnefo » snf-ganeti

import qualified Text.Regex.PCRE as PCRE

import Ganeti.BasicTypes

import Ganeti.Objects

import Ganeti.Query.Language

import Ganeti.Query.Types

-- | Compiles a filter based on field names to one based on getters.

compileFilter :: FieldMap a b

              -> Filter FilterField

compileFilter fm =

                      (Ok . snd) (field `Map.lookup` fm))

-- | Wraps a getter, filter pair. If the getter is 'FieldRuntime' but

           -> Maybe b

           -> a

           -> FieldGetter a b

wrapGetter cfg b a getter faction =

  case tryGetter cfg b a getter of

    Nothing -> Ok True -- runtime missing, accepting the value

      case v of

        ResultEntry RSNormal (Just fval) -> faction fval

        ResultEntry RSNormal Nothing ->

        _ -> Ok True -- filter has no data to work, accepting it

-- | Helper to evaluate a filter getter (and the value it generates) in

-- a boolean context.

trueFilter (JSBool x) = Ok x

               "' in boolean context"

-- | A type synonim for a rank-2 comparator function. This is used so

-- in a boolean context. Note the order of arguments is reversed from

-- the filter definitions (due to the call chain), make sure to

-- compare in the reverse order too!.

binOpFilter comp (QuotedString y) (JSString x) =

  Ok $ fromJSString x `comp` y

binOpFilter comp (NumericValue y) (JSRational _ x) =

  Ok $ x `comp` fromIntegral y

binOpFilter _ expr actual =

      show (pp_value actual) ++ " with '" ++ show expr ++ "'"

-- | Implements the 'RegexpFilter' matching.

regexpFilter re (JSString val) =

  Ok $ PCRE.match (compiledRegex re) (fromJSString val)

regexpFilter _ x =

        \ expecting string but got '" ++ show (pp_value x) ++ "'"

-- | Implements the 'ContainsFilter' matching.

-- note: the next two implementations are the same, but we have to

-- repeat them due to the encapsulation done by FilterValue

containsFilter (QuotedString val) lst = do

-- this as passing the filter.

evaluateFilter :: ConfigData -> Maybe b -> a

               -> Filter (FieldGetter a b)

evaluateFilter _ _  _ EmptyFilter = Ok True

evaluateFilter c mb a (AndFilter flts) =

  all id <$> mapM (evaluateFilter c mb a) flts