summaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-03-11 15:46:09 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-03-11 15:46:09 -0400
commit4bc070f7bf8f86ff7c3bba3dc1245401c5ddf7a9 (patch)
tree26cd47b3e8abbe5d18fa642bd1cb96826c4fa767 /Assistant
parentce5156f836300a1b1f39dda9d5ddddf766b0b314 (diff)
better handling of batch renames
Rather than wait a full second, which may be longer than needed, or too short to get all the rename events, we start a mode where we wait 1/10th of a second, and if there are Changes received, wait again. Basically we're back in batch mode when this happens.
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/Threads/Committer.hs35
1 files changed, 22 insertions, 13 deletions
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index 029ac94d2..08d34dd06 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -80,22 +80,11 @@ waitChangeTime a = runEvery (Seconds 1) <~> do
changes <- getChanges
-- See if now's a good time to commit.
now <- liftIO getCurrentTime
- debug ["got", show changes]
case (shouldCommit now changes, possiblyrename changes) of
(True, False) -> a (changes, now)
(True, True) -> do
- {- Wait for other, related changes to arrive.
- - If there are multiple RmChanges, this is
- - probably a directory rename, so wait a full
- - second to get all the Changes involved. -}
- liftIO $ if length (filter isRmChange changes) > 1
- then threadDelaySeconds $ Seconds 1
- else humanImperceptibleDelay
- -- Don't block, but are there any new changes?
- morechanges <- getAnyChanges
- debug ["got more", show morechanges]
- let allchanges = changes++morechanges
- a (allchanges, now)
+ morechanges <- getrelatedchanges changes
+ a (changes ++ morechanges, now)
_ -> refill changes
where
{- Did we perhaps only get one of the AddChange and RmChange pair
@@ -107,6 +96,26 @@ waitChangeTime a = runEvery (Seconds 1) <~> do
renamepart (PendingAddChange _ _) = True
renamepart c = isRmChange c
+ {- Gets changes related to the passed changes, without blocking
+ - very long.
+ -
+ - If there are multiple RmChanges, this is probably a directory
+ - rename, in which case it may be necessary to wait longer to get
+ - all the Changes involved.
+ -}
+ getrelatedchanges oldchanges
+ | length (filter isRmChange oldchanges) > 1 =
+ concat <$> getbatchchanges []
+ | otherwise = do
+ liftIO humanImperceptibleDelay
+ getAnyChanges
+ getbatchchanges cs = do
+ liftIO $ threadDelay $ fromIntegral $ oneSecond `div` 10
+ cs' <- getAnyChanges
+ if null cs'
+ then return cs
+ else getbatchchanges (cs':cs)
+
isRmChange :: Change -> Bool
isRmChange (Change { changeInfo = i }) | i == RmChange = True
isRmChange _ = False