X-Git-Url: https://code.delx.au/offlineimap/blobdiff_plain/34fa505749bc12db371ab8e07239e321fc6536b4..82db11ed4398e59345e469d9054b44f8f6250d4e:/src/Data/Syncable.hs

diff --git a/src/Data/Syncable.hs b/src/Data/Syncable.hs
index aa03932..2675245 100644
--- a/src/Data/Syncable.hs
+++ b/src/Data/Syncable.hs
@@ -66,36 +66,82 @@ call forgetfolders on local and remote
 module Data.Syncable where
 import qualified Data.Map as Map
 
-type SyncCollection k = Map.Map k ()
+type SyncCollection k v = Map.Map k v
 
-data (Eq k, Ord k, Show k) => 
-    SyncCommand k = 
+data (Eq k, Ord k, Show k, Show v) => 
+    SyncCommand k v = 
            DeleteItem k
-         | CopyItem k
+         | CopyItem k v
+         | ModifyContent k v
     deriving (Eq, Ord, Show)
 
-syncThem :: (Ord k, Show k) =>
-            SyncCollection k  -- ^ Present state of master
-         -> SyncCollection k  -- ^ Present state of child
-         -> SyncCollection k  -- ^ Last state of child
-         -> ([SyncCommand k], [SyncCommand k]) -- ^ Changes to make to (master, child)
-syncThem masterstate childstate lastchildstate =
+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
+bring them into proper sync.
+
+In the event that both master and child previously had an item, and the payload
+of the item has changed on both ends, the payload as given in the child
+will take precedence.
+
+This relationship should hold:
+
+>let (masterCmds, childCmds) = syncBiDir masterState childState lastChildState
+>unaryApplyChanges masterState masterCmds == 
+> unaryApplyChanges childState childCmds
+
+This relationship is validated in the test suite that accompanies this
+software.
+
+-}
+syncBiDir :: (Ord k, Show k, Show v, Eq v) =>
+            SyncCollection k v  -- ^ Present state of master
+         -> SyncCollection k v  -- ^ Present state of child
+         -> SyncCollection k v  -- ^ Last state of child
+         -> ([SyncCommand k v], [SyncCommand k v]) -- ^ Changes to make to (master, child)
+syncBiDir masterstate childstate lastchildstate =
     (masterchanges, childchanges)
     where masterchanges = (map DeleteItem .
                           findDeleted childstate masterstate $ lastchildstate)
                           ++ 
-                          (map CopyItem .
+                          (map (pairToFunc CopyItem) .
                            findAdded childstate masterstate $ lastchildstate)
+                          ++ (map (pairToFunc ModifyContent) . Map.toList $ masterPayloadChanges)
           childchanges = (map DeleteItem . 
                           findDeleted masterstate childstate $ lastchildstate)
                          ++
-                         (map CopyItem .
+                         (map (pairToFunc CopyItem) .
                           findAdded masterstate childstate $ lastchildstate)
+                         ++ (map (pairToFunc ModifyContent) . Map.toList $ childPayloadChanges)
+          masterPayloadChanges = 
+              Map.union (findModified childstate lastchildstate)
+                 (findModified childstate masterstate)
+          -- The child's payload takes precedence, so we are going to
+          -- calculate the changes made on the master to apply to the client,
+          -- then subtract out any items in the master changes that have the
+          -- same key.
+          childPayloadChanges = 
+              foldl (flip Map.delete) (findModified masterstate lastchildstate)
+                    (Map.keys (findModified childstate masterstate))
+                    
+
+{- | Compares two SyncCollections, and returns the commands that, when
+applied to the first collection, would yield the second. -}
+diffCollection :: (Ord k, Show k, Show v) => 
+                  SyncCollection k v
+               -> SyncCollection k v
+               -> [SyncCommand k v]
+diffCollection coll1 coll2 = 
+    (map DeleteItem . findDeleted 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 -}
 findDeleted :: Ord k =>
-               SyncCollection k -> SyncCollection k -> SyncCollection k ->
+               SyncCollection k v -> SyncCollection k v -> SyncCollection k v ->
                [k]
 findDeleted state1 state2 lastchildstate =
     Map.keys . Map.difference (Map.intersection state2 lastchildstate) $ state1
@@ -103,30 +149,30 @@ findDeleted state1 state2 lastchildstate =
 {- | Returns a list of keys that exist in state1 but in neither 
 state2 nor lastchildstate -}
 findAdded :: (Ord k, Eq k) =>
-               SyncCollection k -> SyncCollection k -> SyncCollection k ->
-               [k]
+               SyncCollection k v -> SyncCollection k v -> SyncCollection k v ->
+               [(k, v)]
 findAdded state1 state2 lastchildstate =
-    Map.keys . Map.difference state1 . Map.union state2 $ lastchildstate
-
-{- | Returns a list of keys that exist in the passed state -}
-filterKeys :: (Ord k) => 
-              SyncCollection k -> [k] -> [k]
-filterKeys state keylist =
-    concatMap keyfunc keylist
-    where keyfunc k =
-              case Map.lookup k state of
-                Nothing -> []
-                Just _ -> [k]
+    Map.toList . Map.difference state1 . Map.union state2 $ lastchildstate
+
+{- Finds all items that exist in both state1 and lastchildstate in which the payload
+is different in state1 than it was in lastchildstate.  Returns the key and new
+payload for each such item found. -}
+findModified :: (Ord k, Eq v) =>
+                SyncCollection k v -> SyncCollection k v -> SyncCollection k v
+findModified state1 lastchildstate =
+    Map.mapMaybe id .  
+    Map.intersectionWith (\v1 v2 -> if v1 /= v2 then Just v1 else Nothing) 
+       state1 $ lastchildstate
 
 {- | Apply the specified changes to the given SyncCollection.  Returns
 a new SyncCollection with the changes applied.  If changes are specified
 that would apply to UIDs that do not exist in the source list, these changes
 are silently ignored. -}
-unaryApplyChanges :: (Eq k, Ord k, Show k) => 
-                     SyncCollection k -> [SyncCommand k] -> SyncCollection k
+unaryApplyChanges :: (Eq k, Ord k, Show k, Show v) => 
+                     SyncCollection k v -> [SyncCommand k v] -> SyncCollection k v
 unaryApplyChanges collection commands =
     let makeChange collection (DeleteItem key) =
             Map.delete key collection
-        makeChange collection (CopyItem key) =
-            Map.insert key () collection
+        makeChange collection (CopyItem key val) =
+            Map.insert key val collection
     in foldl makeChange collection commands