git-annex/Command/Status.hs
Joey Hess 068aaf943b on second thought, InodeCache should use getFileSize
This is necessary for interop between inode caches created on unix and
windows. Which is more important than supporting inodecaches for large keys
with the wrong size, which are broken anyway.

There should be no slowdown from this change, except on Windows.
2015-01-20 19:35:50 -04:00

90 lines
2.3 KiB
Haskell

{- git-annex command
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- 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 qualified Git.LsFiles as LsFiles
import qualified Git.Ref
import qualified Git
cmd :: [Command]
cmd = [notBareRepo $ noCommit $ noMessages $ withOptions [jsonOption] $
command "status" paramPaths seek SectionCommon
"show the working tree status"]
seek :: 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
getstatus <- ifM isDirect
( return statusDirect
, return $ Just <$$> statusIndirect
)
forM_ l $ \f -> maybe noop (showFileStatus f) =<< getstatus f
void $ liftIO cleanup
stop
data Status
= NewFile
| DeletedFile
| ModifiedFile
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
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)
( return Nothing
, return $ Just ModifiedFile
)
checkkey _ Nothing = Just <$> checkNew f
statusIndirect :: FilePath -> Annex Status
statusIndirect f = ifM (liftIO $ isJust <$> catchMaybeIO (getFileStatus f))
( checkNew f
, return DeletedFile
)
where
checkNew :: FilePath -> Annex Status
checkNew f = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f))
( return ModifiedFile
, return NewFile
)