summaryrefslogtreecommitdiff
path: root/Command/Status.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-11-07 13:55:36 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-11-07 14:07:25 -0400
commitff03a89236956904b617e02468102e5d390306bd (patch)
tree7095a8d9b4491c2c777cf0d39ad8d4f0da3c6c1e /Command/Status.hs
parent8aec790a7aefba4dc2e8e0d219d333c12ad585e3 (diff)
add new status command
This works for both direct and indirect mode. It may need some performance tuning. Note that unlike git status, it only shows the status of the work tree, not the status of the index. So only one status letter, not two .. and since files that have been added and not yet committed do not differ between the work tree and the index, they are not shown. Might want to add display of the index vs the last commit eventually. This commit was sponsored by an unknown bitcoin contributor, whose contribution as been going up lately! ;)
Diffstat (limited to 'Command/Status.hs')
-rw-r--r--Command/Status.hs89
1 files changed, 89 insertions, 0 deletions
diff --git a/Command/Status.hs b/Command/Status.hs
new file mode 100644
index 000000000..fa478f928
--- /dev/null
+++ b/Command/Status.hs
@@ -0,0 +1,89 @@
+{- 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 = [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
+ )