Merge branch 'master' into assistant

This commit is contained in:
Joey Hess 2012-06-26 17:23:20 -04:00
commit e0a65247ae
5 changed files with 54 additions and 35 deletions

5
Git.hs
View file

@ -19,6 +19,7 @@ module Git (
repoIsHttp,
repoIsLocal,
repoIsLocalBare,
repoIsLocalUnknown,
repoDescribe,
repoLocation,
repoPath,
@ -99,6 +100,10 @@ repoIsLocalBare :: Repo -> Bool
repoIsLocalBare Repo { location = Local { worktree = Nothing } } = True
repoIsLocalBare _ = False
repoIsLocalUnknown :: Repo -> Bool
repoIsLocalUnknown Repo { location = LocalUnknown { } } = True
repoIsLocalUnknown _ = False
assertLocal :: Repo -> a -> a
assertLocal repo action
| repoIsUrl repo = error $ unwords

View file

@ -75,7 +75,7 @@ byName' :: String -> Annex (Either String Remote)
byName' "" = return $ Left "no remote specified"
byName' n = handle . filter matching <$> remoteList
where
handle [] = Left $ "there is no git remote named \"" ++ n ++ "\""
handle [] = Left $ "there is no available git remote named \"" ++ n ++ "\""
handle match = Right $ Prelude.head match
matching r = n == name r || toUUID n == uuid r

View file

@ -42,7 +42,8 @@ remote = RemoteType {
list :: Annex [Git.Repo]
list = do
c <- fromRepo Git.config
mapM (tweakurl c) =<< fromRepo Git.remotes
rs <- mapM (tweakurl c) =<< fromRepo Git.remotes
catMaybes <$> mapM configread rs
where
annexurl n = "remote." ++ n ++ ".annexurl"
tweakurl c r = do
@ -52,39 +53,45 @@ list = do
Just url -> inRepo $ \g ->
Git.Construct.remoteNamed n $
Git.Construct.fromRemoteLocation url g
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
gen r u _ = do
{- It's assumed to be cheap to read the config of non-URL remotes,
- so this is done each time git-annex is run. Conversely,
- the config of an URL remote is only read when there is no
- cached UUID value. -}
let cheap = not $ Git.repoIsUrl 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 r = do
notignored <- repoNotIgnored r
r' <- case (cheap, notignored, u) of
u <- getRepoUUID r
r' <- case (repoCheap r, notignored, u) of
(_, False, _) -> return r
(True, _, _) -> tryGitConfigRead r
(False, _, NoUUID) -> tryGitConfigRead r
_ -> return r
{- A repo with a LocalUnknown location is not currently
- accessible, so skip it. -}
if Git.repoIsLocalUnknown r'
then return Nothing
else return $ Just r'
u' <- getRepoUUID r'
repoCheap :: Git.Repo -> Bool
repoCheap = not . Git.repoIsUrl
let defcst = if cheap then cheapRemoteCost else expensiveRemoteCost
cst <- remoteCost r' defcst
return Remote {
uuid = u',
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 = cheap,
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',
repo = r,
remotetype = remote
}

2
debian/changelog vendored
View file

@ -3,6 +3,8 @@ git-annex (3.20120625) UNRELEASED; urgency=low
* cabal: Only try to use inotify on Linux.
* Version build dependency on STM, and allow building without it,
which disables the watch command.
* Avoid ugly failure mode when moving content from a local repository
that is not available.
-- Joey Hess <joeyh@debian.org> Mon, 25 Jun 2012 11:38:12 -0400

5
doc/bugs/undefined.mdwn Normal file
View file

@ -0,0 +1,5 @@
Trying to move files from a local remote that is not mounted:
git-annex: Prelude.undefined
> [[fixed|done]] --[[Joey]]