summaryrefslogtreecommitdiff
path: root/Command/Status.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Command/Status.hs')
-rw-r--r--Command/Status.hs29
1 files changed, 22 insertions, 7 deletions
diff --git a/Command/Status.hs b/Command/Status.hs
index 7bb4dc8ca..a3f5f1df7 100644
--- a/Command/Status.hs
+++ b/Command/Status.hs
@@ -11,6 +11,7 @@ module Command.Status where
import Control.Monad.State.Strict
import qualified Data.Map as M
+import qualified Data.Set as S
import Text.JSON
import Common.Annex
@@ -32,6 +33,8 @@ import Remote
import Config
import Utility.Percentage
import Logs.Transfer
+import Logs.Group
+import Types.Group
-- a named computation that produces a statistic
type Stat = StatState (Maybe (String, StatState String))
@@ -71,6 +74,7 @@ fast_stats =
, remote_list SemiTrusted "semitrusted"
, remote_list UnTrusted "untrusted"
, remote_list DeadTrusted "dead"
+ , group_list
, transfer_list
, disk_size
]
@@ -172,16 +176,23 @@ bloom_info = stat "bloom filter size" $ json id $ do
return $ size ++ note
+group_list :: Stat
+group_list = stat "repository groups" $ nojson $ lift $ do
+ m <- uuidsByGroup <$> groupMap
+ ls <- forM (M.toList m) $ \(g, s) -> do
+ l <- Remote.prettyListUUIDs (S.toList s)
+ return $ g ++ ": " ++ intercalate ", " l
+ return $ show (M.size m) ++ multiLine ls
+
transfer_list :: Stat
transfer_list = stat "transfers in progress" $ nojson $ lift $ do
uuidmap <- Remote.remoteMap id
ts <- getTransfers
if null ts
then return "none"
- else return $ pp uuidmap "" $ sort ts
+ else return $ multiLine $
+ map (\(t, i) -> line uuidmap t i) $ sort ts
where
- pp _ c [] = c
- pp uuidmap c ((t, i):xs) = "\n\t" ++ line uuidmap t i ++ pp uuidmap c xs
line uuidmap t i = unwords
[ showLcDirection (transferDirection t) ++ "ing"
, fromMaybe (key2file $ transferKey t) (associatedFile i)
@@ -213,10 +224,11 @@ backend_usage = stat "backend usage" $ nojson $
<$> (backendsKeys <$> cachedReferencedData)
<*> (backendsKeys <$> cachedPresentData)
where
- calc a b = pp "" $ reverse . sort $ map swap $ M.toList $ M.unionWith (+) a b
- pp c [] = c
- pp c ((n, b):xs) = "\n\t" ++ b ++ ": " ++ show n ++ pp c xs
- swap (a, b) = (b, a)
+ calc x y = multiLine $
+ map (\(n, b) -> b ++ ": " ++ show n) $
+ reverse $ sort $ map swap $ M.toList $
+ M.unionWith (+) x y
+ swap (x, y) = (y, x)
cachedPresentData :: StatState KeyData
cachedPresentData = do
@@ -284,3 +296,6 @@ staleSize label dirspec = go =<< lift (Command.Unused.staleKeys dirspec)
aside :: String -> String
aside s = " (" ++ s ++ ")"
+
+multiLine :: [String] -> String
+multiLine = concatMap (\l -> "\n\t" ++ l)