From 430ad8ce85835e002a326b68813c51f85c91141e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 6 Jul 2012 16:39:07 -0400 Subject: it builds again Currently nothing waits on transfer processes. (Second drive of the day fried. Not concentrating very well.) --- Assistant/TransferSlots.hs | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 Assistant/TransferSlots.hs (limited to 'Assistant/TransferSlots.hs') diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs new file mode 100644 index 000000000..0e2bb98b0 --- /dev/null +++ b/Assistant/TransferSlots.hs @@ -0,0 +1,30 @@ +{- git-annex assistant transfer slots + - + - Copyright 2012 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Assistant.TransferSlots where + +import Control.Exception +import Control.Concurrent + +type TransferSlots = QSemN + +{- Number of concurrent transfers allowed to be run from the assistant. + - + - Transfers launched by other means, including by remote assistants, + - do not currently take up slots. + -} +numSlots :: Int +numSlots = 1 + +newTransferSlots :: IO TransferSlots +newTransferSlots = newQSemN numSlots + +{- Waits until a transfer slot becomes available, and runs a transfer + - action in the slot. + -} +inTransferSlot :: TransferSlots -> IO a -> IO a +inTransferSlot s = bracket_ (waitQSemN s 1) (signalQSemN s 1) -- cgit v1.2.3