copy --to S3 works

This commit is contained in:
Joey Hess 2011-03-29 17:57:20 -04:00
parent 72f94cc42e
commit 0782d70063
4 changed files with 60 additions and 67 deletions

View file

@ -14,9 +14,7 @@ import Control.Exception.Extensible
import Control.Monad.State (liftIO)
import qualified Data.Map as M
import System.Cmd.Utils
import Control.Monad (filterM, liftM, when)
import Data.String.Utils
import Maybe
import Control.Monad (filterM)
import RemoteClass
import Types
@ -35,40 +33,35 @@ import Config
remote :: RemoteType Annex
remote = RemoteType {
typename = "git",
generator = gen,
enumerate = list,
generate = gen,
setup = error "not supported"
}
gen :: Annex [Remote Annex]
gen = do
list :: Annex [Git.Repo]
list = do
g <- Annex.gitRepo
allremotes <- filterM remoteNotIgnored $ Git.remotes g
filterM remoteNotIgnored $ Git.remotes g
gen :: Git.Repo -> Maybe (M.Map String String) -> Annex (Remote Annex)
gen repo _ = 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 = filter (not . Git.repoIsUrl) allremotes
let expensive = filter Git.repoIsUrl allremotes
expensive_todo <- filterM noCachedUUID expensive
let skip = filter (`notElem` expensive_todo) expensive
let todo = cheap++expensive_todo
when (not $ null expensive_todo) $
showNote $ "getting UUID for " ++ (join ", " $
map Git.repoDescribe expensive_todo)
done <- mapM tryGitConfigRead todo
generated <- mapM genRemote $ skip ++ done
return $ catMaybes generated
where
noCachedUUID r = liftM null $ getUUID r
let cheap = not $ Git.repoIsUrl repo
u <- getUUID repo
repo' <- case (cheap, u) of
(True, _) -> tryGitConfigRead repo
(False, "") -> tryGitConfigRead repo
_ -> return repo
genRemote repo'
genRemote :: Git.Repo -> Annex (Maybe (Remote Annex))
genRemote :: Git.Repo -> Annex (Remote Annex)
genRemote r = do
u <- getUUID r
c <- remoteCost r
return $ Just $ Remote {
return $ Remote {
uuid = u,
cost = c,
name = Git.repoDescribe r,