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

@@ -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

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
+	)

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' []

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

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

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`