status: Show added but not yet committed files.

Seems easy, but git ls-files can't list the right subset of files.
So, I wrote a whole new parser for git status output, and converted the
status command to use that.

There are a few other small behavior changes. The order changed. Unlocked
files show as T. In indirect mode, deleted files were not shown before, and
that's fixed. Regular files checked directly into git and modified
were not shown before, and are now.

Command/Status.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2015 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -12,9 +12,9 @@ import Command
 import Annex.CatFile
 import Annex.Content.Direct
 import Config
-import qualified Git.LsFiles as LsFiles
+import Git.Status
 import qualified Git.Ref
-import qualified Git
+import Git.FilePath
 
 cmd :: Command
 cmd = notBareRepo $ noCommit $ noMessages $ withGlobalOptions [jsonOption] $
@@ -24,67 +24,51 @@ cmd = notBareRepo $ noCommit $ noMessages $ withGlobalOptions [jsonOption] $
 
 seek :: CmdParams -> 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.
-	top <- fromRepo Git.repoPath
-	d <- liftIO $ relPathCwdToFile top
-	start' [d]
-start locs = start' locs
 	
-start' :: [FilePath] -> CommandStart
+start :: [FilePath] -> CommandStart
-start' locs = do
+start locs = do
-	(l, cleanup) <- inRepo $ LsFiles.modifiedOthers locs
+	(l, cleanup) <- inRepo $ getStatus locs
 	getstatus <- ifM isDirect
 		( return statusDirect
-		, return $ Just <$$> statusIndirect
+		, return $ \s -> pure (Just s)
 		)
-	forM_ l $ \f -> maybe noop (showFileStatus f) =<< getstatus f
+	forM_ l $ \s -> maybe noop displayStatus =<< getstatus s
 	void $ liftIO cleanup
 	stop
 
-data Status 
+displayStatus :: Status -> Annex ()
-	= NewFile
+-- renames not shown in this simplified status
-	| DeletedFile
+displayStatus (Renamed _ _) = noop
-	| ModifiedFile
+displayStatus s  = do
+	let c = statusChar s
+	absf <- fromRepo $ fromTopFilePath (statusFile s)
+	f <- liftIO $ relPathCwdToFile absf
+	unlessM (showFullJSON [("status", [c]), ("file", f)]) $
+		liftIO $ putStrLn $ [c] ++ " " ++ f
 
-showStatus :: Status -> String
+-- Git thinks that present direct mode files are typechanged;
-showStatus NewFile = "?"
+-- check their content to see if they are modified or not.
-showStatus DeletedFile = "D"
+statusDirect :: Status -> Annex (Maybe Status)
-showStatus ModifiedFile = "M"
+statusDirect (TypeChanged t) = do
-
+	absf <- fromRepo $ fromTopFilePath t
-showFileStatus :: FilePath -> Status -> Annex ()
+	f <- liftIO $ relPathCwdToFile absf
-showFileStatus f s  = unlessM (showFullJSON [("status", ss), ("file", f)]) $
+	v <- liftIO (catchMaybeIO $ getFileStatus f)
-	liftIO $ putStrLn $ ss ++ " " ++ f
+	case v  of
+		Nothing -> return $ Just $ Deleted t
+		Just s
+			| not (isSymbolicLink s) ->
+				checkkey f s =<< catKeyFile f
+			| otherwise -> Just <$> checkNew f t
   where
-	ss = showStatus s
+	checkkey f s (Just k) = ifM (sameFileStatus k f s)
-
-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 are modifed,
-		-- so have to check.
-		| not (isSymbolicLink s) = checkkey s =<< catKeyFile f
-		| otherwise = Just <$> checkNew f
-	
-	checkkey s (Just k) = ifM (sameFileStatus k f s)
 		( return Nothing
-		, return $ Just ModifiedFile
+		, return $ Just $ Modified t
 		)
-	checkkey _ Nothing = Just <$> checkNew f
+	checkkey f _ Nothing = Just <$> checkNew f t
+statusDirect s = pure (Just s)
 
-statusIndirect :: FilePath -> Annex Status
+checkNew :: FilePath -> TopFilePath -> Annex Status
-statusIndirect f = ifM (liftIO $ isJust <$> catchMaybeIO (getFileStatus f))
+checkNew f t = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f))
-	( checkNew f
+	( return (Modified t)
-	, return DeletedFile
+	, return (Untracked t)
-	)
-
-checkNew :: FilePath -> Annex Status
-checkNew f = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f))
-	( return ModifiedFile
-	, return NewFile
 	)

Git/Status.hs

@@ -0,0 +1,76 @@
+{- git status interface
+ -
+ - Copyright 2015 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Status where
+
+import Common
+import Git
+import Git.Command
+import Git.FilePath
+
+data Status
+	= Modified TopFilePath
+	| Deleted TopFilePath
+	| Added TopFilePath
+	| Renamed TopFilePath TopFilePath
+	| TypeChanged TopFilePath
+	| Untracked TopFilePath
+
+statusChar :: Status -> Char
+statusChar (Modified _) = 'M'
+statusChar (Deleted _) = 'D'
+statusChar (Added _) = 'A'
+statusChar (Renamed _ _) = 'R'
+statusChar (TypeChanged _) = 'T'
+statusChar (Untracked _) = '?'
+
+statusFile :: Status -> TopFilePath
+statusFile (Modified f) = f
+statusFile (Deleted f) = f
+statusFile (Added f) = f
+statusFile (Renamed _oldf newf) = newf
+statusFile (TypeChanged f) = f
+statusFile (Untracked f) = f
+
+parseStatusZ :: [String] -> [Status]
+parseStatusZ = go []
+  where
+	go c [] = reverse c
+	go c (x:xs) = case x of
+		(sindex:sworktree:' ':f) -> 
+			-- Look at both the index and worktree status,
+			-- preferring worktree.
+			case cparse sworktree <|> cparse sindex of
+				Just mks -> go (mks (asTopFilePath f) : c) xs
+				Nothing -> if sindex == 'R'
+					-- In -z mode, the name the
+					-- file was renamed to comes
+					-- first, and the next component
+					-- is the old filename.
+					then case xs of
+						(oldf:xs') -> go (Renamed (asTopFilePath oldf) (asTopFilePath f) : c) xs'
+						_ -> go c []
+					else go c xs
+		_ -> go c xs
+
+	cparse 'M' = Just Modified
+	cparse 'A' = Just Added
+	cparse 'D' = Just Deleted
+	cparse 'T' = Just TypeChanged
+	cparse '?' = Just Untracked
+	cparse _ = Nothing
+
+getStatus :: [FilePath] -> Repo -> IO ([Status], IO Bool)
+getStatus l r = do
+	(ls, cleanup) <- pipeNullSplit params r
+	return (parseStatusZ ls, cleanup)
+  where
+	params =
+		[ Param "status"
+		, Param "-uall"
+		, Param "-z"
+		] ++ map File l

debian/changelog

@@ -13,6 +13,7 @@ git-annex (5.20150917) UNRELEASED; urgency=medium
   * Fix a crash at direct mode merge time when .git/index doesn't exist
     yet. Triggered by eg, git-annex sync --no-commit in a fresh clone of
     a repository.
+  * status: Show added but not yet committed files.
 
  -- Joey Hess <id@joeyh.name>  Wed, 16 Sep 2015 12:23:33 -0400
 

doc/git-annex-status.mdwn

@@ -9,8 +9,10 @@ git annex status `[path ...]`
 # DESCRIPTION
 
 Similar to `git status --short`, this command displays the status of the files
-in the working tree. Shows files that are not checked into git, files that have
+in the working tree. 
-been deleted, and files that have been modified.
+
+Show files that are not checked into git (?), deleted (D),
+modified (M), added but not committed (A), and type changed/unlocked (T).
 
 Particularly useful in direct mode.
 

doc/todo/make_status_show_staged_files.mdwn

@@ -21,3 +21,5 @@ Using the `git status` command directly will show the added files
 ### What version of git-annex are you using? On what operating system?
 
 git-annex version: 5.20141024-g613f396
+
+> [[done]] --[[Joey]]