From 4ab5a926b1f7b056b191aa3ad4510048ea59f06d Mon Sep 17 00:00:00 2001
From: iko <ilyakooo0@gmail.com>
Date: Thu, 24 Dec 2020 17:22:27 +0300
Subject: [PATCH] Very simple v1

---
 .gitignore   |  1 +
 package.yaml | 26 ++++++++++++++++++++
 src/Main.hs  | 67 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 stack.yaml   |  5 ++++
 4 files changed, 99 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 package.yaml
 create mode 100644 src/Main.hs
 create mode 100644 stack.yaml

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:
+  - .