keep logs of failed transfers, and requeue them when doing a non-full scan

of a remote

1 files changed, 16 insertions, 11 deletions

diff --git a/Assistant/ScanRemotes.hs b/Assistant/ScanRemotes.hs
index 524dc200b..2920e89c3 100644
--- a/Assistant/ScanRemotes.hs
+++ b/Assistant/ScanRemotes.hs
@@ -14,9 +14,12 @@ import Data.Function
 import Control.Concurrent.STM
 import qualified Data.Map as M
 
-type Priority = Int
+data ScanInfo = ScanInfo
+	{ scanPriority :: Int
+	, fullScan :: Bool
+	}
 
-type ScanRemoteMap = TMVar (M.Map Remote Priority)
+type ScanRemoteMap = TMVar (M.Map Remote ScanInfo)
 
 {- The TMVar starts empty, and is left empty when there are no remotes
  - to scan. -}
@@ -25,21 +28,23 @@ newScanRemoteMap = atomically newEmptyTMVar
 
 {- Blocks until there is a remote that needs to be scanned.
  - Processes higher priority remotes first. -}
-getScanRemote :: ScanRemoteMap -> IO Remote
+getScanRemote :: ScanRemoteMap -> IO (Remote, ScanInfo)
 getScanRemote v = atomically $ do
 	m <- takeTMVar v
-	let l = reverse $ map fst $ sortBy (compare `on` snd) $ M.toList m
+	let l = reverse $ sortBy (compare `on` scanPriority . snd) $ M.toList m
 	case l of
 		[] -> retry -- should never happen
-		(newest:_) -> do
-			let m' = M.delete newest m
+		(ret@(r, _):_) -> do
+			let m' = M.delete r m
 			unless (M.null m') $
 				putTMVar v m'
-			return newest
+			return ret
 
 {- Adds new remotes that need scanning to the map. -}
-addScanRemotes :: ScanRemoteMap -> [Remote] -> IO ()
-addScanRemotes _ [] = noop
-addScanRemotes v rs = atomically $ do
+addScanRemotes :: ScanRemoteMap -> [Remote] -> Bool -> IO ()
+addScanRemotes _ [] _ = noop
+addScanRemotes v rs full = atomically $ do
 	m <- fromMaybe M.empty <$> tryTakeTMVar v
-	putTMVar v $ M.union m $ M.fromList $ map (\r -> (r, Remote.cost r)) rs
+	putTMVar v $ M.union (M.fromList $ zip rs (map info rs)) m
+	where
+		info r = ScanInfo (Remote.cost r) full