diff options
Diffstat (limited to 'Assistant/Threads')
| -rw-r--r-- | Assistant/Threads/Committer.hs | 28 |
1 files changed, 18 insertions, 10 deletions
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index d1fa7224e..e069bda21 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -75,33 +75,38 @@ refill cs = do debug ["delaying commit of", show (length cs), "changes"] refillChanges cs -{- Wait for one or more changes to arrive to be committed. -} +{- Wait for one or more changes to arrive to be committed, and then + - runs an action to commit them. If more changes arrive while this is + - going on, they're handled intelligently, batching up changes into + - large commits where possible, doing rename detection, and + - commiting immediately otherwise. -} waitChangeTime :: (([Change], UTCTime) -> Assistant Int) -> Assistant () -waitChangeTime a = go [] 0 +waitChangeTime a = waitchanges 0 where - go unhandled lastcommitsize = do + waitchanges lastcommitsize = do -- Wait one one second as a simple rate limiter. liftIO $ threadDelaySeconds (Seconds 1) -- Now, wait until at least one change is available for -- processing. cs <- getChanges - let changes = unhandled ++ cs + handlechanges cs lastcommitsize + handlechanges changes lastcommitsize = do let len = length changes -- See if now's a good time to commit. now <- liftIO getCurrentTime case (lastcommitsize >= maxCommitSize, shouldCommit now len changes, possiblyrename changes) of (True, True, _) | len > maxCommitSize -> - go [] =<< a (changes, now) + waitchanges =<< a (changes, now) | otherwise -> aftermaxcommit changes (_, True, False) -> - go [] =<< a (changes, now) + waitchanges =<< a (changes, now) (_, True, True) -> do morechanges <- getrelatedchanges changes - go [] =<< a (changes ++ morechanges, now) + waitchanges =<< a (changes ++ morechanges, now) _ -> do refill changes - go [] lastcommitsize + waitchanges lastcommitsize {- Did we perhaps only get one of the AddChange and RmChange pair - that make up a file rename? Or some of the pairs that make up @@ -158,14 +163,17 @@ waitChangeTime a = go [] 0 -} aftermaxcommit oldchanges = loop (30 :: Int) where - loop 0 = go oldchanges 0 + loop 0 = continue oldchanges loop n = do liftAnnex noop -- ensure Annex state is free liftIO $ threadDelaySeconds (Seconds 1) changes <- getAnyChanges if null changes then loop (n - 1) - else go (oldchanges ++ changes) 0 + else continue (oldchanges ++ changes) + continue cs + | null cs = waitchanges 0 + | otherwise = handlechanges cs 0 isRmChange :: Change -> Bool isRmChange (Change { changeInfo = i }) | i == RmChange = True |