From: Iustin Pop <ius...@google.com> This is similar to the Python version, objects.py:FillDict.
Signed-off-by: Iustin Pop <ius...@google.com> --- htools/Ganeti/HTools/QC.hs | 21 +++++++++++++++++++++ htools/Ganeti/Objects.hs | 12 ++++++++++++ htools/test.hs | 1 + 3 files changed, 34 insertions(+) diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs index 9b379fa..322a7ab 100644 --- a/htools/Ganeti/HTools/QC.hs +++ b/htools/Ganeti/HTools/QC.hs @@ -50,6 +50,7 @@ module Ganeti.HTools.QC , testSsconf , testQlang , testConfd + , testObjects ) where import qualified Test.HUnit as HUnit @@ -2109,3 +2110,23 @@ testSuite "Confd" [ 'prop_Confd_req_sign , 'prop_Confd_bad_key ] + +-- * Objects tests + +-- | Tests that fillDict behaves correctly +prop_Objects_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property +prop_Objects_fillDict defaults custom = + let d_map = Map.fromList defaults + d_keys = map fst defaults + c_map = Map.fromList custom + c_keys = map fst custom + in printTestCase "Empty custom filling" + (Objects.fillDict d_map Map.empty [] == d_map) .&&. + printTestCase "Empty defaults filling" + (Objects.fillDict Map.empty c_map [] == c_map) .&&. + printTestCase "Delete all keys" + (Objects.fillDict d_map c_map (d_keys++c_keys) == Map.empty) + +testSuite "Objects" + [ 'prop_Objects_fillDict + ] diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs index c23707e..7f4c0a6 100644 --- a/htools/Ganeti/Objects.hs +++ b/htools/Ganeti/Objects.hs @@ -58,11 +58,14 @@ module Ganeti.Objects , NodeGroup(..) , IpFamily(..) , ipFamilyToVersion + , fillDict , Cluster(..) , ConfigData(..) ) where +import Data.List (foldl') import Data.Maybe +import qualified Data.Map as Map import Text.JSON (makeObj, showJSON, readJSON, JSON, JSValue(..)) import qualified Text.JSON as J @@ -71,6 +74,15 @@ import Ganeti.HTools.JSON import Ganeti.THH +-- * Generic definitions + +-- | Fills one map with keys from the other map, if not already +-- existing. Mirrors objects.py:FillDict. +fillDict :: (Ord k) => Map.Map k v -> Map.Map k v -> [k] -> Map.Map k v +fillDict defaults custom skip_keys = + let updated = Map.union custom defaults + in foldl' (flip Map.delete) updated skip_keys + -- * NIC definitions $(declareSADT "NICMode" diff --git a/htools/test.hs b/htools/test.hs index fd60126..bca051d 100644 --- a/htools/test.hs +++ b/htools/test.hs @@ -70,6 +70,7 @@ allTests = , (True, testSsconf) , (True, testQlang) , (True, testConfd) + , (True, testObjects) , (False, testCluster) ] -- 1.7.10
