get rid of implicitMessages state

Oh joyous day, this is probably git-annex's oldest implementation wart,
source of much unncessary bother.

Now that we have a StartMessage, showEndResult' can look at it to know
if it needs to display an end message or not.

This is also going to be faster, because it avoids an uncessary state
lookup for each file processed.

CmdLine.hs

@@ -122,10 +122,8 @@ findCmd fuzzyok argv cmds
 
 prepRunCommand :: Command -> GlobalSetter -> Annex ()
 prepRunCommand cmd globalconfig = do
-	when (cmdnomessages cmd) $ do
+	when (cmdnomessages cmd) $
 		Annex.setOutput QuietOutput
-		Annex.changeState $ \s -> s 
-			{ Annex.output = (Annex.output s) { implicitMessages = False } }
 	getParsed globalconfig
 	whenM (annexDebug <$> Annex.getGitConfig) $
 		liftIO enableDebugOutput

CmdLine/Action.hs

@@ -101,22 +101,21 @@ commandAction start = Annex.getState Annex.concurrency >>= \case
 	
 	mkjob workerst startmsg perform = 
 		inOwnConsoleRegion (Annex.output workerst) $
-			void $ accountCommandAction $
+			void $ accountCommandAction startmsg $
 				performconcurrent startmsg perform
 
-	-- Like callCommandAction, but the start stage has already run,
+	-- Like performCommandAction' but the worker thread's stage
-	-- and the worker thread's stage is changed before starting the
+	-- is changed before starting the cleanup action.
-	-- cleanup action.
 	performconcurrent startmsg perform = do
 		showStartMessage startmsg
 		perform >>= \case
 			Just cleanup -> do
 				changeStageTo CleanupStage
 				r <- cleanup
-				implicitMessage (showEndResult r)
+				showEndMessage startmsg r
 				return r
 			Nothing -> do
-				implicitMessage (showEndResult False)
+				showEndMessage startmsg False
 				return False
 
 -- | Wait until there's an idle worker in the pool, remove it from the
@@ -206,17 +205,23 @@ changeStageTo newstage = do
 
 {- Like commandAction, but without the concurrency. -}
 includeCommandAction :: CommandStart -> CommandCleanup
-includeCommandAction = accountCommandAction . callCommandAction
+includeCommandAction start =
+	start >>= \case
+		Nothing -> return True
+		Just (startmsg, perform) -> do
+			showStartMessage startmsg
+			accountCommandAction startmsg $
+				performCommandAction' startmsg perform
 
-accountCommandAction :: CommandCleanup -> CommandCleanup
+accountCommandAction :: StartMessage -> CommandCleanup -> CommandCleanup
-accountCommandAction a = tryNonAsync a >>= \case
+accountCommandAction startmsg cleanup = tryNonAsync cleanup >>= \case
 	Right True -> return True
 	Right False -> incerr
 	Left err -> case fromException err of
 		Just exitcode -> liftIO $ exitWith exitcode
 		Nothing -> do
 			toplevelWarning True (show err)
-			implicitMessage showEndFail
+			showEndMessage startmsg False
 			incerr
   where
 	incerr = do
@@ -232,19 +237,23 @@ callCommandAction = fromMaybe True <$$> callCommandAction'
 {- Like callCommandAction, but returns Nothing when the command did not
  - perform any action. -}
 callCommandAction' :: CommandStart -> Annex (Maybe Bool)
-callCommandAction' a = callCommandActionQuiet a >>= \case
+callCommandAction' start = 
-	Nothing -> return Nothing
-	Just r -> implicitMessage (showEndResult r) >> return (Just r)
-
-callCommandActionQuiet :: CommandStart -> Annex (Maybe Bool)
-callCommandActionQuiet start =
 	start >>= \case
 		Nothing -> return Nothing
 		Just (startmsg, perform) -> do
 			showStartMessage startmsg
+			Just <$> performCommandAction' startmsg perform
+
+performCommandAction' :: StartMessage -> CommandPerform -> CommandCleanup
+performCommandAction' startmsg perform = 
 	perform >>= \case
-				Nothing -> return (Just False)
+		Nothing -> do
-				Just cleanup -> Just <$> cleanup
+			showEndMessage startmsg False
+			return False
+		Just cleanup -> do
+			r <- cleanup
+			showEndMessage startmsg r
+			return r
 
 {- Do concurrent output when that has been requested. -}
 allowConcurrentOutput :: Annex a -> Annex a

Messages.hs

@@ -9,6 +9,7 @@ module Messages (
 	showStart,
 	showStart',
 	showStartMessage,
+	showEndMessage,
 	StartMessage(..),
 	ActionItem(..),
 	mkActionItem,
@@ -43,7 +44,6 @@ module Messages (
 	debugEnabled,
 	commandProgressDisabled,
 	outputMessage,
-	implicitMessage,
 	withMessageState,
 	prompt,
 ) where
@@ -97,13 +97,15 @@ showStartMessage (StartUsualMessages command ai) = do
 	outputType <$> Annex.getState Annex.output >>= \case
 		QuietOutput -> Annex.setOutput NormalOutput
 		_ -> noop
-	Annex.changeState $ \s -> s
-		{ Annex.output = (Annex.output s) { implicitMessages = True } }
 	showStartMessage (StartMessage command ai)
 showStartMessage (CustomOutput _) = do
 	Annex.setOutput QuietOutput
-	Annex.changeState $ \s -> s
+
-		{ Annex.output = (Annex.output s) { implicitMessages = False } }
+-- Only show end result if the StartMessage is one that gets displayed.
+showEndMessage :: StartMessage -> Bool -> Annex ()
+showEndMessage (StartMessage _ _) = showEndResult
+showEndMessage (StartUsualMessages _ _) = showEndResult
+showEndMessage (CustomOutput _) = const noop
 
 showNote :: String -> Annex ()
 showNote s = outputMessage (JSON.note s) $ "(" ++ s ++ ") "
@@ -275,12 +277,6 @@ commandProgressDisabled = withMessageState $ \s -> return $
 		JSONOutput _ -> True
 		NormalOutput -> concurrentOutputEnabled s
 
-{- 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)
-
 {- Prevents any concurrent console access while running an action, so
  - that the action is the only thing using the console, and can eg prompt
  - the user.

Types/Messages.hs

@@ -35,7 +35,6 @@ data MessageState = MessageState
 	{ outputType :: OutputType
 	, concurrentOutputEnabled :: Bool
 	, sideActionBlock :: SideActionBlock
-	, implicitMessages :: Bool
 	, consoleRegion :: Maybe ConsoleRegion
 	, consoleRegionErrFlag :: Bool
 	, jsonBuffer :: Maybe Aeson.Object
@@ -49,7 +48,6 @@ newMessageState = do
 		{ outputType = NormalOutput
 		, concurrentOutputEnabled = False
 		, sideActionBlock = NoBlock
-		, implicitMessages = True 
 		, consoleRegion = Nothing
 		, consoleRegionErrFlag = False
 		, jsonBuffer = Nothing