refactor inAnnex remote checking to Remotes
This commit is contained in:
parent
0194394be6
commit
f3e4633e35
2 changed files with 18 additions and 15 deletions
13
Core.hs
13
Core.hs
|
@ -86,19 +86,12 @@ gitPreCommitHook repo = do
|
|||
p <- getPermissions hook
|
||||
setPermissions hook $ p {executable = True}
|
||||
|
||||
{- Checks if a given key is currently present in the annexLocation.
|
||||
-
|
||||
- This can be run against a remote repository to check the key there. -}
|
||||
{- Checks if a given key is currently present in the annexLocation. -}
|
||||
inAnnex :: Key -> Annex Bool
|
||||
inAnnex key = do
|
||||
g <- Annex.gitRepo
|
||||
if (not $ Git.repoIsUrl g)
|
||||
then liftIO $ doesFileExist $ annexLocation g key
|
||||
else do
|
||||
showNote ("checking " ++ Git.repoDescribe g ++ "...")
|
||||
liftIO $ boolSystem "ssh" [Git.urlHost g,
|
||||
"test -e " ++
|
||||
(shellEscape $ annexLocation g key)]
|
||||
when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo"
|
||||
liftIO $ doesFileExist $ annexLocation g key
|
||||
|
||||
{- Calculates the relative path to use to link a file to a key. -}
|
||||
calcGitLink :: FilePath -> Key -> Annex FilePath
|
||||
|
|
20
Remotes.hs
20
Remotes.hs
|
@ -81,14 +81,24 @@ keyPossibilities key = do
|
|||
- If the remote cannot be accessed, returns a Left error.
|
||||
-}
|
||||
inAnnex :: Git.Repo -> Key -> Annex (Either IOException Bool)
|
||||
inAnnex remote key = do
|
||||
-- the check needs to run in an Annex monad using the remote
|
||||
liftIO $ ((try $ check)::IO (Either IOException Bool))
|
||||
inAnnex r key = do
|
||||
if (not $ Git.repoIsUrl r)
|
||||
then check local
|
||||
else do
|
||||
Core.showNote ("checking " ++ Git.repoDescribe r ++ "...")
|
||||
check remote
|
||||
where
|
||||
check = do
|
||||
a <- Annex.new remote []
|
||||
check a = liftIO $ ((try a)::IO (Either IOException Bool))
|
||||
local = do
|
||||
-- run a local check by making an Annex monad
|
||||
-- using the remote
|
||||
a <- Annex.new r []
|
||||
(result, _) <- Annex.run a (Core.inAnnex key)
|
||||
return result
|
||||
remote = do
|
||||
-- remote check via ssh in and test
|
||||
boolSystem "ssh" [Git.urlHost r, "test -e " ++
|
||||
(shellEscape $ annexLocation r key)]
|
||||
|
||||
{- Cost Ordered list of remotes. -}
|
||||
remotesByCost :: Annex [Git.Repo]
|
||||
|
|
Loading…
Reference in a new issue