068aaf943b
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.
90 lines
2.3 KiB
Haskell
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
|
|
)
|