module System.Process.Log
(logCreateProcess
,withProcessTimeLog
,showProcessArgDebug)
where
import Control.Monad.IO.Class
import Control.Monad.Logger
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import Language.Haskell.TH
import qualified System.Clock as Clock
import System.Process (CreateProcess(..), CmdSpec(..))
logCreateProcess :: Q Exp
logCreateProcess =
[|let f :: MonadLogger m => CreateProcess -> m ()
f CreateProcess { cmdspec = ShellCommand shellCmd } =
$logDebug ("Creating shell process: " <> T.pack shellCmd)
f CreateProcess { cmdspec = RawCommand name args } =
$logDebug
("Creating process: " <> T.pack name <> " " <>
T.intercalate
" "
(map showProcessArgDebug args))
in f|]
withProcessTimeLog :: Q Exp
withProcessTimeLog =
[|let f :: (MonadIO m, MonadLogger m) => String -> [String] -> m a -> m a
f name args proc = do
let cmdText =
T.intercalate
" "
(T.pack name : map showProcessArgDebug args)
$logDebug ("Run process: " <> cmdText)
start <- liftIO $ Clock.getTime Clock.Monotonic
x <- proc
end <- liftIO $ Clock.getTime Clock.Monotonic
let diff = Clock.diffTimeSpec start end
let useAnsi = True
$logDebug
("Process finished in " <>
(if useAnsi then "\ESC[92m" else "") <>
timeSpecMilliSecondText diff <>
(if useAnsi then "\ESC[0m" else "") <>
": " <> cmdText)
return x
in f|]
timeSpecMilliSecondText :: Clock.TimeSpec -> Text
timeSpecMilliSecondText t =
(T.pack . show . (`div` 10^(6 :: Int)) . Clock.toNanoSecs) t <> "ms"
showProcessArgDebug :: String -> Text
showProcessArgDebug x
| any special x = T.pack (show x)
| otherwise = T.pack x
where special '"' = True
special ' ' = True
special _ = False