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
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue