diff options
author | 2016-01-20 14:07:13 -0400 | |
---|---|---|
committer | 2016-01-20 14:10:13 -0400 | |
commit | 0c4e0046e72aab8216e3fe7d3f4252b1a66e1211 (patch) | |
tree | b977261e78042cc6b11d530578a47a0d25d21359 | |
parent | b51672003cf035ba4595f45746cac343d154266f (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.hs | 4 | ||||
-rw-r--r-- | CmdLine/Action.hs | 6 | ||||
-rw-r--r-- | Command.hs | 7 | ||||
-rw-r--r-- | Command/Status.hs | 9 | ||||
-rw-r--r-- | Messages.hs | 7 | ||||
-rw-r--r-- | Types/Command.hs | 2 | ||||
-rw-r--r-- | Types/Messages.hs | 2 |
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 |