about summary refs log tree commit diff
diff options
context:
space:
mode:
authorsternenseemann <git@lukasepple.de>2019-10-27 22:55:56 +0100
committersternenseemann <git@lukasepple.de>2019-10-27 22:55:56 +0100
commit105783e02d7470671359aedf5eead463201bd990 (patch)
tree3d727beee38f768a67fde9e7330db540df5c9f40
parenta7ac5318ad96c6d1ced72a9b169a89864b5caf4f (diff)
test insertMapKey instead of unused insertSeq
-rw-r--r--lib/Grav2ty/Util/RelGraph.hs17
-rw-r--r--test/Main.hs2
2 files changed, 4 insertions, 15 deletions
diff --git a/lib/Grav2ty/Util/RelGraph.hs b/lib/Grav2ty/Util/RelGraph.hs
index 8cdb7a9..71d63f8 100644
--- a/lib/Grav2ty/Util/RelGraph.hs
+++ b/lib/Grav2ty/Util/RelGraph.hs
@@ -5,7 +5,6 @@ module Grav2ty.Util.RelGraph
   , emptyRel
   , insertRel
   , insertRelNoOv
-  , insertMap
   , insertMapKey
   , lookupRel
   , anyFrom
@@ -66,19 +65,9 @@ insertSeq f g seq = ins seq g
                        in insertRelNoOv x el v v' g
 
 -- | Takes a 'Map' of Vertices and a function that returns the relations for
---   the associated edge and inserts them into a 'RelGraph'
-insertMap :: Ord a => (a -> a -> (v, v)) -> RelGraph a v -> Map k a -> RelGraph a v
-insertMap f g map = M.foldl' ins g map
-  where ins g x = foldl' (folder x) g map
-        folder x g el = let (v, v') = f x el
-                       in insertRelNoOv x el v v' g
-
--- | Takes a 'Map' of Vertices and a function that returns the relations for
 --   the associated edge and inserts them into a 'RelGraph'. Instead of using
 --   the vertices themselves we use the keys of the vertices as keys in
 --   the 'RelGraph' as well.
---
---   TODO: prop
 insertMapKey :: Ord k => (a -> a -> (v, v)) -> RelGraph k v -> Map k a -> RelGraph k v
 insertMapKey f g map = M.foldlWithKey' ins g map
   where ins g k x = M.foldlWithKey' (folder k x) g map
@@ -99,9 +88,9 @@ foldlFrom' :: Ord a => (b -> v -> b) -> b -> a -> RelGraph a v -> b
 foldlFrom' f res x =
   foldl' f res . fromMaybe M.empty . M.lookup x . unRelGraph
 
-prop_relCorrectness :: Seq Integer -> Bool
-prop_relCorrectness seq = all cond $ allCombinations g
-  where g = insertSeq (\x y -> let r = x * y in (r, negate r)) emptyRel seq
+prop_relCorrectness :: Map String Integer -> Bool
+prop_relCorrectness map = all cond $ allCombinations g
+  where g = insertMapKey (\x y -> let r = x * y in (r, negate r)) emptyRel map
         cond (x, y) = lookupRel x y g == fmap negate (lookupRel y x g)
 
 prop_insertLookupNoOv :: (Ord a, Eq v) => a -> a -> v ->  Bool
diff --git a/test/Main.hs b/test/Main.hs
index 49d5027..da433ff 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -23,7 +23,7 @@ instance (Ord a, Arbitrary a, Arbitrary v) => Arbitrary (RelGraph a v) where
 
 relGraph :: TestTree
 relGraph = testGroup "Grav2ty.Util.UGraph"
-  [ QC.testProperty "Check relational properties of insertSeq" prop_relCorrectness
+  [ QC.testProperty "Check relational properties of insertMapKey" prop_relCorrectness
   , QC.testProperty "Check insertion and lookup correctness" (prop_insertLookup :: Integer -> Integer ->  String -> RelGraph Integer String -> Bool)
   , QC.testProperty "Check insertion and lookup correctness w/o overwrite" (prop_insertLookupNoOv :: Integer -> Integer ->  String -> Bool)
   ]