split ScanRemotes and lifted

Assistant/Monad.hs

@@ -28,7 +28,7 @@ import Control.Monad.Base (liftBase, MonadBase)
 import Common.Annex
 import Assistant.Types.ThreadedMonad
 import Assistant.DaemonStatus
-import Assistant.ScanRemotes
+import Assistant.Types.ScanRemotes
 import Assistant.TransferQueue
 import Assistant.TransferSlots
 import Assistant.Types.Pushes

Assistant/ScanRemotes.hs

@@ -7,39 +7,32 @@
 
 module Assistant.ScanRemotes where
 
-import Common.Annex
+import Assistant.Common
+import Assistant.Types.ScanRemotes
 import qualified Types.Remote as Remote
 
 import Data.Function
 import Control.Concurrent.STM
 import qualified Data.Map as M
 
-data ScanInfo = ScanInfo
-	{ scanPriority :: Int
-	, fullScan :: Bool
-	}
-
-type ScanRemoteMap = TMVar (M.Map Remote ScanInfo)
-
-{- The TMVar starts empty, and is left empty when there are no remotes
- - to scan. -}
-newScanRemoteMap :: IO ScanRemoteMap
-newScanRemoteMap = atomically newEmptyTMVar
-
 {- Blocks until there is a remote or remotes that need to be scanned.
  -
  - The list has higher priority remotes listed first. -}
-getScanRemote :: ScanRemoteMap -> IO [(Remote, ScanInfo)]
+getScanRemote :: Assistant [(Remote, ScanInfo)]
-getScanRemote v = atomically $
+getScanRemote = do
-	reverse . sortBy (compare `on` scanPriority . snd) . M.toList
+	v <- getAssistant scanRemoteMap
-		<$> takeTMVar v
+	liftIO $ atomically $
+		reverse . sortBy (compare `on` scanPriority . snd) . M.toList
+			<$> takeTMVar v
 
 {- Adds new remotes that need scanning. -}
-addScanRemotes :: ScanRemoteMap -> Bool -> [Remote] -> IO ()
+addScanRemotes :: Bool -> [Remote] -> Assistant ()
-addScanRemotes _ _ [] = noop
+addScanRemotes _ [] = noop
-addScanRemotes v full rs = atomically $ do
+addScanRemotes full rs = do
-	m <- fromMaybe M.empty <$> tryTakeTMVar v
+	v <- getAssistant scanRemoteMap
-	putTMVar v $ M.unionWith merge (M.fromList $ zip rs (map info rs)) m
+	liftIO $ atomically $ do
+		m <- fromMaybe M.empty <$> tryTakeTMVar v
+		putTMVar v $ M.unionWith merge (M.fromList $ zip rs (map info rs)) m
 	where
 		info r = ScanInfo (-1 * Remote.cost r) full
 		merge x y = ScanInfo

Assistant/Sync.hs

@@ -41,8 +41,7 @@ reconnectRemotes notifypushes rs = void $ do
 	alertWhile (syncAlert rs) $ do
 		(ok, diverged) <- sync
 			=<< liftAnnex (inRepo Git.Branch.current)
-		scanremotes <- getAssistant scanRemoteMap
+		addScanRemotes diverged rs
-		liftIO $ addScanRemotes scanremotes diverged rs
 		return ok
 	where
 		(gitremotes, _specialremotes) =

Assistant/Threads/TransferScanner.hs

@@ -8,6 +8,7 @@
 module Assistant.Threads.TransferScanner where
 
 import Assistant.Common
+import Assistant.Types.ScanRemotes
 import Assistant.ScanRemotes
 import Assistant.TransferQueue
 import Assistant.DaemonStatus
@@ -36,7 +37,7 @@ transferScannerThread = NamedThread "TransferScanner" $ do
   where
 	go scanned = do
 		liftIO $ threadDelaySeconds (Seconds 2)
-		(rs, infos) <- unzip <$> getScanRemote <<~ scanRemoteMap
+		(rs, infos) <- unzip <$> getScanRemote
 		if any fullScan infos || any (`S.notMember` scanned) rs
 			then do
 				expensiveScan rs
@@ -56,10 +57,7 @@ transferScannerThread = NamedThread "TransferScanner" $ do
 	 -   and then the system (or us) crashed, and that info was
 	 -   lost.
 	 -}
-	startupScan = do
+	startupScan = addScanRemotes True =<< syncRemotes <$> daemonStatus
-		scanremotes <- getAssistant scanRemoteMap
-		liftIO . addScanRemotes scanremotes True
-			=<< syncRemotes <$> daemonStatus
 
 {- This is a cheap scan for failed transfers involving a remote. -}
 failedTransferScan :: Remote -> Assistant ()

Assistant/Types/ScanRemotes.hs

@@ -0,0 +1,25 @@
+{- git-annex assistant remotes needing scanning
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Types.ScanRemotes where
+
+import Common.Annex
+
+import Control.Concurrent.STM
+import qualified Data.Map as M
+
+data ScanInfo = ScanInfo
+	{ scanPriority :: Int
+	, fullScan :: Bool
+	}
+
+type ScanRemoteMap = TMVar (M.Map Remote ScanInfo)
+
+{- The TMVar starts empty, and is left empty when there are no remotes
+ - to scan. -}
+newScanRemoteMap :: IO ScanRemoteMap
+newScanRemoteMap = atomically newEmptyTMVar