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     deriving (Eq, Ord, Show)
  76
  77 {- | Perform a bi-directional sync.  Compared to the last known state of
  78 the child, evaluate the new states of the master and child.  Return a list of
  79 changes to make to the master and list of changes to make to the child to
  80 bring them into proper sync.
  81
  82 This relationship should hold:
  83
  84 >let (masterCmds, childCmds) = syncBiDir masterState childState lastChildState
  85 >unaryApplyChanges masterState masterCmds ==
  86 > unaryApplyChanges childState childCmds
  87
  88 This relationship is validated in the test suite that accompanies this
  89 software.
  90 -}
  91 syncBiDir :: (Ord k, Show k, Show v) =>
  92             SyncCollection k v  -- ^ Present state of master
  93          -> SyncCollection k v  -- ^ Present state of child
  94          -> SyncCollection k v  -- ^ Last state of child
  95          -> ([SyncCommand k v], [SyncCommand k v]) -- ^ Changes to make to (master, child)
  96 syncBiDir masterstate childstate lastchildstate =
  97     (masterchanges, childchanges)
  98     where masterchanges = (map DeleteItem .
  99                           findDeleted childstate masterstate $ lastchildstate)
 100                           ++
 101                           (map (\(x, y) -> CopyItem x y) .
 102                            findAdded childstate masterstate $ lastchildstate)
 103           childchanges = (map DeleteItem .
 104                           findDeleted masterstate childstate $ lastchildstate)
 105                          ++
 106                          (map (\(x, y) -> CopyItem x y) .
 107                           findAdded masterstate childstate $ lastchildstate)
 108
 109 {- | Compares two SyncCollections, and returns the commands that, when
 110 applied to the first collection, would yield the second. -}
 111 diffCollection :: (Ord k, Show k, Show v) =>
 112                   SyncCollection k v
 113                -> SyncCollection k v
 114                -> [SyncCommand k v]
 115 diffCollection coll1 coll2 =
 116     (map DeleteItem . findDeleted coll2 coll1 $ coll1) ++
 117     (map (\(k, v) -> CopyItem k v) . findAdded coll2 coll1 $ coll1)
 118
 119 {- | Returns a list of keys that exist in state2 and lastchildstate
 120 but not in state1 -}
 121 findDeleted :: Ord k =>
 122                SyncCollection k v -> SyncCollection k v -> SyncCollection k v ->
 123                [k]
 124 findDeleted state1 state2 lastchildstate =
 125     Map.keys . Map.difference (Map.intersection state2 lastchildstate) $ state1
 126
 127 {- | Returns a list of keys that exist in state1 but in neither
 128 state2 nor lastchildstate -}
 129 findAdded :: (Ord k, Eq k) =>
 130                SyncCollection k v -> SyncCollection k v -> SyncCollection k v ->
 131                [(k, v)]
 132 findAdded state1 state2 lastchildstate =
 133     Map.toList . Map.difference state1 . Map.union state2 $ lastchildstate
 134
 135 {- | Apply the specified changes to the given SyncCollection.  Returns
 136 a new SyncCollection with the changes applied.  If changes are specified
 137 that would apply to UIDs that do not exist in the source list, these changes
 138 are silently ignored. -}
 139 unaryApplyChanges :: (Eq k, Ord k, Show k, Show v) =>
 140                      SyncCollection k v -> [SyncCommand k v] -> SyncCollection k v
 141 unaryApplyChanges collection commands =
 142     let makeChange collection (DeleteItem key) =
 143             Map.delete key collection
 144         makeChange collection (CopyItem key val) =
 145             Map.insert key val collection
 146     in foldl makeChange collection commands