split ScanRemotes and lifted
This commit is contained in:
parent
86cb3faf51
commit
0c584bf70d
5 changed files with 45 additions and 30 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue