Process: use Trammel

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