summaryrefslogtreecommitdiff
path: root/Assistant/TransferSlots.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-08-12 12:36:08 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-08-12 12:36:08 -0400
commita73e271d604616e1e0cdb5d2720e851d7b9acb73 (patch)
treea87a0bb5988d5005c689882c3e335b9504d065d7 /Assistant/TransferSlots.hs
parentb6b8f6da9ce18c92cd5c813e07f06d392731bf86 (diff)
run resumed transfers immediately, do not wait for free transfer slot
The resumed transfer still uses a slot, so will delay other, queued transfers from starting.
Diffstat (limited to 'Assistant/TransferSlots.hs')
-rw-r--r--Assistant/TransferSlots.hs19
1 files changed, 14 insertions, 5 deletions
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs
index 81eb6500f..27b869f1d 100644
--- a/Assistant/TransferSlots.hs
+++ b/Assistant/TransferSlots.hs
@@ -25,6 +25,8 @@ data TransferException = PauseTransfer | ResumeTransfer
instance E.Exception TransferException
+type TransferSlotRunner = TransferSlots -> IO () -> IO ThreadId
+
{- Number of concurrent transfers allowed to be run from the assistant.
-
- Transfers launched by other means, including by remote assistants,
@@ -38,17 +40,24 @@ newTransferSlots = newQSemN numSlots
{- Waits until a transfer slot becomes available, and runs a transfer
- action in the slot, in its own thread.
- -
- - Note that the action is subject to being killed when the transfer
+ -}
+inTransferSlot :: TransferSlotRunner
+inTransferSlot = runTransferSlot (\s -> waitQSemN s 1)
+
+{- Runs a transfer action, without waiting for a slot to become available. -}
+inImmediateTransferSlot :: TransferSlotRunner
+inImmediateTransferSlot = runTransferSlot (\s -> signalQSemN s (-1))
+
+{- Note that the action is subject to being killed when the transfer
- is canceled or paused.
-
- A PauseTransfer exception is handled by letting the action be killed,
- then pausing the thread until a ResumeTransfer exception is raised,
- then rerunning the action.
-}
-inTransferSlot :: TransferSlots -> IO () -> IO ThreadId
-inTransferSlot s transfer = do
- waitQSemN s 1
+runTransferSlot :: (QSemN -> IO ()) -> TransferSlotRunner
+runTransferSlot allocator s transfer = do
+ allocator s
forkIO $ E.bracket_ noop (signalQSemN s 1) go
where
go = catchPauseResume transfer