From 5f6a8cd075968bf7014f9b0ef165f2ca3c07a585 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 11 Mar 2013 01:22:56 -0400
Subject: status: Can now be run with a directory path to show only the status
 of that directory, rather than the whole annex.

---
 Command/Status.hs  | 78 +++++++++++++++++++++++++++++++++++++++++++-----------
 Command/Unused.hs  | 32 +++++++++++++---------
 debian/changelog   |  2 ++
 doc/git-annex.mdwn | 13 ++++++++-
 4 files changed, 95 insertions(+), 30 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 ()
diff --git a/debian/changelog b/debian/changelog
index f09a347a9..9cac59c1f 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -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
 
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index a05104fa8..7d9928d71 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -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,
-- 
cgit v1.2.3