status: Can now be run with a directory path to show only the status of that directory, rather than the whole annex.

This commit is contained in:
Joey Hess 2013-03-11 01:22:56 -04:00
parent 0ecd05c28d
commit baf226e313
4 changed files with 95 additions and 30 deletions

View file

@ -34,6 +34,7 @@ import Config
import Utility.Percentage import Utility.Percentage
import Logs.Transfer import Logs.Transfer
import Types.TrustLevel import Types.TrustLevel
import qualified Limit
-- a named computation that produces a statistic -- a named computation that produces a statistic
type Stat = StatState (Maybe (String, StatState String)) type Stat = StatState (Maybe (String, StatState String))
@ -56,17 +57,41 @@ data StatInfo = StatInfo
type StatState = StateT StatInfo Annex type StatState = StateT StatInfo Annex
def :: [Command] def :: [Command]
def = [command "status" paramNothing seek def = [command "status" (paramOptional paramPaths) seek
"shows status information about the annex"] "shows status information about the annex"]
seek :: [CommandSeek] seek :: [CommandSeek]
seek = [withNothing start] seek = [withWords start]
start :: [FilePath] -> CommandStart
start [] = do
globalStatus
stop
start ps = do
mapM_ localStatus ps
stop
globalStatus :: Annex ()
globalStatus = do
fast <- Annex.getState Annex.fast
let stats = if fast
then global_fast_stats
else global_fast_stats ++ global_slow_stats
showCustom "status" $ do
evalStateT (mapM_ showStat stats) (StatInfo Nothing Nothing)
return True
localStatus :: FilePath -> Annex ()
localStatus dir = showCustom (unwords ["status", dir]) $ do
let stats = map (\s -> s dir) local_stats
evalStateT (mapM_ showStat stats) =<< getLocalStatInfo dir
return True
{- Order is significant. Less expensive operations, and operations {- Order is significant. Less expensive operations, and operations
- that share data go together. - that share data go together.
-} -}
fast_stats :: [Stat] global_fast_stats :: [Stat]
fast_stats = global_fast_stats =
[ supported_backends [ supported_backends
, supported_remote_types , supported_remote_types
, repository_mode , repository_mode
@ -77,8 +102,8 @@ fast_stats =
, transfer_list , transfer_list
, disk_size , disk_size
] ]
slow_stats :: [Stat] global_slow_stats :: [Stat]
slow_stats = global_slow_stats =
[ tmp_size [ tmp_size
, bad_data_size , bad_data_size
, local_annex_keys , local_annex_keys
@ -88,15 +113,14 @@ slow_stats =
, bloom_info , bloom_info
, backend_usage , backend_usage
] ]
local_stats :: [FilePath -> Stat]
start :: CommandStart local_stats =
start = do [ local_dir
fast <- Annex.getState Annex.fast , const local_annex_keys
let stats = if fast then fast_stats else fast_stats ++ slow_stats , const local_annex_size
showCustom "status" $ do , const known_annex_keys
evalStateT (mapM_ showStat stats) (StatInfo Nothing Nothing) , const known_annex_size
return True ]
stop
stat :: String -> (String -> StatState String) -> Stat stat :: String -> (String -> StatState String) -> Stat
stat desc a = return $ Just (desc, a desc) stat desc a = return $ Just (desc, a desc)
@ -142,6 +166,9 @@ remote_list level = stat n $ nojson $ lift $ do
where where
n = showTrustLevel level ++ " repositories" n = showTrustLevel level ++ " repositories"
local_dir :: FilePath -> Stat
local_dir dir = stat "directory" $ json id $ return dir
local_annex_size :: Stat local_annex_size :: Stat
local_annex_size = stat "local annex size" $ json id $ local_annex_size = stat "local annex size" $ json id $
showSizeKeys <$> cachedPresentData showSizeKeys <$> cachedPresentData
@ -246,6 +273,26 @@ cachedReferencedData = do
put s { referencedData = Just v } put s { referencedData = Just v }
return v return v
getLocalStatInfo :: FilePath -> Annex StatInfo
getLocalStatInfo dir = do
matcher <- Limit.getMatcher
(presentdata, referenceddata) <-
Command.Unused.withKeysFilesReferencedIn dir initial
(update matcher)
return $ StatInfo (Just presentdata) (Just referenceddata)
where
initial = (emptyKeyData, emptyKeyData)
update matcher key file vs@(presentdata, referenceddata) =
ifM (matcher $ Annex.FileInfo file file)
( (,)
<$> ifM (inAnnex key)
( return $ addKey key presentdata
, return presentdata
)
<*> pure (addKey key referenceddata)
, return vs
)
emptyKeyData :: KeyData emptyKeyData :: KeyData
emptyKeyData = KeyData 0 0 0 M.empty emptyKeyData = KeyData 0 0 0 M.empty
@ -293,4 +340,3 @@ aside s = " (" ++ s ++ ")"
multiLine :: [String] -> String multiLine :: [String] -> String
multiLine = concatMap (\l -> "\n\t" ++ l) multiLine = concatMap (\l -> "\n\t" ++ l)

View file

@ -213,36 +213,42 @@ bloomFilter convert l bloom = filter (\k -> convert k `notElemB` bloom) l
{- Given an initial value, folds it with each key referenced by {- Given an initial value, folds it with each key referenced by
- symlinks in the git repo. -} - symlinks in the git repo. -}
withKeysReferenced :: v -> (Key -> v -> v) -> Annex v withKeysReferenced :: v -> (Key -> v -> v) -> Annex v
withKeysReferenced initial a = withKeysReferenced' initial folda withKeysReferenced initial a = withKeysReferenced' Nothing initial folda
where where
folda k v = return $ a k v folda k _ v = return $ a k v
{- Runs an action on each referenced key in the git repo. -} {- Runs an action on each referenced key in the git repo. -}
withKeysReferencedM :: (Key -> Annex ()) -> Annex () withKeysReferencedM :: (Key -> Annex ()) -> Annex ()
withKeysReferencedM a = withKeysReferenced' () calla withKeysReferencedM a = withKeysReferenced' Nothing () calla
where where
calla k _ = a k calla k _ _ = a k
withKeysReferenced' :: v -> (Key -> v -> Annex v) -> Annex v {- Folds an action over keys and files referenced in a particular directory. -}
withKeysReferenced' initial a = do withKeysFilesReferencedIn :: FilePath -> v -> (Key -> FilePath -> v -> Annex v) -> Annex v
withKeysFilesReferencedIn = withKeysReferenced' . Just
withKeysReferenced' :: Maybe FilePath -> v -> (Key -> FilePath -> v -> Annex v) -> Annex v
withKeysReferenced' mdir initial a = do
(files, clean) <- getfiles (files, clean) <- getfiles
r <- go initial files r <- go initial files
liftIO $ void clean liftIO $ void clean
return r return r
where where
getfiles = ifM isBareRepo getfiles = case mdir of
( return ([], return True) Nothing -> ifM isBareRepo
, do ( return ([], return True)
top <- fromRepo Git.repoPath , do
inRepo $ LsFiles.inRepo [top] top <- fromRepo Git.repoPath
) inRepo $ LsFiles.inRepo [top]
)
Just dir -> inRepo $ LsFiles.inRepo [dir]
go v [] = return v go v [] = return v
go v (f:fs) = do go v (f:fs) = do
x <- Backend.lookupFile f x <- Backend.lookupFile f
case x of case x of
Nothing -> go v fs Nothing -> go v fs
Just (k, _) -> do Just (k, _) -> do
!v' <- a k v !v' <- a k f v
go v' fs go v' fs
withKeysReferencedInGit :: (Key -> Annex ()) -> Annex () withKeysReferencedInGit :: (Key -> Annex ()) -> Annex ()

2
debian/changelog vendored
View file

@ -46,6 +46,8 @@ git-annex (4.20130228) UNRELEASED; urgency=low
* addurl: Escape invalid characters in urls, rather than failing to * addurl: Escape invalid characters in urls, rather than failing to
use an invalid url. use an invalid url.
* addurl: Properly handle url-escaped characters in file:// urls. * addurl: Properly handle url-escaped characters in file:// urls.
* status: Can now be run with a directory path to show only the
status of that directory, rather than the whole annex.
-- Joey Hess <joeyh@debian.org> Wed, 27 Feb 2013 23:20:40 -0400 -- Joey Hess <joeyh@debian.org> Wed, 27 Feb 2013 23:20:40 -0400

View file

@ -394,13 +394,24 @@ subdirectories).
To generate output suitable for the gource visualisation program, To generate output suitable for the gource visualisation program,
specify --gource. specify --gource.
* status * status [directory ...]
Displays some statistics and other information, including how much data Displays some statistics and other information, including how much data
is in the annex and a list of all known repositories. is in the annex and a list of all known repositories.
To only show the data that can be gathered quickly, use --fast. To only show the data that can be gathered quickly, use --fast.
When a directory is specified, shows only an abbreviated status
display for that directory. In this mode, all of the file matching
options can be used to filter the files that will be included in
the status.
For example, suppose you want to run "git annex get .", but
would first like to see how much disk space that will use.
Then run:
git annex status . --not --in here
* map * map
Helps you keep track of your repositories, and the connections between them, Helps you keep track of your repositories, and the connections between them,