Merge branch 'master' into assistant
This commit is contained in:
commit
e0a65247ae
5 changed files with 54 additions and 35 deletions
5
Git.hs
5
Git.hs
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
2
debian/changelog
vendored
|
@ -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
5
doc/bugs/undefined.mdwn
Normal file
|
@ -0,0 +1,5 @@
|
|||
Trying to move files from a local remote that is not mounted:
|
||||
|
||||
git-annex: Prelude.undefined
|
||||
|
||||
> [[fixed|done]] --[[Joey]]
|
Loading…
Reference in a new issue