diff options
author | Joey Hess <joey@kitenet.net> | 2011-03-28 23:51:07 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-03-28 23:51:07 -0400 |
commit | a3b6586902d6689b07c050b1fc50e19f4115c42e (patch) | |
tree | 51d1658cd393c31435cda2b618e03f68563b645a | |
parent | b1db436816b6b70ff0b9891bbc4a5468d9b895b3 (diff) |
update
-rw-r--r-- | Remote.hs | 19 | ||||
-rw-r--r-- | Remote/Git.hs | 14 | ||||
-rw-r--r-- | Remote/S3.hs | 14 | ||||
-rw-r--r-- | RemoteClass.hs | 17 |
4 files changed, 45 insertions, 19 deletions
@@ -44,17 +44,16 @@ import LocationLog import Locations import Messages -{- Add generators for new Remotes here. -} -generators :: [Annex (RemoteGenerator Annex)] -generators = - [ Remote.Git.generate - , Remote.S3.generate +remoteTypes :: [RemoteType Annex] +remoteTypes = + [ Remote.Git.remote + , Remote.S3.remote ] -{- Runs a list of generators. -} -runGenerators :: [Annex (RemoteGenerator Annex)] -> Annex [Remote Annex] -runGenerators gs = do - (actions, expensive) <- collect ([], []) gs +{- Runs the generators of each type of Remote -} +runGenerators :: Annex [Remote Annex] +runGenerators = do + (actions, expensive) <- collect ([], []) $ map generator remoteTypes when (not $ null expensive) $ showNote $ "getting UUID for " ++ join ", " expensive sequence actions @@ -71,7 +70,7 @@ genList = do rs <- Annex.getState Annex.remotes if null rs then do - rs' <- runGenerators generators + rs' <- runGenerators Annex.changeState $ \s -> s { Annex.remotes = rs' } return rs' else return rs diff --git a/Remote/Git.hs b/Remote/Git.hs index 9021a2230..68bd172e9 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -6,7 +6,7 @@ -} module Remote.Git ( - generate, + remote, onRemote ) where @@ -30,8 +30,11 @@ import RsyncFile import Ssh import Config -generate :: Annex (RemoteGenerator Annex) -generate = do +remote :: RemoteType Annex +remote = RemoteType { typename = "git", generator = gen } + +gen :: Annex (RemoteGenerator Annex) +gen = do g <- Annex.gitRepo allremotes <- filterM remoteNotIgnored $ Git.remotes g @@ -64,7 +67,10 @@ genRemote r = do retrieveKeyFile = copyFromRemote r, removeKey = dropKey r, hasKey = inAnnex r, - hasKeyCheap = not (Git.repoIsUrl r) + hasKeyCheap = not (Git.repoIsUrl r), + hasConfig = False, + config = Nothing, + setup = \_ -> return () } {- Tries to read the config for a specified remote, updates state, and diff --git a/Remote/S3.hs b/Remote/S3.hs index 23ec33bb5..4aa1bc639 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Remote.S3 (generate) where +module Remote.S3 (remote) where import Network.AWS.AWSConnection import Network.AWS.S3Object @@ -27,8 +27,11 @@ import qualified Annex import UUID import Config -generate :: Annex (RemoteGenerator Annex) -generate = do +remote :: RemoteType Annex +remote = RemoteType { typename = "S3", generator = gen } + +gen :: Annex (RemoteGenerator Annex) +gen = do g <- Annex.gitRepo remotes <- filterM remoteNotIgnored $ findS3Remotes g todo <- filterM cachedUUID remotes @@ -64,7 +67,10 @@ genRemote r u = do retrieveKeyFile = error "TODO", removeKey = error "TODO", hasKey = error "TODO", - hasKeyCheap = False + hasKeyCheap = False, + hasConfig = True, + config = Nothing, + setup = \_ -> return () } s3Connection :: Git.Repo -> Annex (Maybe AWSConnection) diff --git a/RemoteClass.hs b/RemoteClass.hs index eb4a01748..f3cc9379b 100644 --- a/RemoteClass.hs +++ b/RemoteClass.hs @@ -10,6 +10,7 @@ module RemoteClass where import Control.Exception +import Data.Map as M import Key @@ -18,6 +19,15 @@ import Key - that are not cheap to set up. -} type RemoteGenerator a = ([a (Remote a)], [String]) +{- There are different types of remotes. -} +data RemoteType a = RemoteType { + -- human visible type name + typename :: String, + -- generates remotes of this type + generator :: a (RemoteGenerator a) +} + +{- An individual remote. -} data Remote a = Remote { -- each Remote has a unique uuid uuid :: String, @@ -36,7 +46,12 @@ data Remote a = Remote { hasKey :: Key -> a (Either IOException Bool), -- Some remotes can check hasKey without an expensive network -- operation. - hasKeyCheap :: Bool + hasKeyCheap :: Bool, + -- a Remote may have a persistent configuration store + hasConfig :: Bool, + config :: Maybe (M.Map String String), + -- initializes or changes the config of a remote + setup :: M.Map String String -> a () } instance Show (Remote a) where |