This allows extracting values from a JSON object that might miss, but
have a well-defined default value.
---
 htools/Ganeti/HTools/QC.hs    |   11 +++++++++++
 htools/Ganeti/HTools/Utils.hs |    7 +++++++
 2 files changed, 18 insertions(+), 0 deletions(-)

diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index 0295181..7111a5d 100644
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -247,9 +247,20 @@ prop_Utils_commaJoinSplit lst = lst /= [""] &&
 -- Split and join should always be idempotent
 prop_Utils_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) == s
 
+-- | fromObjWithDefault, we test using the Maybe monad and an integer
+-- value
+prop_Utils_fromObjWithDefault def_value random_key =
+    -- a missing key will be returned with the default
+    Utils.fromObjWithDefault [] random_key def_value == Just def_value &&
+    -- a found key will be returned as is, not with default
+    Utils.fromObjWithDefault [(random_key, J.showJSON def_value)]
+         random_key (def_value+1) == Just def_value
+        where _types = (def_value :: Integer)
+
 testUtils =
   [ run prop_Utils_commaJoinSplit
   , run prop_Utils_commaSplitJoin
+  , run prop_Utils_fromObjWithDefault
   ]
 
 -- | Make sure add is idempotent
diff --git a/htools/Ganeti/HTools/Utils.hs b/htools/Ganeti/HTools/Utils.hs
index 6317f98..b26f858 100644
--- a/htools/Ganeti/HTools/Utils.hs
+++ b/htools/Ganeti/HTools/Utils.hs
@@ -32,6 +32,7 @@ module Ganeti.HTools.Utils
     , readEitherString
     , loadJSArray
     , fromObj
+    , fromObjWithDefault
     , maybeFromObj
     , tryFromObj
     , fromJVal
@@ -46,6 +47,7 @@ module Ganeti.HTools.Utils
 
 import Control.Monad (liftM)
 import Data.List
+import Data.Maybe (fromMaybe)
 import qualified Text.JSON as J
 import Text.Printf (printf)
 
@@ -142,6 +144,11 @@ maybeFromObj o k =
       Nothing -> return Nothing
       Just val -> liftM Just (fromKeyValue k val)
 
+-- | Reads the value of a key in a JSON object with a default if missing.
+fromObjWithDefault :: (J.JSON a, Monad m) =>
+                      [(String, J.JSValue)] -> String -> a -> m a
+fromObjWithDefault o k d = liftM (fromMaybe d) $ maybeFromObj o k
+
 -- | Reads a JValue, that originated from an object key
 fromKeyValue :: (J.JSON a, Monad m)
               => String     -- ^ The key name
-- 
1.7.3.1

Reply via email to