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 =
122 (findModified masterstate childstate childstate lastchildstate)
123 (findModified masterstate childstate reducedChildState masterstate)
124 where reducedChildState =
125 Map.difference childstate lastchildstate
127 -- The child's payload takes precedence, so we are going to
128 -- calculate the changes made on the master to apply to the client,
129 -- then subtract out any items in the master changes that have the
131 childPayloadChanges =
132 Map.union (findModified childstate childstate masterstate lastchildstate)
133 (findModified childstate childstate childstate lastchildstate)
135 {- | Compares two SyncCollections, and returns the commands that, when
136 applied to the first collection, would yield the second. -}
137 diffCollection :: (Ord k, Show k, Eq v, Show v) =>
139 -> SyncCollection k v
141 diffCollection coll1 coll2 =
142 (map DeleteItem . findDeleted coll2 coll1 $ coll1) ++
143 (map (pairToFunc CopyItem) . findAdded coll2 coll1 $ coll1)
145 (map (pairToFunc ModifyContent) . Map.toList .
146 findModified coll1 coll2 $ coll1)
149 {- | Returns a list of keys that exist in state2 and lastchildstate
151 findDeleted :: Ord k =>
152 SyncCollection k v -> SyncCollection k v -> SyncCollection k v ->
154 findDeleted state1 state2 lastchildstate =
155 Map.keys . Map.difference (Map.intersection state2 lastchildstate) $ state1
157 {- | Returns a list of keys that exist in state1 but in neither
158 state2 nor lastchildstate -}
159 findAdded :: (Ord k, Eq k) =>
160 SyncCollection k v -> SyncCollection k v -> SyncCollection k v ->
162 findAdded state1 state2 lastchildstate =
163 Map.toList . Map.difference state1 . Map.union state2 $ lastchildstate
166 {- Finds all items that exist in both state1 and lastchildstate in which the payload
167 is different in state1 than it was in lastchildstate. Returns the key and new
168 payload for each such item found. -}
169 findModified :: (Ord k, Eq v) =>
171 -> SyncCollection k v
172 -> SyncCollection k v
173 -> SyncCollection k v
174 -> SyncCollection k v
175 findModified basestate authoritativestate comparisonstate laststate =
177 Map.intersectionWithKey compareFunc comparisonstate laststate
178 where compareFunc k compv lastv =
181 else case (Map.lookup k basestate, Map.lookup k authoritativestate) of
182 (Nothing, _) -> Nothing
183 (Just basev, Nothing) ->
187 (Just basev, Just authv) ->
188 if (authv /= lastv) && (authv /= basev)
190 else if compv /= basev && (authv /= basev)
194 {- | Apply the specified changes to the given SyncCollection. Returns
195 a new SyncCollection with the changes applied. If changes are specified
196 that would apply to UIDs that do not exist in the source list, these changes
197 are silently ignored. -}
198 unaryApplyChanges :: (Eq k, Ord k, Show k, Show v) =>
199 SyncCollection k v -> [SyncCommand k v] -> SyncCollection k v
200 unaryApplyChanges collection commands =
201 let makeChange collection (DeleteItem key) =
202 Map.delete key collection
203 makeChange collection (CopyItem key val) =
204 Map.insert key val collection
205 makeChange collection (ModifyContent key val) =
206 Map.adjust (\_ -> val) key collection
207 in foldl makeChange collection commands