From 228ef0f2bcdacea52cf512779b99947d1b8cb173 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Fri, 30 Nov 2012 00:32:52 +0100
Subject: [PATCH] Make Query operators enforce strictness
Currently, the query operators (binop, etc.) create thunks, instead of
forcing the evaluation of the simple boolean results. This results in
higher than needed memory use.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Michele Tartara <mtartara@google.com>
---
htools/Ganeti/Query/Filter.hs | 12 ++++++------
1 file changed, 6 insertions(+), 6 deletions(-)
diff --git a/htools/Ganeti/Query/Filter.hs b/htools/Ganeti/Query/Filter.hs
index 6073c9e18..d5e56f708 100644
--- a/htools/Ganeti/Query/Filter.hs
+++ b/htools/Ganeti/Query/Filter.hs
@@ -99,7 +99,7 @@ wrapGetter cfg b a getter faction =
-- | Helper to evaluate a filter getter (and the value it generates) in
-- a boolean context.
trueFilter :: JSValue -> ErrorResult Bool
-trueFilter (JSBool x) = Ok x
+trueFilter (JSBool x) = Ok $! x
trueFilter v = Bad . ParameterError $
"Unexpected value '" ++ show (pp_value v) ++
"' in boolean context"
@@ -115,9 +115,9 @@ type Comparator = (Eq a, Ord a) => a -> a -> Bool
-- compare in the reverse order too!.
binOpFilter :: Comparator -> FilterValue -> JSValue -> ErrorResult Bool
binOpFilter comp (QuotedString y) (JSString x) =
- Ok $ fromJSString x `comp` y
+ Ok $! fromJSString x `comp` y
binOpFilter comp (NumericValue y) (JSRational _ x) =
- Ok $ x `comp` fromIntegral y
+ Ok $! x `comp` fromIntegral y
binOpFilter _ expr actual =
Bad . ParameterError $ "Invalid types in comparison, trying to compare " ++
show (pp_value actual) ++ " with '" ++ show expr ++ "'"
@@ -125,7 +125,7 @@ binOpFilter _ expr actual =
-- | Implements the 'RegexpFilter' matching.
regexpFilter :: FilterRegex -> JSValue -> ErrorResult Bool
regexpFilter re (JSString val) =
- Ok $ PCRE.match (compiledRegex re) (fromJSString val)
+ Ok $! PCRE.match (compiledRegex re) (fromJSString val)
regexpFilter _ x =
Bad . ParameterError $ "Invalid field value used in regexp matching,\
\ expecting string but got '" ++ show (pp_value x) ++ "'"
@@ -136,10 +136,10 @@ containsFilter :: FilterValue -> JSValue -> ErrorResult Bool
-- repeat them due to the encapsulation done by FilterValue
containsFilter (QuotedString val) lst = do
lst' <- fromJVal lst
- return $ val `elem` lst'
+ return $! val `elem` lst'
containsFilter (NumericValue val) lst = do
lst' <- fromJVal lst
- return $ val `elem` lst'
+ return $! val `elem` lst'
-- | Verifies if a given item passes a filter. The runtime context
-- might be missing, in which case most of the filters will consider
--
GitLab