summaryrefslogtreecommitdiffstats
path: root/src/Process.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Process.hs')
-rw-r--r--src/Process.hs29
1 files changed, 19 insertions, 10 deletions
diff --git a/src/Process.hs b/src/Process.hs
index 5c53681..75040e1 100644
--- a/src/Process.hs
+++ b/src/Process.hs
@@ -1,21 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Process
( spawn
, module System.Process
) where
+import Control.Concurrent
import Control.Monad (unless, when)
+import Data.Monoid
+import System.Exit
import System.IO
import System.Process
-import Control.Concurrent
+
+import Trammel
+
type OutputWrapper = IO () -> IO ()
data OutStreamType = Stderr | Stdout
-color :: OutStreamType -> String
-color Stderr = "31"
-color Stdout = "32"
+color :: OutStreamType -> Ps
+color Stderr = 31
+color Stdout = 32
data ReaperConfig = ReaperConfig
{ withOutput :: OutputWrapper
@@ -60,10 +66,10 @@ spawn jobId _withOutput cmdline = do
reap :: ReaperConfig -> IO ()
reap rc@ReaperConfig{..} = do
forLines_ streamHandle $ \line ->
- withOutput $ do
- putStrLn $
- "\x1b[35m" ++ jobName ++ "\x1b[m " ++
- "\x1b[" ++ (color streamType) ++ "m" ++ line ++ "\x1b[m"
+ withOutput $ putStrLn $ pp $
+ SGR [35] (Plain jobName) <>
+ Plain " " <>
+ SGR [color streamType] (Plain line)
i <- decMVar openFdsRef
@@ -79,8 +85,11 @@ reap rc@ReaperConfig{..} = do
finish :: ReaperConfig -> IO ()
finish ReaperConfig{..} = do
exitCode <- waitForProcess processHandle
- withOutput $
- putStrLn $ "\x1b[35m" ++ jobName ++ "\x1b[m exit: " ++ show exitCode
+ when (exitCode /= ExitSuccess) $
+ withOutput $ putStrLn $ pp $
+ SGR [35] (Plain jobName) <>
+ Plain " " <>
+ SGR [31] (Plain $ show exitCode)
decMVar :: MVar Int -> IO Int