make start button work on queued transfers

When multiple downloads of a key are queued, it starts the first, but leaves the
other downloads in the queue. This ensures that we don't lose a queued
download if the one that got started failed.
This commit is contained in:
Joey Hess 2012-08-29 16:30:40 -04:00
parent c21a9fe04a
commit 8d32d54320
3 changed files with 66 additions and 51 deletions

View file

@ -209,8 +209,14 @@ cancelTransfer pause t = do
startTransfer :: Transfer -> Handler ()
startTransfer t = do
m <- getCurrentTransfers
webapp <- getYesod
let dstatus = daemonStatus webapp
let q = transferQueue webapp
{- resume a paused transfer -}
maybe noop go (M.lookup t m)
-- TODO: handle starting a queued transfer
{- start a queued transfer -}
is <- liftIO $ map snd <$> getMatchingTransfers q dstatus (== t)
maybe noop start $ headMaybe is
where
go info = maybe (start info) (resume info) $ transferTid info
resume info tid = do
@ -222,6 +228,7 @@ startTransfer t = do
throwTo tid ResumeTransfer
start info = do
webapp <- getYesod
let st = fromJust $ threadState webapp
let dstatus = daemonStatus webapp
let slots = transferSlots webapp
{- This transfer was being run by another process,
@ -230,8 +237,7 @@ startTransfer t = do
{ transferPid = Nothing, transferPaused = False }
liftIO $ inImmediateTransferSlot dstatus slots $ do
program <- readProgramFile
let a = Transferrer.doTransfer dstatus t info program
return $ Just (t, info, a)
Transferrer.startTransfer st dstatus program t info
getCurrentTransfers :: Handler TransferMap
getCurrentTransfers = currentTransfers