2012-04-17 22:37:40 +00:00
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
|
2012-01-10 17:11:16 +00:00
|
|
|
{- git-annex remote list
|
|
|
|
-
|
2012-07-22 17:48:50 +00:00
|
|
|
- Copyright 2011,2012 Joey Hess <joey@kitenet.net>
|
2012-01-10 17:11:16 +00:00
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Remote.List where
|
|
|
|
|
|
|
|
import qualified Data.Map as M
|
|
|
|
|
|
|
|
import Common.Annex
|
|
|
|
import qualified Annex
|
|
|
|
import Logs.Remote
|
|
|
|
import Types.Remote
|
|
|
|
import Annex.UUID
|
|
|
|
import Config
|
2012-03-04 20:00:24 +00:00
|
|
|
import Remote.Helper.Hooks
|
2012-07-22 17:48:50 +00:00
|
|
|
import qualified Git
|
2012-01-10 17:11:16 +00:00
|
|
|
|
|
|
|
import qualified Remote.Git
|
2012-04-14 18:22:33 +00:00
|
|
|
#ifdef WITH_S3
|
2012-02-14 07:10:01 +00:00
|
|
|
import qualified Remote.S3
|
2012-04-14 18:22:33 +00:00
|
|
|
#endif
|
2012-01-10 17:11:16 +00:00
|
|
|
import qualified Remote.Bup
|
|
|
|
import qualified Remote.Directory
|
|
|
|
import qualified Remote.Rsync
|
|
|
|
import qualified Remote.Web
|
|
|
|
import qualified Remote.Hook
|
|
|
|
|
|
|
|
remoteTypes :: [RemoteType]
|
|
|
|
remoteTypes =
|
|
|
|
[ Remote.Git.remote
|
2012-04-14 18:22:33 +00:00
|
|
|
#ifdef WITH_S3
|
2012-02-14 07:10:01 +00:00
|
|
|
, Remote.S3.remote
|
2012-04-14 18:22:33 +00:00
|
|
|
#endif
|
2012-01-10 17:11:16 +00:00
|
|
|
, Remote.Bup.remote
|
|
|
|
, Remote.Directory.remote
|
|
|
|
, Remote.Rsync.remote
|
|
|
|
, Remote.Web.remote
|
|
|
|
, Remote.Hook.remote
|
|
|
|
]
|
|
|
|
|
|
|
|
{- Builds a list of all available Remotes.
|
|
|
|
- Since doing so can be expensive, the list is cached. -}
|
|
|
|
remoteList :: Annex [Remote]
|
|
|
|
remoteList = do
|
|
|
|
rs <- Annex.getState Annex.remotes
|
|
|
|
if null rs
|
|
|
|
then do
|
|
|
|
m <- readRemoteLog
|
|
|
|
rs' <- concat <$> mapM (process m) remoteTypes
|
|
|
|
Annex.changeState $ \s -> s { Annex.remotes = rs' }
|
|
|
|
return rs'
|
|
|
|
else return rs
|
|
|
|
where
|
2012-07-22 17:48:50 +00:00
|
|
|
process m t = enumerate t >>= mapM (remoteGen m t)
|
|
|
|
|
|
|
|
{- Generates a Remote. -}
|
|
|
|
remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex Remote
|
|
|
|
remoteGen m t r = do
|
|
|
|
u <- getRepoUUID r
|
|
|
|
addHooks =<< generate t r u (M.lookup u m)
|
2012-01-10 17:11:16 +00:00
|
|
|
|
|
|
|
{- All remotes that are not ignored. -}
|
|
|
|
enabledRemoteList :: Annex [Remote]
|
|
|
|
enabledRemoteList = filterM (repoNotIgnored . repo) =<< remoteList
|