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