avoid repeatedly searching path to make batch command when running transferkeys
This commit is contained in:
parent
0d91432442
commit
0fd6078865
4 changed files with 45 additions and 33 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue