b223988e22
--backend is no longer a global option, and is only accepted by commands that actually need it. Three commands that used to support backend but don't any longer are watch, webapp, and assistant. It would be possible to make them support it, but I doubt anyone used the option with these. And in the case of webapp and assistant, the option was handled inconsistently, only taking affect when the command is run with an existing git-annex repo, not when it creates a new one. Also, renamed GlobalOption etc to AnnexOption. Because there are many options of this type that are not actually global (any more) and get added to commands that need them. Sponsored-by: Kevin Mueller on Patreon
66 lines
1.8 KiB
Haskell
66 lines
1.8 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2013-2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Status where
|
|
|
|
import Command
|
|
import Git.Status
|
|
import Git.FilePath
|
|
|
|
cmd :: Command
|
|
cmd = notBareRepo $ noCommit $ noMessages $
|
|
withAnnexOptions [jsonOptions] $
|
|
command "status" SectionCommon
|
|
"show the working tree status"
|
|
paramPaths (seek <$$> optParser)
|
|
|
|
data StatusOptions = StatusOptions
|
|
{ statusFiles :: CmdParams
|
|
, ignoreSubmodules :: Maybe String
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser StatusOptions
|
|
optParser desc = StatusOptions
|
|
<$> cmdParams desc
|
|
<*> optional (strOption
|
|
( long "ignore-submodules"
|
|
<> help "passed on to git status"
|
|
<> metavar "WHEN"
|
|
))
|
|
|
|
seek :: StatusOptions -> CommandSeek
|
|
seek o = withWords (commandAction . start o) (statusFiles o)
|
|
|
|
start :: StatusOptions -> [FilePath] -> CommandStart
|
|
start o locs = do
|
|
(l, cleanup) <- inRepo $ getStatus ps locs
|
|
let getstatus = pure . simplifiedStatus
|
|
forM_ l $ \s -> maybe noop displayStatus =<< getstatus s
|
|
ifM (liftIO cleanup)
|
|
( stop
|
|
, giveup "git status failed"
|
|
)
|
|
where
|
|
ps = case ignoreSubmodules o of
|
|
Nothing -> []
|
|
Just s -> [Param $ "--ignore-submodules="++s]
|
|
|
|
-- Prefer to show unstaged status in this simplified status.
|
|
simplifiedStatus :: StagedUnstaged Status -> Maybe Status
|
|
simplifiedStatus (StagedUnstaged { unstaged = Just s }) = Just s
|
|
simplifiedStatus (StagedUnstaged { staged = Just s }) = Just s
|
|
simplifiedStatus _ = Nothing
|
|
|
|
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 $ fromRawFilePath <$> relPathCwdToFile absf
|
|
unlessM (showFullJSON $ JSONChunk [("status", [c]), ("file", f)]) $
|
|
liftIO $ putStrLn $ [c] ++ " " ++ f
|