git-annex/Command/Status.hs
Joey Hess 7189dfd77d git-annex (5.20131127) unstable; urgency=low
* webapp: Detect when upgrades are available, and upgrade if the user
    desires.
    (Only when git-annex is installed using the prebuilt binaries
    from git-annex upstream, not from eg Debian.)
  * assistant: Detect when the git-annex binary is modified or replaced,
    and either prompt the user to restart the program, or automatically
    restart it.
  * annex.autoupgrade configures both the above upgrade behaviors.
  * Added support for quvi 0.9. Slightly suboptimal due to limitations in its
    interface compared with the old version.
  * Bug fix: annex.version did not get set on automatic upgrade to v5 direct
    mode repo, so the upgrade was performed repeatedly, slowing commands down.
  * webapp: Fix bug that broke switching between local repositories
    that use the new guarded direct mode.
  * Android: Fix stripping of the git-annex binary.
  * Android: Make terminal app show git-annex version number.
  * Android: Re-enable XMPP support.
  * reinject: Allow to be used in direct mode.
  * Futher improvements to git repo repair. Has now been tested in tens
    of thousands of intentionally damaged repos, and successfully
    repaired them all.
  * Allow use of --unused in bare repository.

# imported from the archive
2013-11-27 18:41:44 -04:00

89 lines
2.2 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
def :: [Command]
def = [notBareRepo $ noCommit $ noMessages $
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.
cwd <- liftIO getCurrentDirectory
top <- fromRepo Git.repoPath
next $ perform [relPathDirToFile cwd top]
start locs = next $ perform locs
perform :: [FilePath] -> CommandPerform
perform 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
next $ return True
data Status
= NewFile
| DeletedFile
| ModifiedFile
showStatus :: Status -> String
showStatus NewFile = "?"
showStatus DeletedFile = "D"
showStatus ModifiedFile = "M"
showFileStatus :: FilePath -> Status -> Annex ()
showFileStatus f s = liftIO $ putStrLn $ showStatus s ++ " " ++ f
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 modifed,
-- so have to check.
| not (isSymbolicLink s) = checkkey s =<< catKeyFile f
| otherwise = Just <$> checkNew f
checkkey s (Just k) = ifM (sameFileStatus k 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
)