diff options
author | Joey Hess <joey@kitenet.net> | 2012-10-29 19:14:30 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-10-29 19:14:30 -0400 |
commit | cb504374b53a940ea12feeb5ba91dd78466be455 (patch) | |
tree | a9e954e85c333a494016df935f32f13aeb38c02f /Assistant/ScanRemotes.hs | |
parent | 86b3857a4c1edafef817935ad3c5d63e6d2d3b25 (diff) |
split ScanRemotes and lifted
Diffstat (limited to 'Assistant/ScanRemotes.hs')
-rw-r--r-- | Assistant/ScanRemotes.hs | 37 |
1 files changed, 15 insertions, 22 deletions
diff --git a/Assistant/ScanRemotes.hs b/Assistant/ScanRemotes.hs index 661c98095..f367ab745 100644 --- a/Assistant/ScanRemotes.hs +++ b/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 v = atomically $ - reverse . sortBy (compare `on` scanPriority . snd) . M.toList - <$> takeTMVar v +getScanRemote :: Assistant [(Remote, ScanInfo)] +getScanRemote = do + v <- getAssistant scanRemoteMap + liftIO $ atomically $ + reverse . sortBy (compare `on` scanPriority . snd) . M.toList + <$> takeTMVar v {- Adds new remotes that need scanning. -} -addScanRemotes :: ScanRemoteMap -> Bool -> [Remote] -> IO () -addScanRemotes _ _ [] = noop -addScanRemotes v full rs = atomically $ do - m <- fromMaybe M.empty <$> tryTakeTMVar v - putTMVar v $ M.unionWith merge (M.fromList $ zip rs (map info rs)) m +addScanRemotes :: Bool -> [Remote] -> Assistant () +addScanRemotes _ [] = noop +addScanRemotes full rs = do + v <- getAssistant scanRemoteMap + 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 |