From 99514f9d18f56e716678c6446873cf818653c836 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 18 Aug 2024 11:18:16 -0400 Subject: [PATCH] maxsize overview display and --json support --- CHANGELOG | 2 +- Command/Info.hs | 3 +- Command/MaxSize.hs | 81 +++++++++++++++++++++++++++------ Messages.hs | 11 +++-- Remote.hs | 21 +++++++-- Types/RepoSize.hs | 4 +- doc/git-annex-maxsize.mdwn | 12 ++++- doc/todo/git-annex_proxies.mdwn | 2 - 8 files changed, 109 insertions(+), 27 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index bd9330e2f5..a56638aeb1 100644 --- a/CHANGELOG +++ b/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. diff --git a/Command/Info.hs b/Command/Info.hs index 0e75c84245..bb3471ad06 100644 --- a/Command/Info.hs +++ b/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 diff --git a/Command/MaxSize.hs b/Command/MaxSize.hs index 19788ad3eb..3efaed5880 100644 --- a/Command/MaxSize.hs +++ b/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 - "configure maximum size of repositoriy" - (paramPair paramRepository (paramOptional paramSize)) - (seek <$$> optParser) +cmd = noMessages $ withAnnexOptions [jsonOptions] $ + command "maxsize" SectionSetup + "configure maximum size of repositoriy" + (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 - startingCustomOutput (ActionItemOther Nothing) $ do + enableNormalOutput + 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 - then show n - else preciseSize storageUnits False n + formatSize o (preciseSize storageUnits True) 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 diff --git a/Messages.hs b/Messages.hs index c6ba6ed40a..b989d1dd8b 100644 --- a/Messages.hs +++ b/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 - QuietOutput -> Annex.setOutput NormalOutput - _ -> noop + enableNormalOutput 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 diff --git a/Remote.hs b/Remote.hs index eea052e254..326fd59fca 100644 --- a/Remote.hs +++ b/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) diff --git a/Types/RepoSize.hs b/Types/RepoSize.hs index efd4d59dbb..3710c5490c 100644 --- a/Types/RepoSize.hs +++ b/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) diff --git a/doc/git-annex-maxsize.mdwn b/doc/git-annex-maxsize.mdwn index 3efc1d623e..04870ce777 100644 --- a/doc/git-annex-maxsize.mdwn +++ b/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, -it displays the currently configured maxsize. +stored in a repository. When run with a repository but without a size, +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 diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn index 21fdc8fd99..6843ec7d38 100644 --- a/doc/todo/git-annex_proxies.mdwn +++ b/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.