diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-07-06 16:44:13 -0600 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-07-06 16:44:13 -0600 |
| commit | 62876502c55958cd8f716d6676eb97825456d9b7 (patch) | |
| tree | 91bd4a801bb53cee557be73b175bfcc6220cc0e4 /Assistant/DaemonStatus.hs | |
| parent | 4a107951442f30354fa90b0b31200a9fdc86ffca (diff) | |
wait on child transfer processes, and invalidate cache
There's still a bug; if the child updates its transfer info file,
then the data from it will superscede the TransferInfo, losing the
info that we should wait on this child.
Diffstat (limited to 'Assistant/DaemonStatus.hs')
| -rw-r--r-- | Assistant/DaemonStatus.hs | 19 |
1 files changed, 16 insertions, 3 deletions
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index 40816bb1a..64c441cee 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -54,8 +54,11 @@ newDaemonStatus = DaemonStatus getDaemonStatus :: DaemonStatusHandle -> Annex DaemonStatus getDaemonStatus = liftIO . readMVar -modifyDaemonStatus :: DaemonStatusHandle -> (DaemonStatus -> DaemonStatus) -> Annex () -modifyDaemonStatus handle a = liftIO $ modifyMVar_ handle (return . a) +modifyDaemonStatus_ :: DaemonStatusHandle -> (DaemonStatus -> DaemonStatus) -> Annex () +modifyDaemonStatus_ handle a = liftIO $ modifyMVar_ handle (return . a) + +modifyDaemonStatus :: DaemonStatusHandle -> (DaemonStatus -> (DaemonStatus, b)) -> Annex b +modifyDaemonStatus handle a = liftIO $ modifyMVar handle (return . a) {- Load any previous daemon status file, and store it in the MVar for this - process to use as its DaemonStatus. Also gets current transfer status. -} @@ -137,5 +140,15 @@ tenMinutes = 10 * 60 {- Mutates the transfer map. -} adjustTransfers :: DaemonStatusHandle -> (TransferMap -> TransferMap) -> Annex () -adjustTransfers dstatus a = modifyDaemonStatus dstatus $ +adjustTransfers dstatus a = modifyDaemonStatus_ dstatus $ \s -> s { currentTransfers = a (currentTransfers s) } + +{- Removes a transfer from the map, and returns its info. -} +removeTransfer :: DaemonStatusHandle -> Transfer -> Annex (Maybe TransferInfo) +removeTransfer dstatus t = modifyDaemonStatus dstatus go + where + go s = + let (info, ts) = M.updateLookupWithKey + (\_k _v -> Nothing) + t (currentTransfers s) + in (s { currentTransfers = ts }, info) |