commit 4ab5a926b1f7b056b191aa3ad4510048ea59f06d Author: iko Date: Thu Dec 24 17:22:27 2020 +0300 Very simple v1 diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..8dbff60 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +odn.cabal diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..1cf8b65 --- /dev/null +++ b/package.yaml @@ -0,0 +1,26 @@ +name: odn +# synopsis: + +dependencies: + - base + - typed-process + - colourista + - text + +executable: + source-dirs: src + main: Main.hs + +ghc-options: + - -threaded + - -Weverything + - -Wno-implicit-prelude + - -Wno-safe + - -Wno-missing-import-lists + - -Wno-partial-fields + - -Wno-all-missed-specialisations + - -Wno-missing-local-signatures + - -Wno-unsafe + +default-extensions: + - OverloadedStrings diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..c978597 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,67 @@ +module Main (main) where + +import Colourista +import Control.Concurrent +import Control.Monad +import Data.Functor +import qualified Data.Text as T +import System.Environment +import System.Exit +import System.IO +import System.Process.Typed + +main :: IO () +main = getArgs >>= runPrograms + +runPrograms :: [String] -> IO () +runPrograms progs = do + exited <- newEmptyMVar + processes <- forM (zip progs (prettifyProcesses progs)) $ \(prog, pretty) -> do + p <- + startProcess . setStderr createPipe + . setStdout createPipe + . setStdin nullStream + $ shell prog + void . forkIO $ do + e <- waitExitCode p + putMVar exited (pretty, e) + return (pretty, p) + + forever $ do + isEmpty <- isEmptyMVar exited + let writeLogs = + forM (zip colors processes) $ \(color, (prog, p)) -> do + (||) + <$> writeOutput [color] prog (getStdout p) + <*> writeOutput [color] prog (getStderr p) + + if isEmpty + then do + written <- writeLogs + if or written + then return () + else threadDelay 100000 + else do + (prog, exitCode) <- readMVar exited + infoMessage $ T.pack prog <> " exited with " <> (T.pack . show) exitCode + forM_ processes (stopProcess . snd) + exitWith exitCode + +colors :: [String] +colors = cycle [green, blue, magenta, cyan] + +writeOutput :: [String] -> String -> Handle -> IO Bool +writeOutput color prog h = do + eof <- hIsEOF h + if eof + then return False + else do + l <- hGetLine h + putStrLn $ formatWith color (prog <> " | ") <> l + return True + +prettifyProcesses :: [String] -> [String] +prettifyProcesses ps' = + let ps = take 50 <$> ps' + maxLen = maximum . fmap length $ ps + in ps <&> \p -> p <> replicate (maxLen - length p) ' ' diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..63f0bfe --- /dev/null +++ b/stack.yaml @@ -0,0 +1,5 @@ +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/27.yaml + +packages: + - .