summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-03-11 01:22:56 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-03-11 01:22:56 -0400
commit5f6a8cd075968bf7014f9b0ef165f2ca3c07a585 (patch)
tree42da56040bcfea26e02874950f82243020dbdb8e /Command
parent3529ab26188f49250ca2b8d254594e72e4aaeabb (diff)
status: Can now be run with a directory path to show only the status of that directory, rather than the whole annex.
Diffstat (limited to 'Command')
-rw-r--r--Command/Status.hs78
-rw-r--r--Command/Unused.hs32
2 files changed, 81 insertions, 29 deletions
diff --git a/Command/Status.hs b/Command/Status.hs
index 89ba55cfa..5b9253780 100644
--- a/Command/Status.hs
+++ b/Command/Status.hs
@@ -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)
-
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 64a619b0a..25cd18c63 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -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
- ( return ([], return True)
- , do
- top <- fromRepo Git.repoPath
- inRepo $ LsFiles.inRepo [top]
- )
+ 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 ()