summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-13 14:51:09 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-13 14:51:09 -0400
commit77055f5ff82d2712f599ba77e03d5d2cc022ff65 (patch)
treec92c8085eac59d67130e1cb1bb55194e2051463a
parent771a6b36e1527571b9a38baacbee6e864f44172a (diff)
move some stuff out of IO
-rw-r--r--Annex.hs11
-rw-r--r--GitRepo.hs32
2 files changed, 22 insertions, 21 deletions
diff --git a/Annex.hs b/Annex.hs
index bd57514ea..e06bd84bc 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -9,7 +9,7 @@ module Annex (
annexWantFile,
annexDropFile,
annexPushRepo,
- repoCost,
+ annexRemotes,
annexPullRepo
) where
@@ -31,8 +31,9 @@ import Types
startAnnex :: IO State
startAnnex = do
r <- gitRepoFromCwd
- r' <- prepUUID r
- gitSetup r'
+ r' <- gitConfigRead r
+ r'' <- prepUUID r'
+ gitSetup r''
return State {
repo = r',
@@ -168,6 +169,10 @@ logStatus state key status = do
inAnnex :: State -> Backend -> Key -> IO Bool
inAnnex state backend key = doesFileExist $ annexLocation state backend key
+{- Ordered list of remotes for the annex. -}
+annexRemotes :: State -> [GitRepo]
+annexRemotes state = reposByCost state $ gitConfigRemotes (repo state)
+
{- Orders a list of git repos by cost. -}
reposByCost :: State -> [GitRepo] -> [GitRepo]
reposByCost state l =
diff --git a/GitRepo.hs b/GitRepo.hs
index c4a55863d..06e244d6b 100644
--- a/GitRepo.hs
+++ b/GitRepo.hs
@@ -54,22 +54,19 @@ data GitRepo =
remoteName :: Maybe String
} deriving (Show, Read, Eq)
-{- Local GitRepo constructor. Can optionally query the repo for its config. -}
-gitRepoFromPath :: FilePath -> Bool -> IO GitRepo
-gitRepoFromPath dir query = do
- let r = LocalGitRepo {
+{- Local GitRepo constructor. -}
+gitRepoFromPath :: FilePath -> GitRepo
+gitRepoFromPath dir =
+ LocalGitRepo {
top = dir,
config = Map.empty,
remoteName = Nothing
}
- if (query)
- then gitConfigRead r
- else return r
{- Remote GitRepo constructor. Throws exception on invalid url. -}
-gitRepoFromUrl :: String -> Bool -> IO GitRepo
-gitRepoFromUrl url query = do
- return $ RemoteGitRepo {
+gitRepoFromUrl :: String -> GitRepo
+gitRepoFromUrl url =
+ RemoteGitRepo {
url = url,
top = path url,
config = Map.empty,
@@ -187,18 +184,17 @@ gitConfig repo key defaultValue =
Map.findWithDefault defaultValue key (config repo)
{- Returns a list of a repo's configured remotes. -}
-gitConfigRemotes :: GitRepo -> IO [GitRepo]
-gitConfigRemotes repo = mapM construct remotes
+gitConfigRemotes :: GitRepo -> [GitRepo]
+gitConfigRemotes repo = map construct remotes
where
remotes = toList $ filter $ config repo
filter = filterWithKey (\k _ -> isremote k)
isremote k = (startswith "remote." k) && (endswith ".url" k)
remotename k = (split "." k) !! 1
- construct (k,v) = do
- r <- if (isURI v)
- then gitRepoFromUrl v False
- else gitRepoFromPath v False
- return r { remoteName = Just $ remotename k }
+ construct (k,v) = (gen v) { remoteName = Just $ remotename k }
+ gen v = if (isURI v)
+ then gitRepoFromUrl v
+ else gitRepoFromPath v
{- Finds the current git repository, which may be in a parent directory. -}
gitRepoFromCwd :: IO GitRepo
@@ -206,7 +202,7 @@ gitRepoFromCwd = do
cwd <- getCurrentDirectory
top <- seekUp cwd isRepoTop
case top of
- (Just dir) -> gitRepoFromPath dir True
+ (Just dir) -> return $ gitRepoFromPath dir
Nothing -> error "Not in a git repository."
seekUp :: String -> (String -> IO Bool) -> IO (Maybe String)