diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-13 21:28:47 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-13 21:28:47 -0400 |
commit | b1607485168e851f69fe3a5b74d73f3c36edf886 (patch) | |
tree | 496133383a3aa77ecc373c383c6655e50d71f9c9 /Remotes.hs | |
parent | e5c1db355f5fa31af14ed8474aee89872b934f1a (diff) |
use a state monad
enormous reworking
Diffstat (limited to 'Remotes.hs')
-rw-r--r-- | Remotes.hs | 44 |
1 files changed, 27 insertions, 17 deletions
diff --git a/Remotes.hs b/Remotes.hs index ae709a3c2..399291467 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -5,6 +5,7 @@ module Remotes ( remotesWithKey ) where +import Control.Monad.State (liftIO) import Types import GitRepo import LocationLog @@ -17,34 +18,43 @@ remotesList :: [GitRepo] -> String remotesList remotes = join " " $ map gitRepoDescribe remotes {- Cost ordered list of remotes that the LocationLog indicate may have a key. -} -remotesWithKey :: State -> Key -> IO [GitRepo] -remotesWithKey state key = do - uuids <- keyLocations (repo state) key - return $ reposByUUID state (remotesByCost state) uuids +remotesWithKey :: Key -> Annex [GitRepo] +remotesWithKey key = do + g <- gitAnnex + uuids <- liftIO $ keyLocations g key + remotes <- remotesByCost + reposByUUID remotes uuids {- Cost Ordered list of remotes. -} -remotesByCost :: State -> [GitRepo] -remotesByCost state = reposByCost state $ gitConfigRemotes (repo state) +remotesByCost :: Annex [GitRepo] +remotesByCost = do + g <- gitAnnex + reposByCost $ gitConfigRemotes g {- Orders a list of git repos by cost. -} -reposByCost :: State -> [GitRepo] -> [GitRepo] -reposByCost state l = - fst $ unzip $ sortBy (\(r1, c1) (r2, c2) -> compare c1 c2) $ costpairs l +reposByCost :: [GitRepo] -> Annex [GitRepo] +reposByCost l = do + costpairs <- mapM costpair l + return $ fst $ unzip $ sortBy bycost $ costpairs where - costpairs l = map (\r -> (r, repoCost state r)) l + costpair r = do + cost <- repoCost r + return (r, cost) + bycost (_, c1) (_, c2) = compare c1 c2 {- Calculates cost for a repo. - - The default cost is 100 for local repositories, and 200 for remote - repositories; it can also be configured by remote.<name>.annex-cost -} -repoCost :: State -> GitRepo -> Int -repoCost state r = - if ((length $ config state r) > 0) - then read $ config state r +repoCost :: GitRepo -> Annex Int +repoCost r = do + g <- gitAnnex + if ((length $ config g r) > 0) + then return $ read $ config g r else if (gitRepoIsLocal r) - then 100 - else 200 + then return 100 + else return 200 where - config state r = gitConfig (repo state) (configkey r) "" + config g r = gitConfig g (configkey r) "" configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-cost" |