1 {- offlineimap component
2 Copyright (C) 2002-2008 John Goerzen <jgoerzen@complete.org>
4 This program is free software; you can redistribute it and/or modify
5 it under the terms of the GNU General Public License as published by
6 the Free Software Foundation; either version 2 of the License, or
7 (at your option) any later version.
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 GNU General Public License for more details.
14 You should have received a copy of the GNU General Public License
15 along with this program; if not, write to the Free Software
16 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 The OfflineIMAP v6 algorithm worked like this:
22 call remoterepos.syncfoldersto(localrepos, [statusrepos])
25 syncfolder(remotename, remoterepos, remotefolder, localrepos, statusrepos, quick)
27 sets localfolder = local folder
28 adds localfolder to mbnames
29 sets statusfolder = status folder
30 if localfolder.getuidvalidity() == None, removes anything in statusfolder
32 statusfolder.cachemessagelist()
34 localfolder.cachemessagelist()
39 remotefolder.cachemessagelist()
41 if not statusfolder.isnewfolder():
42 # Delete local copies of remote messages. This way,
43 # if a message's flag is modified locally but it has been
44 # deleted remotely, we'll delete it locally. Otherwise, we
45 # try to modify a deleted message's flags! This step
46 # need only be taken if a statusfolder is present; otherwise,
47 # there is no action taken *to* the remote repository.
48 remotefolder.syncmessagesto_delete(localfolder, [localfolder,
50 localfolder.syncmessagesto(statusfolder, [remotefolder, statusfolder])
52 # Synchroonize remote changes
53 remotefolder.syncmessagesto(localfolder, [localfolder, statusfolder])
55 # Make sure the status folder is up-to-date.
56 ui.syncingmessages(localrepos, localfolder, statusrepos, statusfolder)
57 localfolder.syncmessagesto(statusfolder)
59 localrepos.restore_atime()
63 call forgetfolders on local and remote
66 module Data.Syncable where
67 import qualified Data.Map as Map
69 type SyncCollection k v = Map.Map k v
71 data (Eq k, Ord k, Show k, Show v) =>
76 deriving (Eq, Ord, Show)
78 pairToFunc :: (a -> b -> c) -> (a, b) -> c
79 pairToFunc func (a, b) = func a b
81 {- | Perform a bi-directional sync. Compared to the last known state of
82 the child, evaluate the new states of the master and child. Return a list of
83 changes to make to the master and list of changes to make to the child to
84 bring them into proper sync.
86 In the event that both master and child previously had an item, and the payload
87 of the item has changed on both ends, the payload as given in the child
88 will take precedence. If both previously had an item, and it changed on only
89 one end, the new value "wins".
91 This relationship should hold:
93 >let (masterCmds, childCmds) = syncBiDir masterState childState lastChildState
94 >unaryApplyChanges masterState masterCmds ==
95 > unaryApplyChanges childState childCmds
97 This relationship is validated in the test suite that accompanies this
101 syncBiDir :: (Ord k, Show k, Show v, Eq v) =>
102 SyncCollection k v -- ^ Present state of master
103 -> SyncCollection k v -- ^ Present state of child
104 -> SyncCollection k v -- ^ Last state of child
105 -> ([SyncCommand k v], [SyncCommand k v]) -- ^ Changes to make to (master, child)
106 syncBiDir masterstate childstate lastchildstate =
107 (masterchanges, childchanges)
108 where masterchanges = (map DeleteItem .
109 findDeleted childstate masterstate $ lastchildstate)
111 (map (pairToFunc CopyItem) .
112 findAdded childstate masterstate $ lastchildstate)
113 ++ (map (pairToFunc ModifyContent) . Map.toList $ masterPayloadChanges)
114 childchanges = (map DeleteItem .
115 findDeleted masterstate childstate $ lastchildstate)
117 (map (pairToFunc CopyItem) .
118 findAdded masterstate childstate $ lastchildstate)
119 ++ (map (pairToFunc ModifyContent) . Map.toList $ childPayloadChanges)
120 masterPayloadChanges =
121 Map.union (findModified masterstate childstate lastchildstate)
122 (findModified masterstate childstate masterstate)
124 -- The child's payload takes precedence, so we are going to
125 -- calculate the changes made on the master to apply to the client,
126 -- then subtract out any items in the master changes that have the
128 childPayloadChanges =
130 (findModified childstate masterstate lastchildstate)
131 (findModified masterstate childstate lastchildstate)
133 {- | Compares two SyncCollections, and returns the commands that, when
134 applied to the first collection, would yield the second. -}
135 diffCollection :: (Ord k, Show k, Show v) =>
137 -> SyncCollection k v
139 diffCollection coll1 coll2 =
140 (map DeleteItem . findDeleted coll2 coll1 $ coll1) ++
141 (map (pairToFunc CopyItem) . findAdded coll2 coll1 $ coll1)
143 {- | Returns a list of keys that exist in state2 and lastchildstate
145 findDeleted :: Ord k =>
146 SyncCollection k v -> SyncCollection k v -> SyncCollection k v ->
148 findDeleted state1 state2 lastchildstate =
149 Map.keys . Map.difference (Map.intersection state2 lastchildstate) $ state1
151 {- | Returns a list of keys that exist in state1 but in neither
152 state2 nor lastchildstate -}
153 findAdded :: (Ord k, Eq k) =>
154 SyncCollection k v -> SyncCollection k v -> SyncCollection k v ->
156 findAdded state1 state2 lastchildstate =
157 Map.toList . Map.difference state1 . Map.union state2 $ lastchildstate
159 {- Finds all items that exist in both state1 and lastchildstate in which the payload
160 is different in state1 than it was in lastchildstate. Returns the key and new
161 payload for each such item found. -}
162 findModified :: (Ord k, Eq v) =>
163 SyncCollection k v -> SyncCollection k v -> SyncCollection k v -> SyncCollection k v
164 findModified basestate state1 lastchildstate =
166 Map.intersectionWithKey comparefunc state1 $ lastchildstate
167 where comparefunc k v1 v2 =
169 then case Map.lookup k basestate of
177 {- | Apply the specified changes to the given SyncCollection. Returns
178 a new SyncCollection with the changes applied. If changes are specified
179 that would apply to UIDs that do not exist in the source list, these changes
180 are silently ignored. -}
181 unaryApplyChanges :: (Eq k, Ord k, Show k, Show v) =>
182 SyncCollection k v -> [SyncCommand k v] -> SyncCollection k v
183 unaryApplyChanges collection commands =
184 let makeChange collection (DeleteItem key) =
185 Map.delete key collection
186 makeChange collection (CopyItem key val) =
187 Map.insert key val collection
188 makeChange collection (ModifyContent key val) =
189 Map.adjust (\_ -> val) key collection
190 in foldl makeChange collection commands