module Propellor.Debug where

import Control.Monad.IfElse
import System.IO
import System.Log.Logger
import System.Log.Formatter
import System.Log.Handler (setFormatter)
import System.Log.Handler.Simple
import Control.Applicative
import Prelude

import Utility.Monad
import Utility.Env
import Utility.Exception
import Utility.Process
import Utility.Directory

debug :: [String] -> IO ()
debug :: [String] -> IO ()
debug = String -> String -> IO ()
debugM String
"propellor" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords

checkDebugMode :: IO ()
checkDebugMode :: IO ()
checkDebugMode = Maybe String -> IO ()
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Maybe String)
getEnv String
"PROPELLOR_DEBUG"
  where
	go :: Maybe String -> IO ()
go (Just String
"1") = IO ()
enableDebugMode
	go (Just String
_) = forall (m :: * -> *). Monad m => m ()
noop
	go Maybe String
Nothing = forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (String -> IO Bool
doesDirectoryExist String
".git") forall a b. (a -> b) -> a -> b
$
		forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
"1" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getgitconfig) IO ()
enableDebugMode
	getgitconfig :: IO String
getgitconfig = forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO String
"" forall a b. (a -> b) -> a -> b
$
		String -> [String] -> IO String
readProcess String
"git" [String
"config", String
"propellor.debug"]

enableDebugMode :: IO ()
enableDebugMode :: IO ()
enableDebugMode = do
	GenericHandler Handle
f <- forall a. LogHandler a => a -> LogFormatter a -> a
setFormatter
		forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Priority -> IO (GenericHandler Handle)
streamHandler Handle
stderr Priority
DEBUG
		forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. String -> LogFormatter a
simpleLogFormatter String
"[$time] $msg")
	String -> (Logger -> Logger) -> IO ()
updateGlobalLogger String
rootLoggerName forall a b. (a -> b) -> a -> b
$ 
		Priority -> Logger -> Logger
setLevel Priority
DEBUG forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. LogHandler a => [a] -> Logger -> Logger
setHandlers [GenericHandler Handle
f]