diff options
Diffstat (limited to 'Assistant/Threads/Committer.hs')
| -rw-r--r-- | Assistant/Threads/Committer.hs | 35 |
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 |