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:
parent
178826c4cb
commit
f2b6ebd502
5 changed files with 121 additions and 56 deletions
|
@ -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)
|
||||
)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue