htools: Add if' and select as functions

if' is just a functional version of the if-then-else construct. Using it
we can manipulate ifs as functions, and also build other functionality.

select allows to choose a result depending on truth value of statements,
with a final default, and can be used to substitute cascaded-nested
if-then-else statements.

Both come with unit tests.

Signed-off-by: Guido Trotter <ultrotter@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>

diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index 3a46759..871ad84 100644 (file)
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -298,11 +298,39 @@ prop_Utils_fromObjWithDefault def_value random_key =
          random_key (def_value+1) == Just def_value
         where _types = def_value :: Integer
 
+-- | Test that functional if' behaves like the syntactic sugar if.
+prop_Utils_if'if :: Bool -> Int -> Int -> Bool
+prop_Utils_if'if cnd a b = Utils.if' cnd a b == if cnd then a else b
+
+-- | Test select
+prop_Utils_select :: Int   -- ^ Default result
+                  -> [Int] -- ^ List of False values
+                  -> [Int] -- ^ List of True values
+                  -> Bool  -- ^ Try undef result (if a true value exists)
+                  -> Bool  -- ^ Try undef true value (if a true value exists)
+                  -> Bool  -- ^ Try undef false value (if a true value exists)
+                  -> Bool  -- ^ Test result
+prop_Utils_select di lst1 lst2 rundefd rundeft rundeff =
+  Utils.select def cndlist == expectedresult
+  where has_nondef_result = not (null lst2)
+        try_undefd = has_nondef_result && rundefd
+        try_undeft = has_nondef_result && rundeft
+        try_undeff = has_nondef_result && rundeff
+        def = Utils.if' try_undefd undefined di
+        utl = Utils.if' try_undeft [(True, undefined)] []
+        ufl = Utils.if' try_undeff [(False, undefined)] []
+        expectedresult = Utils.if' has_nondef_result (head lst2) def
+        flist = map (\e -> (False, e)) lst1
+        tlist = map (\e -> (True, e)) lst2
+        cndlist = flist ++ tlist ++ utl ++ ufl
+
 -- | Test list for the Utils module.
 testUtils =
   [ run prop_Utils_commaJoinSplit
   , run prop_Utils_commaSplitJoin
   , run prop_Utils_fromObjWithDefault
+  , run prop_Utils_if'if
+  , run prop_Utils_select
   ]
 
 -- ** PeerMap tests

diff --git a/htools/Ganeti/HTools/Utils.hs b/htools/Ganeti/HTools/Utils.hs
index efc3d62..cff474b 100644 (file)
--- a/htools/Ganeti/HTools/Utils.hs
+++ b/htools/Ganeti/HTools/Utils.hs
@@ -28,6 +28,8 @@ module Ganeti.HTools.Utils
     , debugXy
     , sepSplit
     , stdDev
+    , if'
+    , select
     , commaJoin
     , readEitherString
     , JSRecord
@@ -106,6 +108,27 @@ stdDev lst =
       av = foldl' (\accu em -> let d = em - mv in accu + d * d) 0.0 lst
   in sqrt (av / ll) -- stddev
 
+-- *  Logical functions
+
+-- Avoid syntactic sugar and enhance readability. These functions are proposed
+-- by some for inclusion in the Prelude, and at the moment they are present
+-- (with various definitions) in the utility-ht package. Some rationale and
+-- discussion is available at <http://www.haskell.org/haskellwiki/If-then-else>
+
+-- | \"if\" as a function, rather than as syntactic sugar.
+if' :: Bool -- ^ condition
+    -> a    -- ^ \"then\" result
+    -> a    -- ^ \"else\" result
+    -> a    -- ^ \"then\" or "else" result depending on the condition
+if' True x _ = x
+if' _    _ y = y
+
+-- | Return the first result with a True condition, or the default otherwise.
+select :: a            -- ^ default result
+       -> [(Bool, a)]  -- ^ list of \"condition, result\"
+       -> a            -- ^ first result which has a True condition, or default
+select def = maybe def snd . find fst
+
 -- * JSON-related functions
 
 -- | A type alias for the list-based representation of J.JSObject.