blob: 0ce7a47ccf682216f92298dd32f79daa8dc5fcaf (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
{- git-annex assistant remotes needing scanning
-
- Copyright 2012 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Assistant.ScanRemotes where
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
{- Blocks until there is a remote or remotes that need to be scanned.
-
- The list has higher priority remotes listed first. -}
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 :: 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
{ scanPriority = max (scanPriority x) (scanPriority y)
, fullScan = fullScan x || fullScan y
}
|
