don't implicitly include all when exclude options are used
This is less erorr-prone, and easier for the user to reason about; it preserves the man page's promise that only explicitly included information will be copied.
This commit is contained in:
parent
a58c90ccf4
commit
80a9944f3b
2 changed files with 68 additions and 53 deletions
|
@ -9,6 +9,8 @@ module Command.FilterBranch where
|
|||
|
||||
import Command
|
||||
|
||||
import qualified Data.Set as S
|
||||
|
||||
cmd :: Command
|
||||
cmd = withGlobalOptions [annexedMatchingOptions] $
|
||||
command "filter-branch" SectionMaintenance
|
||||
|
@ -18,61 +20,73 @@ cmd = withGlobalOptions [annexedMatchingOptions] $
|
|||
data FilterBranchOptions = FilterBranchOptions
|
||||
{ includeFiles :: CmdParams
|
||||
, keyOptions :: Maybe KeyOptions
|
||||
, includeKeyInformationFor :: [DeferredParse UUID]
|
||||
, excludeKeyInformationFor :: [DeferredParse UUID]
|
||||
, includeAllKeyInformation :: Bool
|
||||
, includeRepoConfigFor :: [DeferredParse UUID]
|
||||
, excludeRepoConfigFor :: [DeferredParse UUID]
|
||||
, includeAllRemoteConfig :: Bool
|
||||
, keyInformation :: [IncludeExclude (DeferredParse UUID)]
|
||||
, repoConfig :: [IncludeExclude (DeferredParse UUID)]
|
||||
, includeGlobalConfig :: Bool
|
||||
, excludeGlobalConfig :: Bool
|
||||
}
|
||||
|
||||
optParser :: CmdParamsDesc -> Parser FilterBranchOptions
|
||||
optParser desc = FilterBranchOptions
|
||||
<$> cmdParams desc
|
||||
<*> optional parseKeyOptions
|
||||
<*> many
|
||||
( parseRepositoryOption "include-key-information-for"
|
||||
"include key information for a repository"
|
||||
)
|
||||
<*> many
|
||||
( parseRepositoryOption "exclude-key-information-for"
|
||||
"exclude key information for a repository"
|
||||
)
|
||||
<*> switch
|
||||
( long "include-all-key-information"
|
||||
<> help "include key information for all repositories"
|
||||
)
|
||||
<*> many
|
||||
( parseRepositoryOption "include-repo-config-for"
|
||||
"include configuration specific to a repository"
|
||||
)
|
||||
<*> many
|
||||
( parseRepositoryOption "exclude-repo-config-for"
|
||||
"exclude configuration specific to a repository"
|
||||
)
|
||||
<*> switch
|
||||
( long "include-all-repo-config"
|
||||
<> help "include configuration of all repositories"
|
||||
)
|
||||
<*> many (parseIncludeExclude "key-information")
|
||||
<*> many (parseIncludeExclude "repo-config")
|
||||
<*> switch
|
||||
( long "include-global-config"
|
||||
<> help "include global configuration"
|
||||
)
|
||||
<*> switch
|
||||
( long "exclude-global-config"
|
||||
<> help "exclude global configuration"
|
||||
|
||||
data IncludeExclude t
|
||||
= Include t
|
||||
| Exclude t
|
||||
| IncludeAll
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
isInclude :: IncludeExclude t -> Bool
|
||||
isInclude (Include _) = True
|
||||
isInclude IncludeAll = True
|
||||
isInclude (Exclude _) = False
|
||||
|
||||
parseIncludeExclude :: String -> Parser (IncludeExclude (DeferredParse UUID))
|
||||
parseIncludeExclude s =
|
||||
( Include <$> parseRepositoryOption
|
||||
("include-" ++ s ++ "-for")
|
||||
"include information about a repository"
|
||||
) <|>
|
||||
( Exclude <$> parseRepositoryOption
|
||||
("exclude-" ++ s ++ "-for")
|
||||
"exclude information about a repository"
|
||||
) <|>
|
||||
( flag' IncludeAll
|
||||
( long ("include-all-" ++ s)
|
||||
<> help "include information about all non-excluded repositories"
|
||||
)
|
||||
)
|
||||
|
||||
parseRepositoryOption :: String -> String -> Parser (DeferredParse UUID)
|
||||
parseRepositoryOption s h = parseUUIDOption <$> strOption
|
||||
( long s
|
||||
<> metavar (paramRemote `paramOr` paramDesc `paramOr` paramUUID)
|
||||
<> help h
|
||||
<> metavar (paramRemote `paramOr` paramDesc `paramOr` paramUUID)
|
||||
<> completeRemotes
|
||||
)
|
||||
|
||||
mkUUIDMatcher :: [IncludeExclude (DeferredParse UUID)] -> Annex (UUID -> Bool)
|
||||
mkUUIDMatcher l = mkUUIDMatcher' <$> mapM get l
|
||||
where
|
||||
get (Include v) = Include <$> getParsed v
|
||||
get (Exclude v) = Exclude <$> getParsed v
|
||||
get IncludeAll = pure IncludeAll
|
||||
|
||||
mkUUIDMatcher' :: [IncludeExclude UUID] -> (UUID -> Bool)
|
||||
mkUUIDMatcher' l = \u ->
|
||||
(S.member (Include u) includes || S.member IncludeAll includes)
|
||||
&& S.notMember (Exclude u) excludes
|
||||
where
|
||||
(includes, excludes) = S.partition isInclude (S.fromList l)
|
||||
|
||||
seek :: FilterBranchOptions -> CommandSeek
|
||||
seek o = do
|
||||
keyinfomatcher <- mkUUIDMatcher (keyInformation o)
|
||||
configinfomatcher <- mkUUIDMatcher (repoConfig o)
|
||||
error "TODO"
|
||||
|
|
|
@ -53,18 +53,20 @@ multiple times.
|
|||
|
||||
When including information about a key, include information specific to
|
||||
this repository. The repository can be specified with a uuid or the name
|
||||
of a remote.
|
||||
of a remote. This option can be used repeatedly to include several
|
||||
repositories.
|
||||
|
||||
* `--include-all-key-information`
|
||||
|
||||
Include key information for all repositories, except any excluded with
|
||||
the `--exclude-key-information-for` option.
|
||||
|
||||
* `--exclude-key-information-for=repo`
|
||||
|
||||
When including information about a key, exclude information specific to
|
||||
this repository. The repository can be specified with a uuid or the name
|
||||
of a remote. When this is used, all repositories that are not
|
||||
excluded will be included.
|
||||
|
||||
* `--include-all-key-information`
|
||||
|
||||
Include key information for all repositories.
|
||||
of a remote. This option can be used repeatedly to exclude
|
||||
several repositories.
|
||||
|
||||
* `--include-repo-config-for=repo`
|
||||
|
||||
|
@ -74,17 +76,19 @@ multiple times.
|
|||
This includes the configuration of special remotes, which may include
|
||||
embedded credentials, or encryption parameters. It also includes trust
|
||||
settings, preferred content, etc. It does not include information
|
||||
about any git-annex keys.
|
||||
about any git-annex keys. This option can be used repeatedly to include
|
||||
several repositories.
|
||||
|
||||
* `--include-all-repo-config`
|
||||
|
||||
Include the configuration of all repositories, except for any excluded
|
||||
with the `--exclude-repo-config-for` option.
|
||||
|
||||
* `--exclude-repo-config-for=repo`
|
||||
|
||||
Exclude configuration specific to this repository.
|
||||
The repository can be specified with a uuid or the name of a remote.
|
||||
When this is used, all repositories that are not excluded will be included.
|
||||
|
||||
* `--include-all-repo-config`
|
||||
|
||||
Include the configuration of all repositories.
|
||||
This option can be used repeatedly to exclude several repositories.
|
||||
|
||||
* `--include-global-config`
|
||||
|
||||
|
@ -93,10 +97,6 @@ multiple times.
|
|||
This includes configs stored by [[git-annex-numcopies]](1),
|
||||
[[git-annex-config]](1), etc.
|
||||
|
||||
* `--exclude-global-config`
|
||||
|
||||
Do not include global configuration.
|
||||
|
||||
# EXAMPLES
|
||||
|
||||
You have a big git-annex repository and are splitting the directory "foo"
|
||||
|
@ -117,7 +117,8 @@ about which annexed files are stored in it, but without sharing anything
|
|||
about the configuration of the remote.
|
||||
|
||||
git-annex filter-branch --all --include-all-key-information \
|
||||
--exclude-repo-config-for=bar --include-global-config
|
||||
--include-all-repo-config --exclude-repo-config-for=bar \
|
||||
--include-global-config
|
||||
|
||||
# SEE ALSO
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue