From 4a0cac113cf999a58a60f7db7a11d5b0ad623699 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 17:53:42 -0400 Subject: fix color display when running propellor inside docker --- src/Propellor/Message.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Message.hs') diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs index e184a59e..639171c5 100644 --- a/src/Propellor/Message.hs +++ b/src/Propellor/Message.hs @@ -6,20 +6,30 @@ 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.Monad +import Utility.Env data MessageHandle = ConsoleMessageHandle | TextMessageHandle mkMessageHandle :: IO MessageHandle -mkMessageHandle = ifM (hIsTerminalDevice stdout) +mkMessageHandle = ifM (hIsTerminalDevice stdout <||> (isJust <$> getEnv "PROPELLOR_CONSOLE")) ( return ConsoleMessageHandle , return TextMessageHandle ) +forceConsole :: IO () +forceConsole = void $ setEnv "PROPELLOR_CONSOLE" "1" True + +isConsole :: MessageHandle -> Bool +isConsole ConsoleMessageHandle = True +isConsole _ = False + whenConsole :: MessageHandle -> IO () -> IO () whenConsole ConsoleMessageHandle a = a whenConsole _ _ = return () -- cgit v1.3-2-g0d8e From 66466a953d9094a7165c8f26225e20aab30369a5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 18 Nov 2014 18:44:24 -0400 Subject: reorg --- src/Propellor/CmdLine.hs | 15 --------------- src/Propellor/Message.hs | 14 ++++++++++++++ 2 files changed, 14 insertions(+), 15 deletions(-) (limited to 'src/Propellor/Message.hs') diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 3e24dd34..8c67f378 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -3,10 +3,6 @@ module Propellor.CmdLine where import System.Environment (getArgs) import Data.List import System.Exit -import System.Log.Logger -import System.Log.Formatter -import System.Log.Handler (setFormatter, LogHandler) -import System.Log.Handler.Simple import System.PosixCompat import Control.Exception (bracket) import System.Posix.IO @@ -343,14 +339,3 @@ gitPush hin hout = void $ fromstdin `concurrently` tostdout B.hPut toh b hFlush toh connect fromh toh - -checkDebugMode :: IO () -checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG" - where - go (Just "1") = do - f <- setFormatter - <$> streamHandler stderr DEBUG - <*> pure (simpleLogFormatter "[$time] $msg") - updateGlobalLogger rootLoggerName $ - setLevel DEBUG . setHandlers [f] - go _ = noop diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs index 639171c5..a1e510ab 100644 --- a/src/Propellor/Message.hs +++ b/src/Propellor/Message.hs @@ -5,6 +5,9 @@ module Propellor.Message where import System.Console.ANSI import System.IO import System.Log.Logger +import System.Log.Formatter +import System.Log.Handler (setFormatter, LogHandler) +import System.Log.Handler.Simple import "mtl" Control.Monad.Reader import Data.Maybe import Control.Applicative @@ -98,3 +101,14 @@ colorLine h intensity color msg = do -- | Causes a debug message to be displayed when PROPELLOR_DEBUG=1 debug :: [String] -> IO () debug = debugM "propellor" . unwords + +checkDebugMode :: IO () +checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG" + where + go (Just "1") = do + f <- setFormatter + <$> streamHandler stderr DEBUG + <*> pure (simpleLogFormatter "[$time] $msg") + updateGlobalLogger rootLoggerName $ + setLevel DEBUG . setHandlers [f] + go _ = noop -- cgit v1.3-2-g0d8e