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.

1 files changed, 38 insertions, 54 deletions

diff --git a/Command/Status.hs b/Command/Status.hs
index 5cb971b84..35195fec6 100644
--- a/Command/Status.hs
+++ b/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' locs = do
-	(l, cleanup) <- inRepo $ LsFiles.modifiedOthers locs
+start :: [FilePath] -> CommandStart
+start locs = do
+	(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 
-	= NewFile
-	| DeletedFile
-	| ModifiedFile
+displayStatus :: Status -> Annex ()
+-- renames not shown in this simplified status
+displayStatus (Renamed _ _) = noop
+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
-showStatus NewFile = "?"
-showStatus DeletedFile = "D"
-showStatus ModifiedFile = "M"
-
-showFileStatus :: FilePath -> Status -> Annex ()
-showFileStatus f s  = unlessM (showFullJSON [("status", ss), ("file", f)]) $
-	liftIO $ putStrLn $ ss ++ " " ++ f
+-- Git thinks that present direct mode files are typechanged;
+-- check their content to see if they are modified or not.
+statusDirect :: Status -> Annex (Maybe Status)
+statusDirect (TypeChanged t) = do
+	absf <- fromRepo $ fromTopFilePath t
+	f <- liftIO $ relPathCwdToFile absf
+	v <- liftIO (catchMaybeIO $ getFileStatus 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
-
-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)
+	checkkey f s (Just k) = ifM (sameFileStatus k f s)
 		( return Nothing
-		, return $ Just ModifiedFile
+		, return $ Just $ Modified t
 		)
-	checkkey _ Nothing = Just <$> checkNew f
-
-statusIndirect :: FilePath -> Annex Status
-statusIndirect f = ifM (liftIO $ isJust <$> catchMaybeIO (getFileStatus f))
-	( checkNew f
-	, return DeletedFile
-	)
+	checkkey f _ Nothing = Just <$> checkNew f t
+statusDirect s = pure (Just s)
 
-checkNew :: FilePath -> Annex Status
-checkNew f = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f))
-	( return ModifiedFile
-	, return NewFile
+checkNew :: FilePath -> TopFilePath -> Annex Status
+checkNew f t = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f))
+	( return (Modified t)
+	, return (Untracked t)
 	)