summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-01-20 14:07:13 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-01-20 14:10:13 -0400
commit0c4e0046e72aab8216e3fe7d3f4252b1a66e1211 (patch)
treeb977261e78042cc6b11d530578a47a0d25d21359
parentb51672003cf035ba4595f45746cac343d154266f (diff)
make noMessages disable closing of json object in --json mode
This allows things like Command.Find to use noMessages and generate their own complete json objects. Previouly, Command.Find managed that only via a hack, which wasn't compatable with batch mode. Only Command.Find, Command.Smudge, and Commange.Status use noMessages currently, and none except for Command.Find are impacted by this change. Fixes find --json --batch output
-rw-r--r--CmdLine.hs4
-rw-r--r--CmdLine/Action.hs6
-rw-r--r--Command.hs7
-rw-r--r--Command/Status.hs9
-rw-r--r--Messages.hs7
-rw-r--r--Types/Command.hs2
-rw-r--r--Types/Messages.hs2
7 files changed, 26 insertions, 11 deletions
diff --git a/CmdLine.hs b/CmdLine.hs
index e6ee0c2e6..bc0f86524 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -39,8 +39,10 @@ dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progde
(cmd, seek, globalconfig) <- parsewith False cmdparser
(\a -> inRepo $ a . Just)
(liftIO . O.handleParseResult)
- when (cmdnomessages cmd) $
+ when (cmdnomessages cmd) $ do
Annex.setOutput QuietOutput
+ Annex.changeState $ \s -> s
+ { Annex.output = (Annex.output s) { implicitMessages = False } }
getParsed globalconfig
whenM (annexDebug <$> Annex.getGitConfig) $
liftIO enableDebugOutput
diff --git a/CmdLine/Action.hs b/CmdLine/Action.hs
index 693a6814f..b9fbf166e 100644
--- a/CmdLine/Action.hs
+++ b/CmdLine/Action.hs
@@ -124,7 +124,7 @@ includeCommandAction a = account =<< tryIO (callCommandAction a)
account (Right False) = incerr
account (Left err) = do
toplevelWarning True (show err)
- showEndFail
+ implicitMessage showEndFail
incerr
incerr = do
Annex.incError
@@ -146,8 +146,8 @@ callCommandAction' = start
cleanup = stage $ status
stage = (=<<)
skip = return Nothing
- failure = showEndFail >> return (Just False)
- status r = showEndResult r >> return (Just r)
+ failure = implicitMessage showEndFail >> return (Just False)
+ status r = implicitMessage (showEndResult r) >> return (Just r)
{- Do concurrent output when that has been requested. -}
allowConcurrentOutput :: Annex a -> Annex a
diff --git a/Command.hs b/Command.hs
index 387f7b8b5..e8c434b9b 100644
--- a/Command.hs
+++ b/Command.hs
@@ -66,8 +66,11 @@ withParams mkseek paramdesc = mkseek <$> cmdParams paramdesc
noCommit :: Command -> Command
noCommit c = c { cmdnocommit = True }
-{- Indicates that a command should not output anything other than what
- - it directly sends to stdout. (--json can override this). -}
+{- Indicates that a command should not output the usual messages when
+ - starting or stopping processing a file or other item. Unless --json mode
+ - is enabled, this also enables quiet output mode, so only things
+ - explicitly output by the command are shown and not progress messages
+ - etc. -}
noMessages :: Command -> Command
noMessages c = c { cmdnomessages = True }
diff --git a/Command/Status.hs b/Command/Status.hs
index 3feea7cb4..af0a1282f 100644
--- a/Command/Status.hs
+++ b/Command/Status.hs
@@ -17,10 +17,11 @@ import qualified Git.Ref
import Git.FilePath
cmd :: Command
-cmd = notBareRepo $ noCommit $ noMessages $ withGlobalOptions [jsonOption] $
- command "status" SectionCommon
- "show the working tree status"
- paramPaths (withParams seek)
+cmd = notBareRepo $ noCommit $ noMessages $
+ withGlobalOptions [jsonOption] $
+ command "status" SectionCommon
+ "show the working tree status"
+ paramPaths (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords start
diff --git a/Messages.hs b/Messages.hs
index 7b4cff102..cec0cb8a3 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -36,6 +36,7 @@ module Messages (
debugEnabled,
commandProgressDisabled,
outputMessage,
+ implicitMessage,
) where
import Text.JSON
@@ -212,3 +213,9 @@ commandProgressDisabled = withOutputType $ \t -> return $ case t of
JSONOutput -> True
NormalOutput -> False
ConcurrentOutput _ -> True
+
+{- Use to show a message that is displayed implicitly, and so might be
+ - disabled when running a certian command that needs more control over its
+ - output. -}
+implicitMessage :: Annex () -> Annex ()
+implicitMessage = whenM (implicitMessages <$> Annex.getState Annex.output)
diff --git a/Types/Command.hs b/Types/Command.hs
index e12873850..aa22143dd 100644
--- a/Types/Command.hs
+++ b/Types/Command.hs
@@ -40,7 +40,7 @@ type CommandCleanup = Annex Bool
data Command = Command
{ cmdcheck :: [CommandCheck] -- check stage
, cmdnocommit :: Bool -- don't commit journalled state changes
- , cmdnomessages :: Bool -- don't output normal messages
+ , cmdnomessages :: Bool -- don't output normal messages
, cmdname :: String
, cmdparamdesc :: CmdParamsDesc -- description of params for usage
, cmdsection :: CommandSection
diff --git a/Types/Messages.hs b/Types/Messages.hs
index e8dbb8e89..f9e09ecd7 100644
--- a/Types/Messages.hs
+++ b/Types/Messages.hs
@@ -24,6 +24,7 @@ data SideActionBlock = NoBlock | StartBlock | InBlock
data MessageState = MessageState
{ outputType :: OutputType
, sideActionBlock :: SideActionBlock
+ , implicitMessages :: Bool
#ifdef WITH_CONCURRENTOUTPUT
, consoleRegion :: Maybe ConsoleRegion
, consoleRegionErrFlag :: Bool
@@ -35,6 +36,7 @@ instance Default MessageState
def = MessageState
{ outputType = NormalOutput
, sideActionBlock = NoBlock
+ , implicitMessages = True
#ifdef WITH_CONCURRENTOUTPUT
, consoleRegion = Nothing
, consoleRegionErrFlag = False