@@ -0,0 +1,67 @@
1+module Main (main) where
2+
3+import Colourista
4+import Control.Concurrent
5+import Control.Monad
6+import Data.Functor
7+import qualified Data.Text as T
8+import System.Environment
9+import System.Exit
10+import System.IO
11+import System.Process.Typed
12+
13+main :: IO ()
14+main = getArgs >>= runPrograms
15+
16+runPrograms :: [String] -> IO ()
17+runPrograms progs = do
18+ exited <- newEmptyMVar
19+ processes <- forM (zip progs (prettifyProcesses progs)) $ \(prog, pretty) -> do
20+ p <-
21+ startProcess . setStderr createPipe
22+ . setStdout createPipe
23+ . setStdin nullStream
24+ $ shell prog
25+ void . forkIO $ do
26+ e <- waitExitCode p
27+ putMVar exited (pretty, e)
28+ return (pretty, p)
29+
30+ forever $ do
31+ isEmpty <- isEmptyMVar exited
32+ let writeLogs =
33+ forM (zip colors processes) $ \(color, (prog, p)) -> do
34+ (||)
35+ <$> writeOutput [color] prog (getStdout p)
36+ <*> writeOutput [color] prog (getStderr p)
37+
38+ if isEmpty
39+ then do
40+ written <- writeLogs
41+ if or written
42+ then return ()
43+ else threadDelay 100000
44+ else do
45+ (prog, exitCode) <- readMVar exited
46+ infoMessage $ T.pack prog <> " exited with " <> (T.pack . show) exitCode
47+ forM_ processes (stopProcess . snd)
48+ exitWith exitCode
49+
50+colors :: [String]
51+colors = cycle [green, blue, magenta, cyan]
52+
53+writeOutput :: [String] -> String -> Handle -> IO Bool
54+writeOutput color prog h = do
55+ eof <- hIsEOF h
56+ if eof
57+ then return False
58+ else do
59+ l <- hGetLine h
60+ putStrLn $ formatWith color (prog <> " | ") <> l
61+ return True
62+
63+prettifyProcesses :: [String] -> [String]
64+prettifyProcesses ps' =
65+ let ps = take 50 <$> ps'
66+ maxLen = maximum . fmap length $ ps
67+ in ps <&> \p -> p <> replicate (maxLen - length p) ' '