mirror of
https://github.com/ilyakooo0/odn.git
synced 2024-11-29 12:13:00 +03:00
Very simple v1
This commit is contained in:
commit
4ab5a926b1
1
.gitignore
vendored
Normal file
1
.gitignore
vendored
Normal file
@ -0,0 +1 @@
|
|||||||
|
odn.cabal
|
26
package.yaml
Normal file
26
package.yaml
Normal file
@ -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
|
67
src/Main.hs
Normal file
67
src/Main.hs
Normal file
@ -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) ' '
|
5
stack.yaml
Normal file
5
stack.yaml
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
resolver:
|
||||||
|
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/27.yaml
|
||||||
|
|
||||||
|
packages:
|
||||||
|
- .
|
Loading…
Reference in New Issue
Block a user