f2b6ebd502
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.
74 lines
2 KiB
Haskell
74 lines
2 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2013-2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- 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 Git.Status
|
|
import qualified Git.Ref
|
|
import Git.FilePath
|
|
|
|
cmd :: Command
|
|
cmd = notBareRepo $ noCommit $ noMessages $ withGlobalOptions [jsonOption] $
|
|
command "status" SectionCommon
|
|
"show the working tree status"
|
|
paramPaths (withParams seek)
|
|
|
|
seek :: CmdParams -> CommandSeek
|
|
seek = withWords start
|
|
|
|
start :: [FilePath] -> CommandStart
|
|
start locs = do
|
|
(l, cleanup) <- inRepo $ getStatus locs
|
|
getstatus <- ifM isDirect
|
|
( return statusDirect
|
|
, return $ \s -> pure (Just s)
|
|
)
|
|
forM_ l $ \s -> maybe noop displayStatus =<< getstatus s
|
|
void $ liftIO cleanup
|
|
stop
|
|
|
|
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
|
|
|
|
-- 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
|
|
checkkey f s (Just k) = ifM (sameFileStatus k f s)
|
|
( return Nothing
|
|
, return $ Just $ Modified t
|
|
)
|
|
checkkey f _ Nothing = Just <$> checkNew f t
|
|
statusDirect s = pure (Just s)
|
|
|
|
checkNew :: FilePath -> TopFilePath -> Annex Status
|
|
checkNew f t = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f))
|
|
( return (Modified t)
|
|
, return (Untracked t)
|
|
)
|