Believe fixed the all changes test, need to fix implementation now

diff --git a/src/Data/Syncable.hs b/src/Data/Syncable.hs
index adcbcde2b57e0b8b6c6f78d62abbd2f6e8f39369..fd5d1623406a1424e8d6991b7b7426ca2ca668c3 100644 (file)
--- a/src/Data/Syncable.hs
+++ b/src/Data/Syncable.hs
@@ -75,6 +75,9 @@ data (Eq k, Ord k, Show k, Show v) =>
          | ModifyContent k v
     deriving (Eq, Ord, Show)
 
+pairToFunc :: (a -> b -> c) -> (a, b) -> c
+pairToFunc func (a, b) = func a b
+
 {- | Perform a bi-directional sync.  Compared to the last known state of
 the child, evaluate the new states of the master and child.  Return a list of
 changes to make to the master and list of changes to make to the child to
@@ -104,15 +107,15 @@ syncBiDir masterstate childstate lastchildstate =
     where masterchanges = (map DeleteItem .
                           findDeleted childstate masterstate $ lastchildstate)
                           ++ 
-                          (map (\(x, y) -> CopyItem x y) .
+                          (map (pairToFunc CopyItem) .
                            findAdded childstate masterstate $ lastchildstate)
-                          ++ (map (\(x, y) -> ModifyContent x y) . Map.toList $ masterPayloadChanges)
+                          ++ (map (pairToFunc ModifyContent) . Map.toList $ masterPayloadChanges)
           childchanges = (map DeleteItem . 
                           findDeleted masterstate childstate $ lastchildstate)
                          ++
-                         (map (\(x, y) -> CopyItem x y) .
+                         (map (pairToFunc CopyItem) .
                           findAdded masterstate childstate $ lastchildstate)
-                         ++ (map (\(x, y) -> ModifyContent x y) . Map.toList $ childPayloadChanges)
+                         ++ (map (pairToFunc ModifyContent) . Map.toList $ childPayloadChanges)
           masterPayloadChanges = 
               findModified childstate lastchildstate
           -- The child's payload takes precedence, so we are going to
@@ -132,7 +135,7 @@ diffCollection :: (Ord k, Show k, Show v) =>
                -> [SyncCommand k v]
 diffCollection coll1 coll2 = 
     (map DeleteItem . findDeleted coll2 coll1 $ coll1) ++
-    (map (\(k, v) -> CopyItem k v) . findAdded coll2 coll1 $ coll1)
+    (map (pairToFunc CopyItem) . findAdded coll2 coll1 $ coll1)
 
 {- | Returns a list of keys that exist in state2 and lastchildstate
 but not in state1 -}

diff --git a/testsrc/runtests.hs b/testsrc/runtests.hs
index dbeda57e293c8531887dd34bd706f51c65eb826b..ca42acfe0a8cb432b4264b376d3e03aca90cbf64 100644 (file)
--- a/testsrc/runtests.hs
+++ b/testsrc/runtests.hs
@@ -77,9 +77,9 @@ prop_allChangesToMaster :: SyncCollection Int Float -> SyncCollection Int Float
 prop_allChangesToMaster master child =
     let (resMaster, resChild) = syncBiDir master child master
         expectedResMaster = sort $
-            (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference child $ master) ++
+            (map (pairToFunc CopyItem) . Map.toList . Map.difference child $ master) ++
             (map DeleteItem . Map.keys . Map.difference master $ child) ++
-            (map (\(k, v) -> ModifyContent k v) changeList)
+            (map (pairToFunc ModifyContent) changeList)
         changeList = foldl changefunc [] (Map.toList child)
         changefunc accum (k, v) =
             case Map.lookup k master of
@@ -90,29 +90,34 @@ prop_allChangesToMaster master child =
         in (expectedResMaster, []) @=?
            (sort resMaster, resChild)
 
+-- FIXME: test findModified
+
 prop_allChanges :: SyncCollection Int Float -> SyncCollection Int Float -> SyncCollection Int Float -> Result
 prop_allChanges master child lastchild =
     let (resMaster, resChild) = syncBiDir master child lastchild
+        masterChildCommon = findModified child master
+        masterMods = findNewMods masterChildCommon master
+        childMods = findNewMods masterChildCommon child
+
+        findNewMods :: (Eq a, Ord a, Eq b) => SyncCollection a b -> SyncCollection a b -> [(a, b)]
+        findNewMods common orig = catMaybes . map checkKV . Map.toList $ common
+            where checkKV (k, v) =
+                      case Map.lookup k orig of
+                        Just v' -> if v' == v
+                                   then Nothing
+                                   else Just (k, v)
+                        Nothing -> Nothing
+
         expectedResMaster = sort $
-            (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference child $ Map.union master lastchild) ++
+            (map (pairToFunc CopyItem) . Map.toList . Map.difference child $ Map.union master lastchild) ++
                                                                                             (map DeleteItem . Map.keys . Map.intersection master $ Map.difference lastchild child) ++
-            (map (\(k, v) -> ModifyContent k v) masterChanges)
+            (map (pairToFunc ModifyContent) masterMods)
 
         expectedResChild = sort $
-            (map (\(k, v) -> CopyItem k v) . Map.toList . Map.difference master $ Map.union child lastchild) ++
+            (map (pairToFunc CopyItem) . Map.toList . Map.difference master $ Map.union child lastchild) ++
                                                                                             (map DeleteItem . Map.keys . Map.intersection child $ Map.difference lastchild master) ++
-            (map (\(k, v) -> ModifyContent k v) childChanges)
+            (map (pairToFunc ModifyContent) childMods)
 
-        childChanges = foldl (changefunc True) [] (Map.toList child)
-        masterChanges = foldl (changefunc False) [] (Map.toList child)
-        changefunc useMaster accum (k, v) =
-            case Map.lookup k master of
-              Nothing -> accum
-              Just x -> if x /= v
-                        then if useMaster
-                             then (k, x) : accum
-                             else (k, v) : accum
-                        else accum
     in (expectedResMaster, expectedResChild) @=?
        (sort resMaster, sort resChild)