From: John Goerzen Date: Thu, 29 May 2008 02:58:05 +0000 (-0500) Subject: Believe fixed the all changes test, need to fix implementation now X-Git-Url: https://code.delx.au/offlineimap/commitdiff_plain/323248bdb51b898ee0609ee5de11ecf16c7f3e7f Believe fixed the all changes test, need to fix implementation now --- diff --git a/src/Data/Syncable.hs b/src/Data/Syncable.hs index adcbcde..fd5d162 100644 --- 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 dbeda57..ca42acf 100644 --- 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)