diff options
| -rw-r--r-- | src/Process.hs | 29 |
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 |