522f568450
Efficiently finding transfers that need to be done to get two repos back in sync seems like an interesting problem.
41 lines
1.1 KiB
Haskell
41 lines
1.1 KiB
Haskell
{- git-annex assistant remotes needing scanning
|
|
-
|
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Assistant.ScanRemotes where
|
|
|
|
import Common.Annex
|
|
import Data.Function
|
|
|
|
import Control.Concurrent.STM
|
|
import Data.Time.Clock
|
|
import qualified Data.Map as M
|
|
|
|
type ScanRemoteMap = TMVar (M.Map Remote UTCTime)
|
|
|
|
{- 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 that needs to be scanned.
|
|
- Processes remotes added most recently first. -}
|
|
getScanRemote :: ScanRemoteMap -> IO Remote
|
|
getScanRemote v = atomically $ do
|
|
m <- takeTMVar v
|
|
let newest = Prelude.head $ reverse $
|
|
map fst $ sortBy (compare `on` snd) $ M.toList m
|
|
putTMVar v $ M.delete newest m
|
|
return newest
|
|
|
|
{- Adds new remotes that need scanning to the map. -}
|
|
addScanRemotes :: ScanRemoteMap -> [Remote] -> IO ()
|
|
addScanRemotes _ [] = return ()
|
|
addScanRemotes v rs = do
|
|
now <- getCurrentTime
|
|
atomically $ do
|
|
m <- fromMaybe M.empty <$> tryTakeTMVar v
|
|
putTMVar v $ foldr (`M.insert` now) m rs
|