From 894e2f7980052f1c331ba7780100ae0ad19856cb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 27 Oct 2015 23:52:02 -0400 Subject: use execProcessConcurrent everywhere Found a reasonable clean way to make Utility.Process use execProcessConcurrent, while still allowing copying updates to it from git-annex. --- src/Propellor/Debug.hs | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) create mode 100644 src/Propellor/Debug.hs (limited to 'src/Propellor/Debug.hs') diff --git a/src/Propellor/Debug.hs b/src/Propellor/Debug.hs new file mode 100644 index 00000000..ac4a56cc --- /dev/null +++ b/src/Propellor/Debug.hs @@ -0,0 +1,36 @@ +module Propellor.Debug where + +import Control.Applicative +import Control.Monad.IfElse +import System.IO +import System.Directory +import System.Log.Logger +import System.Log.Formatter +import System.Log.Handler (setFormatter) +import System.Log.Handler.Simple + +import Utility.Monad +import Utility.Env +import Utility.Exception +import Utility.Process + +debug :: [String] -> IO () +debug = debugM "propellor" . unwords + +checkDebugMode :: IO () +checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG" + where + go (Just "1") = enableDebugMode + go (Just _) = noop + go Nothing = whenM (doesDirectoryExist ".git") $ + whenM (elem "1" . lines <$> getgitconfig) enableDebugMode + getgitconfig = catchDefaultIO "" $ + readProcess "git" ["config", "propellor.debug"] + +enableDebugMode :: IO () +enableDebugMode = do + f <- setFormatter + <$> streamHandler stderr DEBUG + <*> pure (simpleLogFormatter "[$time] $msg") + updateGlobalLogger rootLoggerName $ + setLevel DEBUG . setHandlers [f] -- cgit v1.2.3