break module dependancy loop
A PITA but worth it to clean up the trust configuration code.
This commit is contained in:
parent
0d5c402210
commit
07cacbeee9
10 changed files with 109 additions and 107 deletions
58
Remote/List.hs
Normal file
58
Remote/List.hs
Normal file
|
@ -0,0 +1,58 @@
|
|||
{- git-annex remote list
|
||||
-
|
||||
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- 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
|
||||
|
||||
import qualified Remote.Git
|
||||
import qualified Remote.S3
|
||||
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
|
||||
, Remote.S3.remote
|
||||
, 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
|
||||
process m t = enumerate t >>= mapM (gen m t)
|
||||
gen m t r = do
|
||||
u <- getRepoUUID r
|
||||
generate t r u (M.lookup u m)
|
||||
|
||||
{- All remotes that are not ignored. -}
|
||||
enabledRemoteList :: Annex [Remote]
|
||||
enabledRemoteList = filterM (repoNotIgnored . repo) =<< remoteList
|
Loading…
Add table
Add a link
Reference in a new issue