From 59ecc804cd7dbba143ebc6f1adcd63c4ba11cfd8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 7 Nov 2013 13:55:36 -0400
Subject: [PATCH] add new status command

This works for both direct and indirect mode.

It may need some performance tuning.

Note that unlike git status, it only shows the status of the work tree, not
the status of the index. So only one status letter, not two .. and since
files that have been added and not yet committed do not differ between the
work tree and the index, they are not shown. Might want to add display of
the index vs the last commit eventually.

This commit was sponsored by an unknown bitcoin contributor, whose
contribution as been going up lately! ;)
---
 Annex/CatFile.hs   |  8 ++---
 Command/Status.hs  | 89 ++++++++++++++++++++++++++++++++++++++++++++++
 Git/LsFiles.hs     |  7 ++++
 Git/Ref.hs         | 14 ++++++++
 GitAnnex.hs        |  2 ++
 doc/git-annex.mdwn | 14 +++++---
 6 files changed, 125 insertions(+), 9 deletions(-)
 create mode 100644 Command/Status.hs

diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs
index 407b4ddae3..812d032c6a 100644
--- a/Annex/CatFile.hs
+++ b/Annex/CatFile.hs
@@ -27,6 +27,7 @@ import qualified Annex
 import Git.Types
 import Git.FilePath
 import Git.FileMode
+import qualified Git.Ref
 
 catFile :: Git.Branch -> FilePath -> Annex L.ByteString
 catFile branch file = do
@@ -108,9 +109,6 @@ catKeyChecked needhead ref@(Ref r) =
 		 map snd . filter (\p -> fst p == file)
 
 {- From a file in the repository back to the key.
- -
- - Prefixing the file with ./ makes this work even if in a subdirectory
- - of a repo.
  -
  - Ideally, this should reflect the key that's staged in the index,
  - not the key that's committed to HEAD. Unfortunately, git cat-file
@@ -134,8 +132,8 @@ catKeyChecked needhead ref@(Ref r) =
 catKeyFile :: FilePath -> Annex (Maybe Key)
 catKeyFile f = ifM (Annex.getState Annex.daemon)
 	( catKeyFileHEAD f
-	, catKeyChecked True (Ref $ ":./" ++ f)
+	, catKeyChecked True $ Git.Ref.fileRef f
 	)
 
 catKeyFileHEAD :: FilePath -> Annex (Maybe Key)
-catKeyFileHEAD f = catKeyChecked False (Ref $ "HEAD:./" ++ f)
+catKeyFileHEAD f = catKeyChecked False $ Git.Ref.fileFromRef Git.Ref.headRef f
diff --git a/Command/Status.hs b/Command/Status.hs
new file mode 100644
index 0000000000..fa478f928b
--- /dev/null
+++ b/Command/Status.hs
@@ -0,0 +1,89 @@
+{- git-annex command
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Status where
+
+import Common.Annex
+import Command
+import Annex.CatFile
+import Annex.Content.Direct
+import Config
+import qualified Git.LsFiles as LsFiles
+import qualified Git.Ref
+import qualified Git
+
+def :: [Command]
+def = [noCommit $ noMessages $
+	command "status" paramPaths seek SectionCommon
+		"show the working tree status"]
+
+seek :: [CommandSeek]
+seek = 
+	[ withWords start
+	]
+
+start :: [FilePath] -> CommandStart
+start [] = do
+	-- Like git status, when run without a directory, behave as if
+	-- given the path to the top of the repository.
+	cwd <- liftIO getCurrentDirectory
+	top <- fromRepo Git.repoPath
+	next $ perform [relPathDirToFile cwd top]
+start locs = next $ perform locs
+	
+perform :: [FilePath] -> CommandPerform
+perform locs = do
+	(l, cleanup) <- inRepo $ LsFiles.modifiedOthers locs
+	getstatus <- ifM isDirect
+		( return statusDirect
+		, return $ Just <$$> statusIndirect
+		)
+	forM_ l $ \f -> maybe noop (showFileStatus f) =<< getstatus f
+	void $ liftIO cleanup
+	next $ return True
+
+data Status 
+	= NewFile
+	| DeletedFile
+	| ModifiedFile
+
+showStatus :: Status -> String
+showStatus NewFile = "?"
+showStatus DeletedFile = "D"
+showStatus ModifiedFile = "M"
+
+showFileStatus :: FilePath -> Status -> Annex ()
+showFileStatus f s  = liftIO $ putStrLn $ showStatus s ++ " " ++ f
+
+statusDirect :: FilePath -> Annex (Maybe Status)
+statusDirect f = checkstatus =<< liftIO (catchMaybeIO $ getFileStatus f)
+  where
+	checkstatus Nothing = return $ Just DeletedFile
+	checkstatus (Just s)
+		-- Git thinks that present direct mode files modifed,
+		-- so have to check.
+		| not (isSymbolicLink s) = checkkey s =<< catKeyFile f
+		| otherwise = Just <$> checkNew f
+	
+	checkkey s (Just k) = ifM (sameFileStatus k s)
+		( return Nothing
+		, return $ Just ModifiedFile
+		)
+	checkkey _ Nothing = Just <$> checkNew f
+
+statusIndirect :: FilePath -> Annex Status
+statusIndirect f = ifM (liftIO $ isJust <$> catchMaybeIO (getFileStatus f))
+	( checkNew f
+	, return DeletedFile
+	)
+  where
+
+checkNew :: FilePath -> Annex Status
+checkNew f = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f))
+	( return ModifiedFile
+	, return NewFile
+	)
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs
index 98cbac58e8..8aaa09067f 100644
--- a/Git/LsFiles.hs
+++ b/Git/LsFiles.hs
@@ -11,6 +11,7 @@ module Git.LsFiles (
 	allFiles,
 	deleted,
 	modified,
+	modifiedOthers,
 	staged,
 	stagedNotDeleted,
 	stagedOthersDetails,
@@ -65,6 +66,12 @@ modified l repo = pipeNullSplit params repo
   where
 	params = [Params "ls-files --modified -z --"] ++ map File l
 
+{- Files that have been modified or are not checked into git. -}
+modifiedOthers :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+modifiedOthers l repo = pipeNullSplit params repo
+  where
+	params = [Params "ls-files --modified --others -z --"] ++ map File l
+
 {- Returns a list of all files that are staged for commit. -}
 staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 staged = staged' []
diff --git a/Git/Ref.hs b/Git/Ref.hs
index 5057180d13..6ce1b87845 100644
--- a/Git/Ref.hs
+++ b/Git/Ref.hs
@@ -41,6 +41,20 @@ under dir r = Ref $ dir ++ "/" ++
 underBase :: String -> Ref -> Ref
 underBase dir r = Ref $ dir ++ "/" ++ show (base r)
 
+{- A Ref that can be used to refer to a file in the repository, as staged
+ - in the index.
+ -
+ - Prefixing the file with ./ makes this work even if in a subdirectory
+ - of a repo.
+ -}
+fileRef :: FilePath -> Ref
+fileRef f = Ref $ ":./" ++ f
+
+{- A Ref that can be used to refer to a file in the repository as it
+ - appears in a given Ref. -}
+fileFromRef :: Ref -> FilePath -> Ref
+fileFromRef (Ref r) f = let (Ref fr) = fileRef f in Ref (r ++ fr)
+
 {- Checks if a ref exists. -}
 exists :: Ref -> Repo -> IO Bool
 exists ref = runBool
diff --git a/GitAnnex.hs b/GitAnnex.hs
index 0bd48e0df5..9580c240e0 100644
--- a/GitAnnex.hs
+++ b/GitAnnex.hs
@@ -47,6 +47,7 @@ import qualified Command.List
 import qualified Command.Log
 import qualified Command.Merge
 import qualified Command.Info
+import qualified Command.Status
 import qualified Command.Migrate
 import qualified Command.Uninit
 import qualified Command.Trust
@@ -141,6 +142,7 @@ cmds = concat
 	, Command.Log.def
 	, Command.Merge.def
 	, Command.Info.def
+	, Command.Status.def
 	, Command.Migrate.def
 	, Command.Map.def
 	, Command.Direct.def
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 4aeeb8ad5a..25b69930ee 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -103,6 +103,13 @@ subdirectories).
 
   To avoid contacting the remote to check if it has every file, specify `--fast`
 
+* `status` [path ...]`
+
+  Similar to `git status --short`, displays the status of the files in the
+  working tree. Shows files that are not checked into git, files that
+  have been deleted, and files that have been modified. 
+  Particulary useful in direct mode.
+
 * `unlock [path ...]`
 
   Normally, the content of annexed files is protected from being changed.
@@ -563,10 +570,6 @@ subdirectories).
 
 # QUERY COMMANDS
 
-* `version`
-
-  Shows the version of git-annex, as well as repository version information.
-
 * `find [path ...]`
 
   Outputs a list of annexed files in the specified path. With no path,
@@ -624,6 +627,9 @@ subdirectories).
   Then run:
 
         	git annex info --fast . --not --in here
+* `version`
+
+  Shows the version of git-annex, as well as repository version information.
 
 * `map`