diff options
author | Joey Hess <joey@kitenet.net> | 2012-07-18 19:13:56 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-07-18 19:15:34 -0400 |
commit | cf47bb3f509ae63ad868b66c0b6f2baecb93e4c7 (patch) | |
tree | 60bfdab5cf877c4de206146c65e759f82cdf2e85 /Assistant/TransferSlots.hs | |
parent | eea0a3616cd1cbaf033649c11a5c2b650b6b632f (diff) |
run file transfers in threads, not processes
This should fix OSX/BSD issues with not noticing transfer information
files with kqueue. Now that threads are used, the thread can manage the
transfer slot allocation and deallocation by itself; much cleaner.
Diffstat (limited to 'Assistant/TransferSlots.hs')
-rw-r--r-- | Assistant/TransferSlots.hs | 16 |
1 files changed, 8 insertions, 8 deletions
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index 1859b281b..dc077254d 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -10,6 +10,9 @@ module Assistant.TransferSlots where import Control.Exception import Control.Concurrent +import Common.Annex +import Assistant.ThreadedMonad + type TransferSlots = QSemN {- Number of concurrent transfers allowed to be run from the assistant. @@ -24,16 +27,13 @@ newTransferSlots :: IO TransferSlots newTransferSlots = newQSemN numSlots {- Waits until a transfer slot becomes available, and runs a transfer - - 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 a = bracketOnError start abort run + - action in the slot, in its own thread. -} +inTransferSlot :: TransferSlots -> ThreadState -> Annex a -> IO ThreadId +inTransferSlot s st a = forkIO $ bracket_ start done run where start = waitQSemN s 1 - abort = const $ transferComplete s - run = const a + done = transferComplete s + run = unsafeRunThreadState st a {- Call when a transfer is complete. -} transferComplete :: TransferSlots -> IO () |