mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

it builds again

Browse source 
Currently nothing waits on transfer processes.

(Second drive of the day fried. Not concentrating very well.)
This commit is contained in:
Joey Hess 2012-07-06 16:39:07 -04:00
parent 8795a392c3
commit 430ad8ce85
3 changed files with 39 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

11
Assistant/Threads/Transferrer.hs
View file

@ -11,6 +11,7 @@ import Common.Annex
import Assistant.ThreadedMonad
import Assistant.DaemonStatus
import Assistant.TransferQueue
import Assistant.TransferSlots
import Logs.Transfer
import Annex.Content
import Utility.ThreadScheduler
@ -25,14 +26,16 @@ maxTransfers :: Int
maxTransfers = 1
{- Dispatches transfers from the queue. -}
transfererThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> IO ()
transfererThread st dstatus transferqueue = runEvery (Seconds 1) $ do
transfererThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> TransferSlots -> IO ()
transfererThread st dstatus transferqueue slots = runEvery (Seconds 1) $ do
(t, info) <- getNextTransfer transferqueue
c <- runThreadState st $ shouldTransfer dstatus t
let run = void $ inTransferSlot slots $
runTransfer st dstatus t info
case c of
Yes -> void $ runTransfer st dstatus t info
Yes -> run
Skip -> noop
TooMany -> void $ waitTransfer >> runTransfer st dstatus t info
TooMany -> waitTransfer >> run
data ShouldTransfer = Yes | Skip | TooMany