aboutsummaryrefslogtreecommitdiff
path: root/Assistant/TransferSlots.hs
diff options
context:
space:
mode:
authorGravatar Ben Gamari <bgamari.foss@gmail.com>2012-10-05 17:02:51 -0400
committerGravatar Ben Gamari <bgamari.foss@gmail.com>2012-10-05 17:02:51 -0400
commitd8087d187dfa7b8b9d19085d05533ed203131bdc (patch)
tree9fc514370be2adee26c92cfe49c2324d423ed45e /Assistant/TransferSlots.hs
parent17a218922b5892fb925b17c0f8acaddd333519b0 (diff)
TransferSlots: Use SafeSemaphore's MSemN instead of QSemN from base
As described in the documentation, QSemN is unsafe for a variety of reasons.
Diffstat (limited to 'Assistant/TransferSlots.hs')
-rw-r--r--Assistant/TransferSlots.hs13
1 files changed, 7 insertions, 6 deletions
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs
index 9e9156ad9..c41b1d28c 100644
--- a/Assistant/TransferSlots.hs
+++ b/Assistant/TransferSlots.hs
@@ -16,9 +16,10 @@ import Logs.Transfer
import qualified Control.Exception as E
import Control.Concurrent
+import qualified Control.Concurrent.MSemN as MSemN
import Data.Typeable
-type TransferSlots = QSemN
+type TransferSlots = MSemN.MSemN Int
{- A special exception that can be thrown to pause or resume a transfer, while
- keeping its slot in use. -}
@@ -39,21 +40,21 @@ numSlots :: Int
numSlots = 1
newTransferSlots :: IO TransferSlots
-newTransferSlots = newQSemN numSlots
+newTransferSlots = MSemN.new numSlots
{- Waits until a transfer slot becomes available, then runs a
- TransferGenerator, and then runs the transfer action in its own thread.
-}
inTransferSlot :: TransferSlotRunner
inTransferSlot dstatus s gen = do
- waitQSemN s 1
+ MSemN.wait s 1
runTransferThread dstatus s =<< gen
{- Runs a TransferGenerator, and its transfer action,
- without waiting for a slot to become available. -}
inImmediateTransferSlot :: TransferSlotRunner
inImmediateTransferSlot dstatus s gen = do
- signalQSemN s (-1)
+ MSemN.signal s (-1)
runTransferThread dstatus s =<< gen
{- Runs a transfer action, in an already allocated transfer slot.
@@ -67,7 +68,7 @@ inImmediateTransferSlot dstatus s gen = do
- then rerunning the action.
-}
runTransferThread :: DaemonStatusHandle -> TransferSlots -> Maybe (Transfer, TransferInfo, IO ()) -> IO ()
-runTransferThread _ s Nothing = signalQSemN s 1
+runTransferThread _ s Nothing = MSemN.signal s 1
runTransferThread dstatus s (Just (t, info, a)) = do
tid <- forkIO go
updateTransferInfo dstatus t $ info { transferTid = Just tid }
@@ -86,4 +87,4 @@ runTransferThread dstatus s (Just (t, info, a)) = do
Just ResumeTransfer -> go
_ -> done
_ -> done
- done = signalQSemN s 1
+ done = MSemN.signal s 1