avoid repeatedly searching path to make batch command when running transferkeys

This commit is contained in:
Joey Hess 2013-12-01 15:37:51 -04:00
parent 0d91432442
commit 0fd6078865
4 changed files with 45 additions and 33 deletions

View file

@ -29,6 +29,7 @@ import qualified Types.Remote as Remote
import Annex.Content
import Annex.Wanted
import Config.Files
import Utility.Batch
import qualified Data.Map as M
import qualified Control.Exception as E
@ -44,17 +45,17 @@ type TransferGenerator = Assistant (Maybe (Transfer, TransferInfo, Transferrer -
{- Waits until a transfer slot becomes available, then runs a
- TransferGenerator, and then runs the transfer action in its own thread.
-}
inTransferSlot :: FilePath -> TransferGenerator -> Assistant ()
inTransferSlot program gen = do
inTransferSlot :: FilePath -> BatchCommandMaker -> TransferGenerator -> Assistant ()
inTransferSlot program batchmaker gen = do
flip MSemN.wait 1 <<~ transferSlots
runTransferThread program =<< gen
runTransferThread program batchmaker =<< gen
{- Runs a TransferGenerator, and its transfer action,
- without waiting for a slot to become available. -}
inImmediateTransferSlot :: FilePath -> TransferGenerator -> Assistant ()
inImmediateTransferSlot program gen = do
inImmediateTransferSlot :: FilePath -> BatchCommandMaker -> TransferGenerator -> Assistant ()
inImmediateTransferSlot program batchmaker gen = do
flip MSemN.signal (-1) <<~ transferSlots
runTransferThread program =<< gen
runTransferThread program batchmaker =<< gen
{- Runs a transfer action, in an already allocated transfer slot.
- Once it finishes, frees the transfer slot.
@ -66,19 +67,19 @@ inImmediateTransferSlot program gen = do
- then pausing the thread until a ResumeTransfer exception is raised,
- then rerunning the action.
-}
runTransferThread :: FilePath -> Maybe (Transfer, TransferInfo, Transferrer -> Assistant ()) -> Assistant ()
runTransferThread _ Nothing = flip MSemN.signal 1 <<~ transferSlots
runTransferThread program (Just (t, info, a)) = do
runTransferThread :: FilePath -> BatchCommandMaker -> Maybe (Transfer, TransferInfo, Transferrer -> Assistant ()) -> Assistant ()
runTransferThread _ _ Nothing = flip MSemN.signal 1 <<~ transferSlots
runTransferThread program batchmaker (Just (t, info, a)) = do
d <- getAssistant id
aio <- asIO1 a
tid <- liftIO $ forkIO $ runTransferThread' program d aio
tid <- liftIO $ forkIO $ runTransferThread' program batchmaker d aio
updateTransferInfo t $ info { transferTid = Just tid }
runTransferThread' :: FilePath -> AssistantData -> (Transferrer -> IO ()) -> IO ()
runTransferThread' program d run = go
runTransferThread' :: FilePath -> BatchCommandMaker -> AssistantData -> (Transferrer -> IO ()) -> IO ()
runTransferThread' program batchmaker d run = go
where
go = catchPauseResume $
withTransferrer program (transferrerPool d)
withTransferrer program batchmaker (transferrerPool d)
run
pause = catchPauseResume $
runEvery (Seconds 86400) noop
@ -279,7 +280,8 @@ startTransfer t = do
liftIO $ throwTo tid ResumeTransfer
start info = do
program <- liftIO readProgramFile
inImmediateTransferSlot program $
batchmaker <- liftIO getBatchCommandMaker
inImmediateTransferSlot program batchmaker $
genTransfer t info
getCurrentTransfers :: Assistant TransferMap