rework annex-ignore handling

Only one place need to filter the list of remotes for ignored remotes:
keyPossibilities. Make the full list available to everything else.

This allows getting rid of the special case handing for --from and --to
to make ignored remotes not be ignored with those options.
This commit is contained in:
Joey Hess 2011-09-18 20:11:39 -04:00
parent d78b9f7d54
commit dd463a3100
11 changed files with 24 additions and 25 deletions

View file

@ -26,7 +26,7 @@ import Control.Applicative hiding (empty)
import qualified Git import qualified Git
import Git.Queue import Git.Queue
import Types.Backend import Types.Backend
import Types.Remote import qualified Types.Remote
import Types.Crypto import Types.Crypto
import Types.BranchState import Types.BranchState
import Types.TrustLevel import Types.TrustLevel
@ -48,7 +48,7 @@ newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a }
data AnnexState = AnnexState data AnnexState = AnnexState
{ repo :: Git.Repo { repo :: Git.Repo
, backends :: [Backend Annex] , backends :: [Backend Annex]
, remotes :: [Remote Annex] , remotes :: [Types.Remote.Remote Annex]
, repoqueue :: Queue , repoqueue :: Queue
, output :: OutputType , output :: OutputType
, force :: Bool , force :: Bool

View file

@ -82,18 +82,10 @@ prop_cost_sane = False `notElem`
{- Checks if a repo should be ignored, based either on annex-ignore {- Checks if a repo should be ignored, based either on annex-ignore
- setting, or on command-line options. Allows command-line to override - setting, or on command-line options. Allows command-line to override
- annex-ignore. -} - annex-ignore. -}
remoteNotIgnored :: Git.Repo -> Annex Bool repoNotIgnored :: Git.Repo -> Annex Bool
remoteNotIgnored r = do repoNotIgnored r = do
ignored <- getConfig r "ignore" "false" ignored <- getConfig r "ignore" "false"
to <- match Annex.toremote return $ not $ Git.configTrue ignored
from <- match Annex.fromremote
if to || from
then return True
else return $ not $ Git.configTrue ignored
where
match a = do
n <- Annex.getState a
return $ n == Git.repoRemoteName r
{- If a value is specified, it is used; otherwise the default is looked up {- If a value is specified, it is used; otherwise the default is looked up
- in git config. forcenumcopies overrides everything. -} - in git config. forcenumcopies overrides everything. -}

View file

@ -16,7 +16,6 @@ module Remote (
hasKeyCheap, hasKeyCheap,
remoteTypes, remoteTypes,
genList,
byName, byName,
prettyPrintUUIDs, prettyPrintUUIDs,
remotesWithUUID, remotesWithUUID,
@ -29,7 +28,7 @@ module Remote (
forceTrust forceTrust
) where ) where
import Control.Monad (filterM) import Control.Monad.State (filterM)
import Data.List import Data.List
import qualified Data.Map as M import qualified Data.Map as M
import Data.String.Utils import Data.String.Utils
@ -83,7 +82,6 @@ genList = do
where where
process m t = process m t =
enumerate t >>= enumerate t >>=
filterM remoteNotIgnored >>=
mapM (gen m t) mapM (gen m t)
gen m t r = do gen m t r = do
u <- getUUID r u <- getUUID r
@ -184,7 +182,7 @@ keyPossibilities' withtrusted key = do
let validtrusteduuids = validuuids `intersect` trusted let validtrusteduuids = validuuids `intersect` trusted
-- remotes that match uuids that have the key -- remotes that match uuids that have the key
allremotes <- genList allremotes <- filterM (repoNotIgnored . repo) =<< genList
let validremotes = remotesWithUUID allremotes validuuids let validremotes = remotesWithUUID allremotes validuuids
return (sort validremotes, validtrusteduuids) return (sort validremotes, validtrusteduuids)

View file

@ -66,7 +66,8 @@ gen r u c = do
removeKey = remove, removeKey = remove,
hasKey = checkPresent r bupr', hasKey = checkPresent r bupr',
hasKeyCheap = bupLocal buprepo, hasKeyCheap = bupLocal buprepo,
config = c config = c,
repo = r
} }
bupSetup :: UUID -> RemoteConfig -> Annex RemoteConfig bupSetup :: UUID -> RemoteConfig -> Annex RemoteConfig

View file

@ -57,7 +57,8 @@ gen r u c = do
removeKey = remove dir, removeKey = remove dir,
hasKey = checkPresent dir, hasKey = checkPresent dir,
hasKeyCheap = True, hasKeyCheap = True,
config = Nothing config = Nothing,
repo = r
} }
directorySetup :: UUID -> RemoteConfig -> Annex RemoteConfig directorySetup :: UUID -> RemoteConfig -> Annex RemoteConfig

View file

@ -71,7 +71,8 @@ gen r u _ = do
removeKey = dropKey r', removeKey = dropKey r',
hasKey = inAnnex r', hasKey = inAnnex r',
hasKeyCheap = cheap, hasKeyCheap = cheap,
config = Nothing config = Nothing,
repo = r'
} }
{- Tries to read the config for a specified remote, updates state, and {- Tries to read the config for a specified remote, updates state, and

View file

@ -58,7 +58,8 @@ gen r u c = do
removeKey = remove hooktype, removeKey = remove hooktype,
hasKey = checkPresent r hooktype, hasKey = checkPresent r hooktype,
hasKeyCheap = False, hasKeyCheap = False,
config = Nothing config = Nothing,
repo = r
} }
hookSetup :: UUID -> RemoteConfig -> Annex RemoteConfig hookSetup :: UUID -> RemoteConfig -> Annex RemoteConfig

View file

@ -66,7 +66,8 @@ gen r u c = do
removeKey = remove o, removeKey = remove o,
hasKey = checkPresent r o, hasKey = checkPresent r o,
hasKeyCheap = False, hasKeyCheap = False,
config = Nothing config = Nothing,
repo = r
} }
genRsyncOpts :: Git.Repo -> Annex RsyncOpts genRsyncOpts :: Git.Repo -> Annex RsyncOpts

View file

@ -67,7 +67,8 @@ gen' r u c cst =
removeKey = remove this, removeKey = remove this,
hasKey = checkPresent this, hasKey = checkPresent this,
hasKeyCheap = False, hasKeyCheap = False,
config = c config = c,
repo = r
} }
s3Setup :: UUID -> RemoteConfig -> Annex RemoteConfig s3Setup :: UUID -> RemoteConfig -> Annex RemoteConfig

View file

@ -58,7 +58,8 @@ gen r _ _ =
removeKey = dropKey, removeKey = dropKey,
hasKey = checkKey, hasKey = checkKey,
hasKeyCheap = False, hasKeyCheap = False,
config = Nothing config = Nothing,
repo = r
} }
{- The urls for a key are stored in remote/web/hash/key.log {- The urls for a key are stored in remote/web/hash/key.log

View file

@ -51,7 +51,9 @@ data Remote a = Remote {
-- operation. -- operation.
hasKeyCheap :: Bool, hasKeyCheap :: Bool,
-- a Remote can have a persistent configuration store -- a Remote can have a persistent configuration store
config :: Maybe RemoteConfig config :: Maybe RemoteConfig,
-- git configuration for the remote
repo :: Git.Repo
} }
instance Show (Remote a) where instance Show (Remote a) where