1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
{- git-annex command
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Status where
import Control.Monad.State
import Data.Maybe
import System.IO
import Data.List
import qualified Data.Map as M
import qualified Annex
import qualified BackendClass
import qualified RemoteClass
import qualified Remote
import qualified Command.Unused
import qualified GitRepo as Git
import Command
import Types
import DataUnits
import Content
import Key
import Locations
-- a named computation that produces a statistic
type Stat = StatState (Maybe (String, StatState String))
-- cached info that multiple Stats may need
data StatInfo = StatInfo
{ keysPresentCache :: (Maybe (SizeList Key))
, keysReferencedCache :: (Maybe (SizeList Key))
}
-- a state monad for running Stats in
type StatState = StateT StatInfo Annex
-- a list with a known length
-- (Integer is used for the length to avoid
-- blowing up if someone annexed billions of files..)
type SizeList a = ([a], Integer)
sizeList :: [a] -> SizeList a
sizeList l = (l, genericLength l)
command :: [Command]
command = [repoCommand "status" (paramNothing) seek
"shows status information about the annex"]
seek :: [CommandSeek]
seek = [withNothing start]
{- Order is significant. Less expensive operations, and operations
- that share data go together.
-}
faststats :: [Stat]
faststats =
[ supported_backends
, supported_remote_types
, tmp_size
, bad_data_size
]
slowstats :: [Stat]
slowstats =
[ local_annex_keys
, local_annex_size
, total_annex_keys
, total_annex_size
, backend_usage
]
start :: CommandStartNothing
start = do
fast <- Annex.getState Annex.fast
let todo = if fast then faststats else faststats ++ slowstats
evalStateT (mapM_ showStat todo) (StatInfo Nothing Nothing)
stop
stat :: String -> StatState String -> Stat
stat desc a = return $ Just (desc, a)
nostat :: Stat
nostat = return $ Nothing
showStat :: Stat -> StatState ()
showStat s = calc =<< s
where
calc (Just (desc, a)) = do
liftIO $ putStr $ desc ++ ": "
liftIO $ hFlush stdout
liftIO . putStrLn =<< a
calc Nothing = return ()
supported_backends :: Stat
supported_backends = stat "supported backends" $
lift (Annex.getState Annex.supportedBackends) >>=
return . unwords . (map BackendClass.name)
supported_remote_types :: Stat
supported_remote_types = stat "supported remote types" $
return $ unwords $ map RemoteClass.typename Remote.remoteTypes
local_annex_size :: Stat
local_annex_size = stat "local annex size" $
cachedKeysPresent >>= keySizeSum
total_annex_size :: Stat
total_annex_size = stat "total annex size" $
cachedKeysReferenced >>= keySizeSum
local_annex_keys :: Stat
local_annex_keys = stat "local annex keys" $
return . show . snd =<< cachedKeysPresent
total_annex_keys :: Stat
total_annex_keys = stat "total annex keys" $
return . show . snd =<< cachedKeysReferenced
tmp_size :: Stat
tmp_size = staleSize "temporary directory size" gitAnnexTmpDir
bad_data_size :: Stat
bad_data_size = staleSize "bad keys size" gitAnnexBadDir
backend_usage :: Stat
backend_usage = stat "backend usage" $
return . usage =<< cachedKeysReferenced
where
usage (ks, _) = pp "" $ sort $ map swap $ splits ks
splits :: [Key] -> [(String, Integer)]
splits ks = M.toList $ M.fromListWith (+) $ map tcount ks
tcount k = (keyBackendName k, 1)
swap (a, b) = (b, a)
pp c [] = c
pp c ((n, b):xs) = "\n\t" ++ b ++ ": " ++ show n ++ pp c xs
cachedKeysPresent :: StatState (SizeList Key)
cachedKeysPresent = do
s <- get
case keysPresentCache s of
Just v -> return v
Nothing -> do
keys <- lift $ getKeysPresent
let v = sizeList keys
put s { keysPresentCache = Just v }
return v
cachedKeysReferenced :: StatState (SizeList Key)
cachedKeysReferenced = do
s <- get
case keysReferencedCache s of
Just v -> return v
Nothing -> do
keys <- lift $ Command.Unused.getKeysReferenced
-- A given key may be referenced repeatedly.
-- nub does not seem too slow (yet)..
let v = sizeList $ nub keys
put s { keysReferencedCache = Just v }
return v
keySizeSum :: SizeList Key -> StatState String
keySizeSum (keys, len) = do
let knownsize = catMaybes $ map keySize keys
let total = roughSize storageUnits False $ foldl (+) 0 knownsize
let missing = len - genericLength knownsize
return $ total ++
if missing > 0
then aside $ "but " ++ show missing ++ " keys have unknown size"
else ""
staleSize :: String -> (Git.Repo -> FilePath) -> Stat
staleSize label dirspec = do
keys <- lift (Command.Unused.staleKeys dirspec)
if null keys
then nostat
else stat label $ do
s <- keySizeSum $ sizeList keys
return $ s ++ aside "clean up with git-annex unused"
aside :: String -> String
aside s = "\t(" ++ s ++ ")"
|
