diff options
| -rw-r--r-- | Command/Status.hs | 92 | ||||
| -rw-r--r-- | Git/Status.hs | 76 | ||||
| -rw-r--r-- | debian/changelog | 1 | ||||
| -rw-r--r-- | doc/git-annex-status.mdwn | 6 | ||||
| -rw-r--r-- | doc/todo/make_status_show_staged_files.mdwn | 2 |
5 files changed, 121 insertions, 56 deletions
diff --git a/Command/Status.hs b/Command/Status.hs index 5cb971b84..35195fec6 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess <id@joeyh.name> + - Copyright 2013-2015 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -12,9 +12,9 @@ import Command import Annex.CatFile import Annex.Content.Direct import Config -import qualified Git.LsFiles as LsFiles +import Git.Status import qualified Git.Ref -import qualified Git +import Git.FilePath cmd :: Command cmd = notBareRepo $ noCommit $ noMessages $ withGlobalOptions [jsonOption] $ @@ -24,67 +24,51 @@ cmd = notBareRepo $ noCommit $ noMessages $ withGlobalOptions [jsonOption] $ seek :: CmdParams -> 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 +start :: [FilePath] -> CommandStart +start locs = do + (l, cleanup) <- inRepo $ getStatus locs getstatus <- ifM isDirect ( return statusDirect - , return $ Just <$$> statusIndirect + , return $ \s -> pure (Just s) ) - forM_ l $ \f -> maybe noop (showFileStatus f) =<< getstatus f + forM_ l $ \s -> maybe noop displayStatus =<< getstatus s void $ liftIO cleanup stop -data Status - = NewFile - | DeletedFile - | ModifiedFile +displayStatus :: Status -> Annex () +-- renames not shown in this simplified status +displayStatus (Renamed _ _) = noop +displayStatus s = do + let c = statusChar s + absf <- fromRepo $ fromTopFilePath (statusFile s) + f <- liftIO $ relPathCwdToFile absf + unlessM (showFullJSON [("status", [c]), ("file", f)]) $ + liftIO $ putStrLn $ [c] ++ " " ++ f -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 +-- Git thinks that present direct mode files are typechanged; +-- check their content to see if they are modified or not. +statusDirect :: Status -> Annex (Maybe Status) +statusDirect (TypeChanged t) = do + absf <- fromRepo $ fromTopFilePath t + f <- liftIO $ relPathCwdToFile absf + v <- liftIO (catchMaybeIO $ getFileStatus f) + case v of + Nothing -> return $ Just $ Deleted t + Just s + | not (isSymbolicLink s) -> + checkkey f s =<< catKeyFile f + | otherwise -> Just <$> checkNew f t 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) + checkkey f s (Just k) = ifM (sameFileStatus k f s) ( return Nothing - , return $ Just ModifiedFile + , return $ Just $ Modified t ) - checkkey _ Nothing = Just <$> checkNew f - -statusIndirect :: FilePath -> Annex Status -statusIndirect f = ifM (liftIO $ isJust <$> catchMaybeIO (getFileStatus f)) - ( checkNew f - , return DeletedFile - ) + checkkey f _ Nothing = Just <$> checkNew f t +statusDirect s = pure (Just s) -checkNew :: FilePath -> Annex Status -checkNew f = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f)) - ( return ModifiedFile - , return NewFile +checkNew :: FilePath -> TopFilePath -> Annex Status +checkNew f t = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f)) + ( return (Modified t) + , return (Untracked t) ) diff --git a/Git/Status.hs b/Git/Status.hs new file mode 100644 index 000000000..4f9ad0265 --- /dev/null +++ b/Git/Status.hs @@ -0,0 +1,76 @@ +{- git status interface + - + - Copyright 2015 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Git.Status where + +import Common +import Git +import Git.Command +import Git.FilePath + +data Status + = Modified TopFilePath + | Deleted TopFilePath + | Added TopFilePath + | Renamed TopFilePath TopFilePath + | TypeChanged TopFilePath + | Untracked TopFilePath + +statusChar :: Status -> Char +statusChar (Modified _) = 'M' +statusChar (Deleted _) = 'D' +statusChar (Added _) = 'A' +statusChar (Renamed _ _) = 'R' +statusChar (TypeChanged _) = 'T' +statusChar (Untracked _) = '?' + +statusFile :: Status -> TopFilePath +statusFile (Modified f) = f +statusFile (Deleted f) = f +statusFile (Added f) = f +statusFile (Renamed _oldf newf) = newf +statusFile (TypeChanged f) = f +statusFile (Untracked f) = f + +parseStatusZ :: [String] -> [Status] +parseStatusZ = go [] + where + go c [] = reverse c + go c (x:xs) = case x of + (sindex:sworktree:' ':f) -> + -- Look at both the index and worktree status, + -- preferring worktree. + case cparse sworktree <|> cparse sindex of + Just mks -> go (mks (asTopFilePath f) : c) xs + Nothing -> if sindex == 'R' + -- In -z mode, the name the + -- file was renamed to comes + -- first, and the next component + -- is the old filename. + then case xs of + (oldf:xs') -> go (Renamed (asTopFilePath oldf) (asTopFilePath f) : c) xs' + _ -> go c [] + else go c xs + _ -> go c xs + + cparse 'M' = Just Modified + cparse 'A' = Just Added + cparse 'D' = Just Deleted + cparse 'T' = Just TypeChanged + cparse '?' = Just Untracked + cparse _ = Nothing + +getStatus :: [FilePath] -> Repo -> IO ([Status], IO Bool) +getStatus l r = do + (ls, cleanup) <- pipeNullSplit params r + return (parseStatusZ ls, cleanup) + where + params = + [ Param "status" + , Param "-uall" + , Param "-z" + ] ++ map File l diff --git a/debian/changelog b/debian/changelog index 5ebbfcd18..aa3675cdc 100644 --- a/debian/changelog +++ b/debian/changelog @@ -13,6 +13,7 @@ git-annex (5.20150917) UNRELEASED; urgency=medium * Fix a crash at direct mode merge time when .git/index doesn't exist yet. Triggered by eg, git-annex sync --no-commit in a fresh clone of a repository. + * status: Show added but not yet committed files. -- Joey Hess <id@joeyh.name> Wed, 16 Sep 2015 12:23:33 -0400 diff --git a/doc/git-annex-status.mdwn b/doc/git-annex-status.mdwn index 7ad967bde..19bd6fab5 100644 --- a/doc/git-annex-status.mdwn +++ b/doc/git-annex-status.mdwn @@ -9,8 +9,10 @@ git annex status `[path ...]` # DESCRIPTION Similar to `git status --short`, this command 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. +in the working tree. + +Show files that are not checked into git (?), deleted (D), +modified (M), added but not committed (A), and type changed/unlocked (T). Particularly useful in direct mode. diff --git a/doc/todo/make_status_show_staged_files.mdwn b/doc/todo/make_status_show_staged_files.mdwn index cd2de5bce..4d418bc11 100644 --- a/doc/todo/make_status_show_staged_files.mdwn +++ b/doc/todo/make_status_show_staged_files.mdwn @@ -21,3 +21,5 @@ Using the `git status` command directly will show the added files ### What version of git-annex are you using? On what operating system? git-annex version: 5.20141024-g613f396 + +> [[done]] --[[Joey]] |