finally using transferkeys
Seems to work! Even progress bars. Have not tested prompting or various error message displays yet. transferkeys had to be made to operate in different modes for the Assistant and Annex monads. A bit ugly, but it did relegate that really ugly Database.Keys.closeDb in transferkeys to only the assistant code path. This commit was sponsored by Noam Kremen.
This commit is contained in:
parent
4c47568876
commit
fcc9e01556
4 changed files with 132 additions and 68 deletions
|
@ -91,8 +91,7 @@ runTransferThread' mkcheck program batchmaker d run = go
|
|||
go = catchPauseResume $ do
|
||||
p <- runAssistant d $ liftAnnex $
|
||||
Annex.getState Annex.transferrerpool
|
||||
withTransferrer True mkcheck program batchmaker p
|
||||
run
|
||||
withTransferrer' True mkcheck program batchmaker p run
|
||||
pause = catchPauseResume $
|
||||
runEvery (Seconds 86400) noop
|
||||
{- Note: This must use E.try, rather than E.catch.
|
||||
|
@ -163,7 +162,7 @@ genTransfer t info = case transferRemote info of
|
|||
- usual cleanup. However, first check if something else is
|
||||
- running the transfer, to avoid removing active transfers.
|
||||
-}
|
||||
go remote transferrer = ifM (performTransfer transferrer t info liftAnnex)
|
||||
go remote transferrer = ifM (performTransfer transferrer AssistantLevel t (transferRemote info) (associatedFile info) liftAnnex)
|
||||
( do
|
||||
case associatedFile info of
|
||||
AssociatedFile Nothing -> noop
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue