summaryrefslogtreecommitdiff
path: root/Assistant/Threads
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-07-06 16:39:07 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-07-06 16:41:37 -0400
commit430ad8ce85835e002a326b68813c51f85c91141e (patch)
treea22295b05a4c49e5cb483ec2b49df170b59c4cd8 /Assistant/Threads
parent8795a392c3f283d8e372cac3d82d29ca52c9cfb5 (diff)
it builds again
Currently nothing waits on transfer processes. (Second drive of the day fried. Not concentrating very well.)
Diffstat (limited to 'Assistant/Threads')
-rw-r--r--Assistant/Threads/Transferrer.hs11
1 files changed, 7 insertions, 4 deletions
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 0d0bc6f6d..3e417e7ff 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -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