diff options
author | 2012-07-22 13:48:50 -0400 | |
---|---|---|
committer | 2012-07-22 14:30:43 -0400 | |
commit | 4ec9244f1af85b95d014103d93de913026b20fe3 (patch) | |
tree | c2ca5dbdc4817f1078b76cd445a4fa69531e905c /Remote/Git.hs | |
parent | e4592649d68535ad45fe37449a90427e84734359 (diff) |
add a path field to remotes
Also broke out some helper functions around constructing remotes,
to be used later.
Diffstat (limited to 'Remote/Git.hs')
-rw-r--r-- | Remote/Git.hs | 70 |
1 files changed, 40 insertions, 30 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs index 3412de89b..f42a1d536 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -5,7 +5,11 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Remote.Git (remote, repoAvail) where +module Remote.Git ( + remote, + configRead, + repoAvail, +) where import qualified Data.Map as M import Control.Exception.Extensible @@ -45,7 +49,7 @@ list :: Annex [Git.Repo] list = do c <- fromRepo Git.config rs <- mapM (tweakurl c) =<< fromRepo Git.remotes - mapM configread rs + mapM configRead rs where annexurl n = "remote." ++ n ++ ".annexurl" tweakurl c r = do @@ -55,19 +59,21 @@ list = do Just url -> inRepo $ \g -> Git.Construct.remoteNamed n $ Git.Construct.fromRemoteLocation url g - {- It's assumed to be cheap to read the config of non-URL - - remotes, so this is done each time git-annex is run - - in a way that uses remotes. - - Conversely, the config of an URL remote is only read - - when there is no cached UUID value. -} - configread r = do - notignored <- repoNotIgnored r - u <- getRepoUUID r - case (repoCheap r, notignored, u) of - (_, False, _) -> return r - (True, _, _) -> tryGitConfigRead r - (False, _, NoUUID) -> tryGitConfigRead r - _ -> return r + +{- It's assumed to be cheap to read the config of non-URL remotes, so this is + - done each time git-annex is run in a way that uses remotes. + - + - Conversely, the config of an URL remote is only read when there is no + - cached UUID value. -} +configRead :: Git.Repo -> Annex Git.Repo +configRead r = do + notignored <- repoNotIgnored r + u <- getRepoUUID r + case (repoCheap r, notignored, u) of + (_, False, _) -> return r + (True, _, _) -> tryGitConfigRead r + (False, _, NoUUID) -> tryGitConfigRead r + _ -> return r repoCheap :: Git.Repo -> Bool repoCheap = not . Git.repoIsUrl @@ -76,21 +82,25 @@ gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote gen r u _ = new <$> remoteCost r defcst where defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost - new cst = Remote { - uuid = u, - cost = cst, - name = Git.repoDescribe r, - storeKey = copyToRemote r, - retrieveKeyFile = copyFromRemote r, - retrieveKeyFileCheap = copyFromRemoteCheap r, - removeKey = dropKey r, - hasKey = inAnnex r, - hasKeyCheap = repoCheap r, - whereisKey = Nothing, - config = Nothing, - repo = r, - remotetype = remote - } + new cst = Remote + { uuid = u + , cost = cst + , name = Git.repoDescribe r + , storeKey = copyToRemote r + , retrieveKeyFile = copyFromRemote r + , retrieveKeyFileCheap = copyFromRemoteCheap r + , removeKey = dropKey r + , hasKey = inAnnex r + , hasKeyCheap = repoCheap r + , whereisKey = Nothing + , config = Nothing + , path = if Git.repoIsLocal r || Git.repoIsLocalUnknown r + then Just $ Git.repoPath r + else Nothing + , repo = r + , remotetype = remote + } + {- Checks relatively inexpensively if a repository is available for use. -} repoAvail :: Git.Repo -> Annex Bool |