summaryrefslogtreecommitdiff
path: root/src/Propellor/Debug.hs
diff options
context:
space:
mode:
authorJoey Hess2015-10-27 23:52:02 -0400
committerJoey Hess2015-10-27 23:52:02 -0400
commit894e2f7980052f1c331ba7780100ae0ad19856cb (patch)
treeaffb9ffb3c77d4d8b12bf2cb6666ec28ce6a11a4 /src/Propellor/Debug.hs
parent261d008d41e6656ce4ceafb8c0f0630d5795944a (diff)
use execProcessConcurrent everywhere
Found a reasonable clean way to make Utility.Process use execProcessConcurrent, while still allowing copying updates to it from git-annex.
Diffstat (limited to 'src/Propellor/Debug.hs')
-rw-r--r--src/Propellor/Debug.hs36
1 files changed, 36 insertions, 0 deletions
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]