diff options
Diffstat (limited to 'Assistant/TransferSlots.hs')
| -rw-r--r-- | Assistant/TransferSlots.hs | 14 |
1 files changed, 12 insertions, 2 deletions
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index 0e2bb98b0..1859b281b 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -24,7 +24,17 @@ newTransferSlots :: IO TransferSlots newTransferSlots = newQSemN numSlots {- Waits until a transfer slot becomes available, and runs a transfer - - action in the slot. + - action in the slot. If the action throws an exception, its slot is + - freed here, otherwise it should be freed by the TransferWatcher when + - the transfer is complete. -} inTransferSlot :: TransferSlots -> IO a -> IO a -inTransferSlot s = bracket_ (waitQSemN s 1) (signalQSemN s 1) +inTransferSlot s a = bracketOnError start abort run + where + start = waitQSemN s 1 + abort = const $ transferComplete s + run = const a + +{- Call when a transfer is complete. -} +transferComplete :: TransferSlots -> IO () +transferComplete s = signalQSemN s 1 |