group: Added --list option
Seemed to make sense to exclude groups used only by dead repositories.
This commit is contained in:
parent
09a0552489
commit
98762a2f96
4 changed files with 46 additions and 12 deletions
|
@ -7,6 +7,7 @@ git-annex (10.20240431) UNRELEASED; urgency=medium
|
|||
git-remote-annex.
|
||||
* When building an adjusted unlocked branch, make pointer files
|
||||
executable when the annex object file is executable.
|
||||
* group: Added --list option.
|
||||
* fsck: Fix recent reversion that made it say it was checksumming files
|
||||
whose content is not present.
|
||||
* Avoid the --fast option preventing checksumming in some cases it
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2012 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2012-2024 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
@ -9,18 +9,38 @@ module Command.Group where
|
|||
|
||||
import Command
|
||||
import qualified Remote
|
||||
import Logs.Group
|
||||
import Types.Group
|
||||
import Logs.Group
|
||||
import Logs.UUID
|
||||
import Logs.Trust
|
||||
import Utility.SafeOutput
|
||||
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Map as M
|
||||
|
||||
cmd :: Command
|
||||
cmd = noMessages $ command "group" SectionSetup "add a repository to a group"
|
||||
(paramPair paramRemote paramDesc) (withParams seek)
|
||||
(paramPair paramRemote paramDesc) (seek <$$> optParser)
|
||||
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek = withWords (commandAction . start)
|
||||
data GroupOptions = GroupOptions
|
||||
{ cmdparams :: CmdParams
|
||||
, listOption :: Bool
|
||||
}
|
||||
|
||||
optParser :: CmdParamsDesc -> Parser GroupOptions
|
||||
optParser desc = GroupOptions
|
||||
<$> cmdParams desc
|
||||
<*> switch
|
||||
( long "list"
|
||||
<> help "list all currently defined groups"
|
||||
)
|
||||
|
||||
seek :: GroupOptions -> CommandSeek
|
||||
seek o
|
||||
| listOption o = if null (cmdparams o)
|
||||
then commandAction startList
|
||||
else giveup "Cannot combine --list with other options"
|
||||
| otherwise = commandAction $ start (cmdparams o)
|
||||
|
||||
start :: [String] -> CommandStart
|
||||
start ps@(name:g:[]) = do
|
||||
|
@ -33,12 +53,21 @@ start ps@(name:g:[]) = do
|
|||
start (name:[]) = do
|
||||
u <- Remote.nameToUUID name
|
||||
startingCustomOutput (ActionItemOther Nothing) $ do
|
||||
liftIO . putStrLn . safeOutput . unwords . map fmt . S.toList
|
||||
=<< lookupGroups u
|
||||
liftIO . listGroups =<< lookupGroups u
|
||||
next $ return True
|
||||
start _ = giveup "Specify a repository and a group."
|
||||
|
||||
startList :: CommandStart
|
||||
startList = startingCustomOutput (ActionItemOther Nothing) $ do
|
||||
us <- trustExclude DeadTrusted =<< M.keys <$> uuidDescMap
|
||||
gs <- foldl' S.union mempty <$> mapM lookupGroups us
|
||||
liftIO $ listGroups gs
|
||||
next $ return True
|
||||
|
||||
listGroups :: S.Set Group -> IO ()
|
||||
listGroups = liftIO . putStrLn . safeOutput . unwords . map fmt . S.toList
|
||||
where
|
||||
fmt (Group g) = decodeBS g
|
||||
start _ = giveup "Specify a repository and a group."
|
||||
|
||||
setGroup :: UUID -> Group -> CommandPerform
|
||||
setGroup uuid g = do
|
||||
|
|
|
@ -12,8 +12,8 @@ improvements on querying in this area.
|
|||
its preferred content expression, as well as any groupwanted expression,
|
||||
and the standard preferred content expression.
|
||||
|
||||
There could be a command that just outputs a list of groups, one per line.
|
||||
Maybe `git-annex group --list`
|
||||
There could be a command that just outputs a list of groups.
|
||||
Maybe `git-annex group --list` (update: implemented this)
|
||||
|
||||
Then you could get your dump of the groupwanted configurations for each
|
||||
group:
|
||||
|
|
|
@ -8,7 +8,7 @@ git annex group `repository [groupname]`
|
|||
|
||||
# DESCRIPTION
|
||||
|
||||
Adds a repository to a group, such as "archival", "enduser", or "transfer".
|
||||
Adds a repository to a group, such as "archive" or "transfer".
|
||||
The groupname must be a single word.
|
||||
|
||||
Omit the groupname to show the current groups that a repository is in.
|
||||
|
@ -20,7 +20,11 @@ A repository can be in multiple groups at the same time.
|
|||
|
||||
# OPTIONS
|
||||
|
||||
* The [[git-annex-common-options]](1) can be used.
|
||||
* `--list`
|
||||
|
||||
Outputs a list of all groups that are used by at least one repository.
|
||||
|
||||
* Also the [[git-annex-common-options]](1) can be used.
|
||||
|
||||
# SEE ALSO
|
||||
|
||||
|
|
Loading…
Reference in a new issue