diff options
| -rw-r--r-- | Assistant/Threads/Committer.hs | 3 | ||||
| -rw-r--r-- | Assistant/Types/Changes.hs | 24 |
2 files changed, 25 insertions, 2 deletions
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index c7633d590..0bdbb0378 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -55,7 +55,8 @@ commitThread = namedThread "Committer" $ do =<< annexDelayAdd <$> Annex.getGitConfig msg <- liftAnnex Command.Sync.commitMsg waitChangeTime $ \(changes, time) -> do - readychanges <- handleAdds havelsof delayadd changes + readychanges <- handleAdds havelsof delayadd $ + simplifyChanges changes if shouldCommit False time (length readychanges) readychanges then do debug diff --git a/Assistant/Types/Changes.hs b/Assistant/Types/Changes.hs index 8c2d02cab..70c40523a 100644 --- a/Assistant/Types/Changes.hs +++ b/Assistant/Types/Changes.hs @@ -1,10 +1,12 @@ {- git-annex assistant change tracking - - - Copyright 2012-2013 Joey Hess <id@joeyh.name> + - Copyright 2012-2015 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} +{-# LANGUAGE BangPatterns #-} + module Assistant.Types.Changes where import Types.KeySource @@ -14,6 +16,7 @@ import Annex.Ingest import Control.Concurrent.STM import Data.Time.Clock +import qualified Data.Set as S {- An un-ordered pool of Changes that have been noticed and should be - staged and committed. Changes will typically be in order, but ordering @@ -76,3 +79,22 @@ finishedChange c@(InProcessAddChange {}) k = Change , changeInfo = AddKeyChange k } finishedChange c _ = c + +{- Combine PendingAddChanges that are for the same file. + - Multiple such often get noticed when eg, a file is opened and then + - closed in quick succession. -} +simplifyChanges :: [Change] -> [Change] +simplifyChanges [c] = [c] +simplifyChanges cl = go cl S.empty [] + where + go [] _ l = reverse l + go (c:cs) seen l + | isPendingAddChange c = + if S.member f seen + then go cs seen l + else + let !seen' = S.insert f seen + in go cs seen' (c:l) + | otherwise = go cs seen (c:l) + where + f = changeFile c |