converted 6 more threads

1 files changed, 83 insertions, 81 deletions

diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 28df518aa..8c46a79fa 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -10,7 +10,6 @@ module Assistant.Threads.TransferScanner where
 import Assistant.Common
 import Assistant.ScanRemotes
 import Assistant.TransferQueue
-import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.Alert
 import Assistant.Drop
@@ -27,64 +26,64 @@ import Annex.Wanted
 
 import qualified Data.Set as S
 
-thisThread :: ThreadName
-thisThread = "TransferScanner"
-
 {- This thread waits until a remote needs to be scanned, to find transfers
  - that need to be made, to keep data in sync.
  -}
-transferScannerThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> TransferQueue -> NamedThread
-transferScannerThread st dstatus scanremotes transferqueue = thread $ liftIO $ do
+transferScannerThread :: NamedThread
+transferScannerThread = NamedThread "TransferScanner" $ do
 	startupScan
 	go S.empty
-	where
-		thread = NamedThread thisThread
-		go scanned = do
-			threadDelaySeconds (Seconds 2)
-			(rs, infos) <- unzip <$> getScanRemote scanremotes
-			if any fullScan infos || any (`S.notMember` scanned) rs
-				then do
-					expensiveScan st dstatus transferqueue rs
-					go $ scanned `S.union` S.fromList rs
-				else do
-					mapM_ (failedTransferScan st dstatus transferqueue) rs
-					go scanned
-		{- All available remotes are scanned in full on startup,
-		 - for multiple reasons, including:
-		 -
-		 - * This may be the first run, and there may be remotes
-		 -   already in place, that need to be synced.
-		 - * We may have run before, and scanned a remote, but
-		 -   only been in a subdirectory of the git remote, and so
-		 -   not synced it all.
-		 - * We may have run before, and had transfers queued,
-		 -   and then the system (or us) crashed, and that info was
-		 -   lost.
-		 -}
-		startupScan = addScanRemotes scanremotes True
-			=<< syncRemotes <$> getDaemonStatus dstatus
+  where
+	go scanned = do
+		liftIO $ threadDelaySeconds (Seconds 2)
+		(rs, infos) <- unzip <$> getScanRemote <<~ scanRemoteMap
+		if any fullScan infos || any (`S.notMember` scanned) rs
+			then do
+				expensiveScan rs
+				go $ scanned `S.union` S.fromList rs
+			else do
+				mapM_ failedTransferScan rs
+				go scanned
+	{- All available remotes are scanned in full on startup,
+	 - for multiple reasons, including:
+	 -
+	 - * This may be the first run, and there may be remotes
+	 -   already in place, that need to be synced.
+	 - * We may have run before, and scanned a remote, but
+	 -   only been in a subdirectory of the git remote, and so
+	 -   not synced it all.
+	 - * We may have run before, and had transfers queued,
+	 -   and then the system (or us) crashed, and that info was
+	 -   lost.
+	 -}
+	startupScan = do
+		scanremotes <- getAssistant scanRemoteMap
+		liftIO . addScanRemotes scanremotes True
+			=<< syncRemotes <$> daemonStatus
 
 {- This is a cheap scan for failed transfers involving a remote. -}
-failedTransferScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO ()
-failedTransferScan st dstatus transferqueue r = do
-	failed <- runThreadState st $ getFailedTransfers (Remote.uuid r)
-	runThreadState st $ mapM_ removeFailedTransfer $ map fst failed
+failedTransferScan :: Remote -> Assistant ()
+failedTransferScan r = do
+	failed <- liftAnnex $ getFailedTransfers (Remote.uuid r)
+	liftAnnex $ mapM_ removeFailedTransfer $ map fst failed
 	mapM_ retry failed
-	where
-		retry (t, info)
-			| transferDirection t == Download = do
-				{- Check if the remote still has the key.
-				 - If not, relies on the expensiveScan to
-				 - get it queued from some other remote. -}
-				whenM (runThreadState st $ remoteHas r $ transferKey t) $
-					requeue t info
-			| otherwise = do
-				{- The Transferrer checks when uploading
-				 - that the remote doesn't already have the
-				 - key, so it's not redundantly checked
-				 - here. -}
+  where
+	retry (t, info)
+		| transferDirection t == Download = do
+			{- Check if the remote still has the key.
+			 - If not, relies on the expensiveScan to
+			 - get it queued from some other remote. -}
+			whenM (liftAnnex $ remoteHas r $ transferKey t) $
 				requeue t info
-		requeue t info = queueTransferWhenSmall
+		| otherwise = do
+			{- The Transferrer checks when uploading
+			 - that the remote doesn't already have the
+			 - key, so it's not redundantly checked here. -}
+			requeue t info
+	requeue t info = do
+		transferqueue <- getAssistant transferQueue
+		dstatus <- getAssistant daemonStatusHandle
+		liftIO $ queueTransferWhenSmall
 			transferqueue dstatus (associatedFile info) t r
 
 {- This is a expensive scan through the full git work tree, finding
@@ -98,42 +97,45 @@ failedTransferScan st dstatus transferqueue r = do
  - TODO: It would be better to first drop as much as we can, before
  - transferring much, to minimise disk use.
  -}
-expensiveScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> [Remote] -> IO ()
-expensiveScan st dstatus transferqueue rs = unless onlyweb $ do
-	brokendebug thisThread ["starting scan of", show visiblers]
-	void $ alertWhile dstatus (scanAlert visiblers) $ do
-		g <- runThreadState st gitRepo
-		(files, cleanup) <- LsFiles.inRepo [] g
+expensiveScan :: [Remote] -> Assistant ()
+expensiveScan rs = unless onlyweb $ do
+	debug ["starting scan of", show visiblers]
+	dstatus <- getAssistant daemonStatusHandle
+	void $ alertWhile dstatus (scanAlert visiblers) <~> do
+		g <- liftAnnex gitRepo
+		(files, cleanup) <- liftIO $ LsFiles.inRepo [] g
 		forM_ files $ \f -> do
-			ts <- runThreadState st $
-				ifAnnexed f (findtransfers f) (return [])
+			ts <- liftAnnex $
+				ifAnnexed f (findtransfers dstatus f) (return [])
 			mapM_ (enqueue f) ts
-		void cleanup
+		void $ liftIO cleanup
 		return True
-	brokendebug thisThread ["finished scan of", show visiblers]
-	where
-		onlyweb = all (== webUUID) $ map Remote.uuid rs
-		visiblers = let rs' = filter (not . Remote.readonly) rs
-			in if null rs' then rs else rs'
-		enqueue f (r, t) = do
-			brokendebug thisThread ["queuing", show t]
-			queueTransferWhenSmall transferqueue dstatus (Just f) t r
-		findtransfers f (key, _) = do
-			locs <- loggedLocations key
-			{- The syncable remotes may have changed since this
-			 - scan began. -}
-			syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus
-			present <- inAnnex key
+	debug ["finished scan of", show visiblers]
+  where
+	onlyweb = all (== webUUID) $ map Remote.uuid rs
+	visiblers = let rs' = filter (not . Remote.readonly) rs
+		in if null rs' then rs else rs'
+	enqueue f (r, t) = do
+		debug ["queuing", show t]
+		transferqueue <- getAssistant transferQueue
+		dstatus <- getAssistant daemonStatusHandle
+		liftIO $ queueTransferWhenSmall transferqueue dstatus (Just f) t r
+	findtransfers dstatus f (key, _) = do
+		locs <- loggedLocations key
+		{- The syncable remotes may have changed since this
+		 - scan began. -}
+		syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus
+		present <- inAnnex key
 
-			handleDrops' locs syncrs present key (Just f)
+		handleDrops' locs syncrs present key (Just f)
 
-			let slocs = S.fromList locs
-			let use a = return $ catMaybes $ map (a key slocs) syncrs
-			if present
-				then filterM (wantSend (Just f) . Remote.uuid . fst)
-					=<< use (genTransfer Upload False)
-				else ifM (wantGet $ Just f)
-					( use (genTransfer Download True) , return [] )
+		let slocs = S.fromList locs
+		let use a = return $ catMaybes $ map (a key slocs) syncrs
+		if present
+			then filterM (wantSend (Just f) . Remote.uuid . fst)
+				=<< use (genTransfer Upload False)
+			else ifM (wantGet $ Just f)
+				( use (genTransfer Download True) , return [] )
 
 genTransfer :: Direction -> Bool -> Key -> S.Set UUID -> Remote -> Maybe (Remote, Transfer)
 genTransfer direction want key slocs r