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