diff options
| -rw-r--r-- | Annex/CatFile.hs | 8 | ||||
| -rw-r--r-- | Command/Status.hs | 89 | ||||
| -rw-r--r-- | Git/LsFiles.hs | 7 | ||||
| -rw-r--r-- | Git/Ref.hs | 14 | ||||
| -rw-r--r-- | GitAnnex.hs | 2 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 14 |
6 files changed, 125 insertions, 9 deletions
diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs index 407b4ddae..812d032c6 100644 --- a/Annex/CatFile.hs +++ b/Annex/CatFile.hs @@ -27,6 +27,7 @@ import qualified Annex import Git.Types import Git.FilePath import Git.FileMode +import qualified Git.Ref catFile :: Git.Branch -> FilePath -> Annex L.ByteString catFile branch file = do @@ -109,9 +110,6 @@ catKeyChecked needhead ref@(Ref r) = {- From a file in the repository back to the key. - - - Prefixing the file with ./ makes this work even if in a subdirectory - - of a repo. - - - Ideally, this should reflect the key that's staged in the index, - not the key that's committed to HEAD. Unfortunately, git cat-file - does not refresh the index file after it's started up, so things @@ -134,8 +132,8 @@ catKeyChecked needhead ref@(Ref r) = catKeyFile :: FilePath -> Annex (Maybe Key) catKeyFile f = ifM (Annex.getState Annex.daemon) ( catKeyFileHEAD f - , catKeyChecked True (Ref $ ":./" ++ f) + , catKeyChecked True $ Git.Ref.fileRef f ) catKeyFileHEAD :: FilePath -> Annex (Maybe Key) -catKeyFileHEAD f = catKeyChecked False (Ref $ "HEAD:./" ++ f) +catKeyFileHEAD f = catKeyChecked False $ Git.Ref.fileFromRef Git.Ref.headRef f 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 + ) diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 98cbac58e..8aaa09067 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -11,6 +11,7 @@ module Git.LsFiles ( allFiles, deleted, modified, + modifiedOthers, staged, stagedNotDeleted, stagedOthersDetails, @@ -65,6 +66,12 @@ modified l repo = pipeNullSplit params repo where params = [Params "ls-files --modified -z --"] ++ map File l +{- Files that have been modified or are not checked into git. -} +modifiedOthers :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) +modifiedOthers l repo = pipeNullSplit params repo + where + params = [Params "ls-files --modified --others -z --"] ++ map File l + {- Returns a list of all files that are staged for commit. -} staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) staged = staged' [] diff --git a/Git/Ref.hs b/Git/Ref.hs index 5057180d1..6ce1b8784 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -41,6 +41,20 @@ under dir r = Ref $ dir ++ "/" ++ underBase :: String -> Ref -> Ref underBase dir r = Ref $ dir ++ "/" ++ show (base r) +{- A Ref that can be used to refer to a file in the repository, as staged + - in the index. + - + - Prefixing the file with ./ makes this work even if in a subdirectory + - of a repo. + -} +fileRef :: FilePath -> Ref +fileRef f = Ref $ ":./" ++ f + +{- A Ref that can be used to refer to a file in the repository as it + - appears in a given Ref. -} +fileFromRef :: Ref -> FilePath -> Ref +fileFromRef (Ref r) f = let (Ref fr) = fileRef f in Ref (r ++ fr) + {- Checks if a ref exists. -} exists :: Ref -> Repo -> IO Bool exists ref = runBool diff --git a/GitAnnex.hs b/GitAnnex.hs index 0bd48e0df..9580c240e 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -47,6 +47,7 @@ import qualified Command.List import qualified Command.Log import qualified Command.Merge import qualified Command.Info +import qualified Command.Status import qualified Command.Migrate import qualified Command.Uninit import qualified Command.Trust @@ -141,6 +142,7 @@ cmds = concat , Command.Log.def , Command.Merge.def , Command.Info.def + , Command.Status.def , Command.Migrate.def , Command.Map.def , Command.Direct.def diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 4aeeb8ad5..25b69930e 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -103,6 +103,13 @@ subdirectories). To avoid contacting the remote to check if it has every file, specify `--fast` +* `status` [path ...]` + + Similar to `git status --short`, displays the status of the files in the + working tree. Shows files that are not checked into git, files that + have been deleted, and files that have been modified. + Particulary useful in direct mode. + * `unlock [path ...]` Normally, the content of annexed files is protected from being changed. @@ -563,10 +570,6 @@ subdirectories). # QUERY COMMANDS -* `version` - - Shows the version of git-annex, as well as repository version information. - * `find [path ...]` Outputs a list of annexed files in the specified path. With no path, @@ -624,6 +627,9 @@ subdirectories). Then run: git annex info --fast . --not --in here +* `version` + + Shows the version of git-annex, as well as repository version information. * `map` |