maxsize overview display and --json support

CHANGELOG

@@ -21,7 +21,7 @@ git-annex (10.20240831) UNRELEASED; urgency=medium
   * Support "balanced=" and "fullybalanced=" in preferred content expressions.
   * Added --rebalance option.
   * maxsize: New command to tell git-annex how large the expected maximum
-    size of a repository is.
+    size of a repository is, and to display repository sizes.
   * vicfg: Include maxsize configuration.
   * info: Improved speed.
 

Command/Info.hs

@@ -573,7 +573,8 @@ reposizes_stats count desc m = stat desc $ nojson $ do
 	let maxlen = maximum (map (length . snd) l)
 	descm <- lift Remote.uuidDescriptions
 	-- This also handles json display.
-	s <- lift $ Remote.prettyPrintUUIDsWith (Just "size") desc descm (Just . show) $
+	s <- lift $ Remote.prettyPrintUUIDsWith (Just "size") desc descm
+		(\sz -> Just $ show sz ++ ": ") $
 		map (\(u, sz) -> (u, Just $ mkdisp sz maxlen)) l
 	return $ if count
 		then countRepoList (length l) s

Command/MaxSize.hs

@@ -5,21 +5,28 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Command.MaxSize where
 
 import Command
 import qualified Remote
+import Annex.RepoSize
+import Types.RepoSize
 import Logs.MaxSize
-import Utility.SafeOutput
+import Logs.Trust
 import Utility.DataUnits
 
 import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Data.Text as T
 
 cmd :: Command
-cmd = noMessages $ command "maxsize" SectionSetup
+cmd = noMessages $ withAnnexOptions [jsonOptions] $ 
-	"configure maximum size of repositoriy"
+	command "maxsize" SectionSetup
-	(paramPair paramRepository (paramOptional paramSize))
+		"configure maximum size of repositoriy"
-	(seek <$$> optParser)
+		(paramPair paramRepository (paramOptional paramSize))
+		(seek <$$> optParser)
 
 data MaxSizeOptions = MaxSizeOptions
 	{ cmdparams :: CmdParams
@@ -37,16 +44,17 @@ optParser desc = MaxSizeOptions
 seek :: MaxSizeOptions -> CommandSeek
 seek o = case cmdparams o of
 	(rname:[]) -> commandAction $ do
-		u <- Remote.nameToUUID rname
+		enableNormalOutput
-		startingCustomOutput (ActionItemOther Nothing) $ do
+		showCustom "maxsize" (SeekInput [rname]) $ do
+			u <- Remote.nameToUUID rname
 			v <- M.lookup u <$> getMaxSizes
-			liftIO $ putStrLn $ safeOutput $ case v of
+			maybeAddJSONField "maxsize" (fromMaxSize <$> v)
+			showRaw $ encodeBS $ case v of
 				Just (MaxSize n) -> 
-					if bytesOption o
+					formatSize o (preciseSize storageUnits True) n
-						then show n
-						else preciseSize storageUnits False n
 				Nothing -> ""
-			next $ return True
+			return True
+		stop
 	(rname:sz:[]) -> commandAction $ do
 		u <- Remote.nameToUUID rname
 		let si = SeekInput (cmdparams o)
@@ -57,4 +65,51 @@ seek o = case cmdparams o of
 				Just n -> do
 					recordMaxSize u (MaxSize n)
 					next $ return True
-	_ -> giveup "Specify a repository."
+	[] -> commandAction $ sizeOverview o
+	_ -> giveup "Too many parameters"
+
+sizeOverview :: MaxSizeOptions -> CommandStart
+sizeOverview o = do
+	enableNormalOutput
+	showCustom "maxsize" (SeekInput []) $ do
+		descmap <- Remote.uuidDescriptions
+		deadset <- S.fromList <$> trustGet DeadTrusted
+		maxsizes <- getMaxSizes
+		reposizes <- flip M.withoutKeys deadset <$> getRepoSizes True
+		let l = reverse $ sortOn snd $ M.toList $
+			M.mapWithKey (gather maxsizes) reposizes
+		v <- Remote.prettyPrintUUIDsWith' False (Just "size")
+		 	"repositories" descmap showsizes l
+		showRaw $ encodeBS $ tableheader
+		showRaw $ encodeBS $ dropWhileEnd (== '\n') v
+		return True
+	stop
+  where
+	sizefield = "size" :: T.Text
+	maxsizefield = "maxsize" :: T.Text
+	
+	gather maxsizes u (RepoSize currsize) = Just $
+			M.fromList
+				[ (sizefield, Just currsize)
+				, (maxsizefield, fromMaxSize <$> M.lookup u maxsizes)
+				]
+
+	tableheader = tablerow ["size", "maxsize", "repository"]
+	
+	showsizes m = do
+		size <- M.lookup sizefield m
+		maxsize <- M.lookup maxsizefield m
+		return $ tablerow [formatsize size, formatsize maxsize, ""]
+	
+	formatsize = maybe "" (formatSize o (roughSize' storageUnits True 0))
+
+	padcolumn s = replicate (7 - length s) ' ' ++ s
+	
+	tablerow [] = ""
+	tablerow (s:[]) = " " ++ s
+	tablerow (s:l) = padcolumn s ++ " " ++ tablerow l
+					
+formatSize :: MaxSizeOptions -> (ByteSize -> String) -> ByteSize -> String
+formatSize o f n
+	| bytesOption o = show n
+	| otherwise = f n

Messages.hs

@@ -55,6 +55,7 @@ module Messages (
 	mkPrompter,
 	sanitizeTopLevelExceptionMessages,
 	countdownToMessage,
+	enableNormalOutput,
 ) where
 
 import Control.Concurrent
@@ -87,9 +88,7 @@ showStartMessage (StartMessage command ai si) =
   where
 	json = JSON.startActionItem command ai si
 showStartMessage (StartUsualMessages command ai si) = do
-	outputType <$> Annex.getState Annex.output >>= \case
+	enableNormalOutput
-		QuietOutput -> Annex.setOutput NormalOutput
-		_ -> noop
 	showStartMessage (StartMessage command ai si)
 showStartMessage (StartNoMessage _) = noop
 showStartMessage (CustomOutput _) =
@@ -379,3 +378,9 @@ countdownToMessage n showmsg
 	| otherwise = do
 		let !n' = pred n
 		return n'
+
+enableNormalOutput :: Annex ()
+enableNormalOutput =
+	outputType <$> Annex.getState Annex.output >>= \case
+		QuietOutput -> Annex.setOutput NormalOutput
+		_ -> noop

Remote.hs

@@ -40,6 +40,7 @@ module Remote (
 	prettyPrintUUIDs,
 	prettyPrintUUIDsDescs,
 	prettyPrintUUIDsWith,
+	prettyPrintUUIDsWith',
 	prettyListUUIDs,
 	prettyUUID,
 	remoteFromUUID,
@@ -229,11 +230,25 @@ prettyPrintUUIDsWith
 	-> (v -> Maybe String)
 	-> [(UUID, Maybe v)] 
 	-> Annex String
-prettyPrintUUIDsWith optfield header descm showval uuidvals = do
+prettyPrintUUIDsWith = prettyPrintUUIDsWith' True
+
+prettyPrintUUIDsWith'
+	:: ToJSON' v
+	=> Bool
+	-> Maybe String 
+	-> String 
+	-> UUIDDescMap
+	-> (v -> Maybe String)
+	-> [(UUID, Maybe v)] 
+	-> Annex String
+prettyPrintUUIDsWith' indented optfield header descm showval uuidvals = do
 	hereu <- getUUID
 	maybeShowJSON $ JSONChunk [(header, V.fromList $ map (jsonify hereu) uuidvals)]
-	return $ unwords $ map (\u -> "\t" ++ prettify hereu u ++ "\n") uuidvals
+	return $ concatMap 
+		(\u -> tabindent ++ prettify hereu u ++ "\n")
+		uuidvals
   where
+	tabindent = if indented then "\t" else ""
 	finddescription u = fromUUIDDesc $ M.findWithDefault mempty u descm
 	prettify hereu (u, optval)
 		| not (null d) = addoptval $ fromUUID u ++ " -- " ++ d
@@ -247,7 +262,7 @@ prettyPrintUUIDsWith optfield header descm showval uuidvals = do
 			| otherwise = n
 		addoptval s = case showval =<< optval of
 			Nothing -> s
-			Just val -> val ++ ": " ++ s
+			Just val -> val ++ s
 	jsonify hereu (u, optval) = object $ catMaybes
 		[ Just ("uuid", toJSON' (fromUUID u :: String))
 		, Just ("description", toJSON' $ finddescription u)

Types/RepoSize.hs

@@ -10,9 +10,9 @@
 module Types.RepoSize where
 
 -- The current size of a repo.
-newtype RepoSize = RepoSize Integer
+newtype RepoSize = RepoSize { fromRepoSize :: Integer }
 	deriving (Show, Eq, Ord, Num)
 
 -- The maximum size of a repo.
-newtype MaxSize = MaxSize Integer
+newtype MaxSize = MaxSize { fromMaxSize :: Integer }
 	deriving (Show, Eq, Ord)

doc/git-annex-maxsize.mdwn

@@ -8,11 +8,15 @@ git annex maxsize repository size
 
 git annex maxsize repository
 
+git annex maxsize
+
 # DESCRIPTION
 
 This configures the maximum combined size of annexed files that can be
-stored in a repository. When run without a size,
+stored in a repository. When run with a repository but without a size,
-it displays the currently configured maxsize.
+it displays the currently configured maxsize. When run without a
+repository, it displays an overview of the size and maxsize of all
+repositories.
 
 The repository can be specified by git remote name or
 by uuid. For the current repository, use "here".
@@ -35,6 +39,10 @@ gigabyte, then it would make sense to run
 
   Displays the maximum size in bytes, disabling the default nicer units.
 
+* `--json`
+
+  Enable JSON output.
+
 * The [[git-annex-common-options]](1) can also be used.
 
 # SEE ALSO

doc/todo/git-annex_proxies.mdwn

@@ -86,8 +86,6 @@ Planned schedule of work:
   overLocationLogs. In the other path it does not, and this should be fixed
   for consistency and correctness.
 
-* `git-annex info` can use maxsize to display how full repositories are
-
 * implement size-based balancing, so all balanced repositories are around
   the same percent full, either as the default or as another preferred
   content expression.