refactor inAnnex remote checking to Remotes

This commit is contained in:
Joey Hess 2010-10-31 23:21:16 -04:00
parent 0194394be6
commit f3e4633e35
2 changed files with 18 additions and 15 deletions

13
Core.hs
View file

@ -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

View file

@ -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]