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:
parent
0ecd05c28d
commit
baf226e313
4 changed files with 95 additions and 30 deletions
|
@ -34,6 +34,7 @@ import Config
|
|||
import Utility.Percentage
|
||||
import Logs.Transfer
|
||||
import Types.TrustLevel
|
||||
import qualified Limit
|
||||
|
||||
-- a named computation that produces a statistic
|
||||
type Stat = StatState (Maybe (String, StatState String))
|
||||
|
@ -56,17 +57,41 @@ data StatInfo = StatInfo
|
|||
type StatState = StateT StatInfo Annex
|
||||
|
||||
def :: [Command]
|
||||
def = [command "status" paramNothing seek
|
||||
def = [command "status" (paramOptional paramPaths) seek
|
||||
"shows status information about the annex"]
|
||||
|
||||
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
|
||||
- that share data go together.
|
||||
-}
|
||||
fast_stats :: [Stat]
|
||||
fast_stats =
|
||||
global_fast_stats :: [Stat]
|
||||
global_fast_stats =
|
||||
[ supported_backends
|
||||
, supported_remote_types
|
||||
, repository_mode
|
||||
|
@ -77,8 +102,8 @@ fast_stats =
|
|||
, transfer_list
|
||||
, disk_size
|
||||
]
|
||||
slow_stats :: [Stat]
|
||||
slow_stats =
|
||||
global_slow_stats :: [Stat]
|
||||
global_slow_stats =
|
||||
[ tmp_size
|
||||
, bad_data_size
|
||||
, local_annex_keys
|
||||
|
@ -88,15 +113,14 @@ slow_stats =
|
|||
, bloom_info
|
||||
, backend_usage
|
||||
]
|
||||
|
||||
start :: CommandStart
|
||||
start = do
|
||||
fast <- Annex.getState Annex.fast
|
||||
let stats = if fast then fast_stats else fast_stats ++ slow_stats
|
||||
showCustom "status" $ do
|
||||
evalStateT (mapM_ showStat stats) (StatInfo Nothing Nothing)
|
||||
return True
|
||||
stop
|
||||
local_stats :: [FilePath -> Stat]
|
||||
local_stats =
|
||||
[ local_dir
|
||||
, const local_annex_keys
|
||||
, const local_annex_size
|
||||
, const known_annex_keys
|
||||
, const known_annex_size
|
||||
]
|
||||
|
||||
stat :: String -> (String -> StatState String) -> Stat
|
||||
stat desc a = return $ Just (desc, a desc)
|
||||
|
@ -142,6 +166,9 @@ remote_list level = stat n $ nojson $ lift $ do
|
|||
where
|
||||
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" $ json id $
|
||||
showSizeKeys <$> cachedPresentData
|
||||
|
@ -246,6 +273,26 @@ cachedReferencedData = do
|
|||
put s { referencedData = Just 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 0 0 0 M.empty
|
||||
|
||||
|
@ -293,4 +340,3 @@ aside s = " (" ++ s ++ ")"
|
|||
|
||||
multiLine :: [String] -> String
|
||||
multiLine = concatMap (\l -> "\n\t" ++ l)
|
||||
|
||||
|
|
|
@ -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
|
||||
- symlinks in the git repo. -}
|
||||
withKeysReferenced :: v -> (Key -> v -> v) -> Annex v
|
||||
withKeysReferenced initial a = withKeysReferenced' initial folda
|
||||
withKeysReferenced initial a = withKeysReferenced' Nothing initial folda
|
||||
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. -}
|
||||
withKeysReferencedM :: (Key -> Annex ()) -> Annex ()
|
||||
withKeysReferencedM a = withKeysReferenced' () calla
|
||||
withKeysReferencedM a = withKeysReferenced' Nothing () calla
|
||||
where
|
||||
calla k _ = a k
|
||||
calla k _ _ = a k
|
||||
|
||||
withKeysReferenced' :: v -> (Key -> v -> Annex v) -> Annex v
|
||||
withKeysReferenced' initial a = do
|
||||
{- Folds an action over keys and files referenced in a particular directory. -}
|
||||
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
|
||||
r <- go initial files
|
||||
liftIO $ void clean
|
||||
return r
|
||||
where
|
||||
getfiles = ifM isBareRepo
|
||||
getfiles = case mdir of
|
||||
Nothing -> ifM isBareRepo
|
||||
( return ([], return True)
|
||||
, do
|
||||
top <- fromRepo Git.repoPath
|
||||
inRepo $ LsFiles.inRepo [top]
|
||||
)
|
||||
Just dir -> inRepo $ LsFiles.inRepo [dir]
|
||||
go v [] = return v
|
||||
go v (f:fs) = do
|
||||
x <- Backend.lookupFile f
|
||||
case x of
|
||||
Nothing -> go v fs
|
||||
Just (k, _) -> do
|
||||
!v' <- a k v
|
||||
!v' <- a k f v
|
||||
go v' fs
|
||||
|
||||
withKeysReferencedInGit :: (Key -> Annex ()) -> Annex ()
|
||||
|
|
2
debian/changelog
vendored
2
debian/changelog
vendored
|
@ -46,6 +46,8 @@ git-annex (4.20130228) UNRELEASED; urgency=low
|
|||
* addurl: Escape invalid characters in urls, rather than failing to
|
||||
use an invalid url.
|
||||
* 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
|
||||
|
||||
|
|
|
@ -394,13 +394,24 @@ subdirectories).
|
|||
To generate output suitable for the gource visualisation program,
|
||||
specify --gource.
|
||||
|
||||
* status
|
||||
* status [directory ...]
|
||||
|
||||
Displays some statistics and other information, including how much data
|
||||
is in the annex and a list of all known repositories.
|
||||
|
||||
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
|
||||
|
||||
Helps you keep track of your repositories, and the connections between them,
|
||||
|
|
Loading…
Add table
Reference in a new issue