code.delx.au - offlineimap/blob - src/Data/Syncable.hs

   1 {- offlineimap component
   2 Copyright (C) 2002-2008 John Goerzen <jgoerzen@complete.org>
   3
   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.
   8
   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.
  13
  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
  17 -}
  18
  19 {-
  20 The OfflineIMAP v6 algorithm worked like this:
  21
  22 call remoterepos.syncfoldersto(localrepos, [statusrepos])
  23
  24 for each folder, call
  25  syncfolder(remotename, remoterepos, remotefolder, localrepos, statusrepos, quick)
  26    this:
  27    sets localfolder = local folder
  28    adds localfolder to mbnames
  29    sets statusfolder = status folder
  30    if localfolder.getuidvalidity() == None, removes anything in statusfolder
  31
  32    statusfolder.cachemessagelist()
  33
  34    localfolder.cachemessagelist()
  35
  36    Check UID validity
  37    Save UID validity
  38
  39    remotefolder.cachemessagelist()
  40
  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,
  49                                                          statusfolder])
  50         localfolder.syncmessagesto(statusfolder, [remotefolder, statusfolder])
  51
  52    # Synchroonize remote changes
  53    remotefolder.syncmessagesto(localfolder, [localfolder, statusfolder])
  54
  55    # Make sure the status folder is up-to-date.
  56    ui.syncingmessages(localrepos, localfolder, statusrepos, statusfolder)
  57    localfolder.syncmessagesto(statusfolder)
  58    statusfolder.save()
  59    localrepos.restore_atime()
  60
  61
  62
  63 call forgetfolders on local and remote
  64 -}
  65
  66 module Data.Syncable where
  67 import qualified Data.Map as Map
  68
  69 type SyncCollection k v = Map.Map k v
  70
  71 data (Eq k, Ord k, Show k, Show v) =>
  72     SyncCommand k v =
  73            DeleteItem k
  74          | CopyItem k v
  75          | ModifyContent k v
  76     deriving (Eq, Ord, Show)
  77
  78 pairToFunc :: (a -> b -> c) -> (a, b) -> c
  79 pairToFunc func (a, b) = func a b
  80
  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.
  85
  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".
  90
  91 This relationship should hold:
  92
  93 >let (masterCmds, childCmds) = syncBiDir masterState childState lastChildState
  94 >unaryApplyChanges masterState masterCmds ==
  95 > unaryApplyChanges childState childCmds
  96
  97 This relationship is validated in the test suite that accompanies this
  98 software.
  99
 100 -}
 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)
 110                           ++
 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)
 116                          ++
 117                          (map (pairToFunc CopyItem) .
 118                           findAdded masterstate childstate $ lastchildstate)
 119                          ++ (map (pairToFunc ModifyContent) . Map.toList $ childPayloadChanges)
 120           masterPayloadChanges =
 121               Map.union
 122                  (findModified masterstate childstate childstate lastchildstate)
 123                  (findModified masterstate childstate reducedChildState masterstate)
 124               where reducedChildState =
 125                         Map.difference childstate lastchildstate
 126
 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
 130           -- same key.
 131           childPayloadChanges =
 132               Map.difference (findModified childstate masterstate masterstate lastchildstate)
 133                  (findModified masterstate childstate childstate lastchildstate)
 134
 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) =>
 138                   SyncCollection k v
 139                -> SyncCollection k v
 140                -> [SyncCommand k v]
 141 diffCollection coll1 coll2 =
 142     (map DeleteItem . findDeleted coll2 coll1 $ coll1) ++
 143     (map (pairToFunc CopyItem) . findAdded coll2 coll1 $ coll1) ++
 144     modifiedData
 145     where modifiedData =
 146               map (pairToFunc ModifyContent) .
 147               Map.toList .
 148               Map.mapMaybe id .
 149               Map.intersectionWith compareFunc coll1 $ coll2
 150           compareFunc v1 v2
 151               | v1 /= v2 = Just v2
 152               | otherwise = Nothing
 153
 154
 155     {-
 156     (map (pairToFunc ModifyContent) . Map.toList .
 157          findModified coll1 coll2 $ coll1)
 158      -}
 159
 160 {- | Returns a list of keys that exist in state2 and lastchildstate
 161 but not in state1 -}
 162 findDeleted :: Ord k =>
 163                SyncCollection k v -> SyncCollection k v -> SyncCollection k v ->
 164                [k]
 165 findDeleted state1 state2 lastchildstate =
 166     Map.keys . Map.difference (Map.intersection state2 lastchildstate) $ state1
 167
 168 {- | Returns a list of keys that exist in state1 but in neither
 169 state2 nor lastchildstate -}
 170 findAdded :: (Ord k, Eq k) =>
 171                SyncCollection k v -> SyncCollection k v -> SyncCollection k v ->
 172                [(k, v)]
 173 findAdded state1 state2 lastchildstate =
 174     Map.toList . Map.difference state1 . Map.union state2 $ lastchildstate
 175
 176
 177 {- Finds all items that exist in both state1 and lastchildstate in which the payload
 178 is different in state1 than it was in lastchildstate.  Returns the key and new
 179 payload for each such item found. -}
 180 findModified :: (Ord k, Eq v) =>
 181                 SyncCollection k v
 182              -> SyncCollection k v
 183              -> SyncCollection k v
 184              -> SyncCollection k v
 185              -> SyncCollection k v
 186 findModified basestate authoritativestate comparisonstate laststate =
 187     Map.mapMaybe id $
 188        Map.intersectionWithKey compareFunc comparisonstate laststate
 189     where compareFunc k compv lastv =
 190               if lastv == compv
 191                  then Nothing
 192                  else case (Map.lookup k basestate, Map.lookup k authoritativestate) of
 193                         (Nothing, _) -> Nothing
 194                         (Just basev, Nothing) ->
 195                             if compv /= basev
 196                                then Just compv
 197                                else Nothing
 198                         (Just basev, Just authv) ->
 199                             if (authv /= lastv) && (authv /= basev)
 200                                then Just authv
 201                                else if compv /= basev && (authv /= basev)
 202                                     then Just compv
 203                                     else Nothing
 204
 205 {- | Apply the specified changes to the given SyncCollection.  Returns
 206 a new SyncCollection with the changes applied.  If changes are specified
 207 that would apply to UIDs that do not exist in the source list, these changes
 208 are silently ignored. -}
 209 unaryApplyChanges :: (Eq k, Ord k, Show k, Show v) =>
 210                      SyncCollection k v -> [SyncCommand k v] -> SyncCollection k v
 211 unaryApplyChanges collection commands =
 212     let makeChange collection (DeleteItem key) =
 213             Map.delete key collection
 214         makeChange collection (CopyItem key val) =
 215             Map.insert key val collection
 216         makeChange collection (ModifyContent key val) =
 217             Map.adjust (\_ -> val) key collection
 218     in foldl makeChange collection commands