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.
This commit is contained in:
Joey Hess 2015-09-22 17:32:28 -04:00
parent 178826c4cb
commit f2b6ebd502
5 changed files with 121 additions and 56 deletions

View file

@ -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
checkkey f _ Nothing = Just <$> checkNew f t
statusDirect s = pure (Just s)
statusIndirect :: FilePath -> Annex Status
statusIndirect f = ifM (liftIO $ isJust <$> catchMaybeIO (getFileStatus f))
( checkNew f
, return DeletedFile
)
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)
)