group: Added --list option

Seemed to make sense to exclude groups used only by dead repositories.
This commit is contained in:
Joey Hess 2024-05-29 13:37:30 -04:00
parent 09a0552489
commit 98762a2f96
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 46 additions and 12 deletions

View file

@ -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