Avoid outputting color setting sequences when not run on a terminal.

Currently TERM is checked for every message. Could be memoized, but it
would add complexity, and typical propellor output is not going to be more
than a few hundred messages, and likely this will be swamped by the actual
work.

debian/changelog

@@ -7,6 +7,7 @@ propellor (0.9.3) UNRELEASED; urgency=medium
   * Convert GpgKeyId to newtype.
   * DigitalOcean.distroKernel property now reboots into the distribution
     kernel when necessary.
+  * Avoid outputting color setting sequences when not run on a terminal.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 10 Nov 2014 11:15:27 -0400
 

src/Propellor/Message.hs

@@ -6,8 +6,26 @@ import System.Console.ANSI
 import System.IO
 import System.Log.Logger
 import "mtl" Control.Monad.Reader
+import Data.Maybe
+import Control.Applicative
 
 import Propellor.Types
+import Utility.Env
+import Utility.Monad
+
+data MessageHandle
+	= ConsoleMessageHandle
+	| TextMessageHandle
+
+mkMessageHandle :: IO MessageHandle
+mkMessageHandle = ifM (isJust <$> getEnv "TERM")
+	( return ConsoleMessageHandle
+	, return TextMessageHandle
+	)
+
+whenConsole :: MessageHandle -> IO () -> IO ()
+whenConsole ConsoleMessageHandle a = a
+whenConsole _ _ = return ()
 
 -- | Shows a message while performing an action, with a colored status
 -- display.
@@ -21,46 +39,55 @@ actionMessageOn = actionMessage' . Just
 
 actionMessage' :: (MonadIO m, ActionResult r) => Maybe HostName -> Desc -> m r -> m r
 actionMessage' mhn desc a = do
-	liftIO $ do
+	h <- liftIO mkMessageHandle
+	liftIO $ whenConsole h $ do
 		setTitle $ "propellor: " ++ desc
 		hFlush stdout
 
 	r <- a
 
 	liftIO $ do
-		setTitle "propellor: running"
-		showhn mhn
+		whenConsole h $
+			setTitle "propellor: running"
+		showhn h mhn
 		putStr $ desc ++ " ... "
 		let (msg, intensity, color) = getActionResult r
-		colorLine intensity color msg
+		colorLine h intensity color msg
 		hFlush stdout
 
 	return r
   where
-	showhn Nothing = return ()
-	showhn (Just hn) = do
-		setSGR [SetColor Foreground Dull Cyan]
+	showhn _ Nothing = return ()
+	showhn h (Just hn) = do
+		whenConsole h $
+			setSGR [SetColor Foreground Dull Cyan]
 		putStr (hn ++ " ")
-		setSGR []
+		whenConsole h $
+			setSGR []
 
 warningMessage :: MonadIO m => String -> m ()
-warningMessage s = liftIO $ colorLine Vivid Magenta $ "** warning: " ++ s
+warningMessage s = liftIO $ do
+	h <- mkMessageHandle
+	colorLine h Vivid Magenta $ "** warning: " ++ s
 
-colorLine :: ColorIntensity -> Color -> String -> IO ()
-colorLine intensity color msg = do
-	setSGR [SetColor Foreground intensity color]
+errorMessage :: MonadIO m => String -> m a
+errorMessage s = liftIO $ do
+	h <- mkMessageHandle
+	colorLine h Vivid Red $ "** error: " ++ s
+	error "Cannot continue!"
+
+colorLine :: MessageHandle -> ColorIntensity -> Color -> String -> IO ()
+colorLine h intensity color msg = do
+	whenConsole h $
+		setSGR [SetColor Foreground intensity color]
 	putStr msg
-	setSGR []
+	whenConsole h $
+		setSGR []
 	-- Note this comes after the color is reset, so that
 	-- the color set and reset happen in the same line.
 	putStrLn ""
 	hFlush stdout
 
-errorMessage :: String -> IO a
-errorMessage s = do
-	liftIO $ colorLine Vivid Red $ "** error: " ++ s
-	error "Cannot continue!"
-
 -- | Causes a debug message to be displayed when PROPELLOR_DEBUG=1
 debug :: [String] -> IO ()
 debug = debugM "propellor" . unwords