diff options
author | Ben Gamari <bgamari.foss@gmail.com> | 2012-10-05 17:02:51 -0400 |
---|---|---|
committer | Ben Gamari <bgamari.foss@gmail.com> | 2012-10-05 17:02:51 -0400 |
commit | d8087d187dfa7b8b9d19085d05533ed203131bdc (patch) | |
tree | 9fc514370be2adee26c92cfe49c2324d423ed45e /Assistant/TransferSlots.hs | |
parent | 17a218922b5892fb925b17c0f8acaddd333519b0 (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.hs | 13 |
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 |