From 3d30a45e72418927d55a31a4d3d7aa5cf0c5c365 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 6 Jul 2012 14:54:07 -0600 Subject: simplified background transferrs seem to work now --- Assistant/Threads/Transferrer.hs | 27 ++++++++------------------- 1 file changed, 8 insertions(+), 19 deletions(-) (limited to 'Assistant') diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs index 3e417e7ff..2d01855b4 100644 --- a/Assistant/Threads/Transferrer.hs +++ b/Assistant/Threads/Transferrer.hs @@ -29,31 +29,20 @@ maxTransfers = 1 transfererThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> TransferSlots -> IO () transfererThread st dstatus transferqueue slots = runEvery (Seconds 1) $ do (t, info) <- getNextTransfer transferqueue - c <- runThreadState st $ shouldTransfer dstatus t - let run = void $ inTransferSlot slots $ - runTransfer st dstatus t info - case c of - Yes -> run - Skip -> noop - TooMany -> waitTransfer >> run - -data ShouldTransfer = Yes | Skip | TooMany + whenM (runThreadState st $ shouldTransfer dstatus t) $ + void $ inTransferSlot slots $ + runTransfer st dstatus t info {- Checks if the requested transfer is already running, or - - the file to download is already present. - - - - There also may be too many transfers already running to service this - - transfer yet. -} -shouldTransfer :: DaemonStatusHandle -> Transfer -> Annex ShouldTransfer + - the file to download is already present. -} +shouldTransfer :: DaemonStatusHandle -> Transfer -> Annex Bool shouldTransfer dstatus t = go =<< currentTransfers <$> getDaemonStatus dstatus where go m - | M.member t m = return Skip - | M.size m > maxTransfers = return TooMany + | M.member t m = return False | transferDirection t == Download = - ifM (inAnnex $ transferKey t) - (return Skip, return Yes) - | otherwise = return Yes + inAnnex $ transferKey t + | otherwise = return True {- Waits for any of the transfers in the map to complete. -} waitTransfer :: IO () -- cgit v1.2.3