it builds again

Currently nothing waits on transfer processes.

(Second drive of the day fried. Not concentrating very well.)

1 files changed, 30 insertions, 0 deletions

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 <joey@kitenet.net>
+ -
+ - 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)