├── .gitignore ├── .travis.yml ├── CHANGELOG.md ├── LICENSE ├── Makefile ├── README.md ├── Setup.hs ├── par.cabal ├── src └── Main.hs └── stack.yaml /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | .stack-work 3 | stack.yaml.lock 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # This is the simple Travis configuration, which is intended for use 2 | # on applications which do not require cross-platform and 3 | # multiple-GHC-version support. For more information and other 4 | # options, see: 5 | # 6 | # https://docs.haskellstack.org/en/stable/travis_ci/ 7 | # 8 | # Copy these contents into the root directory of your Github project in a file 9 | # named .travis.yml 10 | 11 | # Use new container infrastructure to enable caching 12 | sudo: false 13 | 14 | # Do not choose a language; we provide our own build tools. 15 | language: generic 16 | 17 | # Caching so the next build will be fast too. 18 | cache: 19 | directories: 20 | - $HOME/.stack 21 | 22 | # Ensure necessary system libraries are present 23 | addons: 24 | apt: 25 | packages: 26 | - libgmp-dev 27 | 28 | before_install: 29 | # Download and unpack the stack executable 30 | - mkdir -p ~/.local/bin 31 | - export PATH=$HOME/.local/bin:$PATH 32 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 33 | 34 | install: 35 | # Build dependencies 36 | - stack --no-terminal --install-ghc test --only-dependencies 37 | 38 | script: 39 | # Build the package, its tests, and its docs and run the tests 40 | - stack --no-terminal test --haddock --no-haddock-deps 41 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | 1.0.9 2 | ----- 3 | 4 | - PR #9. Migrate from `slave-thread` to just `async` 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015 Kostiantyn Rybnikov 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files (the 5 | "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject to 9 | the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 17 | IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 18 | CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, 19 | TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE 20 | SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | build: 2 | cabal install -j --only-dependencies --ghc-options="-j" 3 | cabal build 4 | strip ./dist/build/par/par 5 | .PHONY: build 6 | transfer: 7 | curl --upload-file ./dist/build/par/par https://transfer.sh/par 8 | .PHONY: transfer 9 | install: 10 | cp ./dist/build/par/par /usr/local/bin/ 11 | chmod +x /usr/local/bin/par 12 | .PHONY: install 13 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # [![Build Status](https://travis-ci.org/k-bx/par.svg?branch=master)](https://travis-ci.org/k-bx/par) Run several commands in parallel 2 | 3 | `par` is a small utility that runs multiple commands in parallel and 4 | by default exits with a failure status of a first failure it sees. 5 | 6 | Use `--help` for command-line help. 7 | 8 | Basic usage example 9 | ------------------- 10 | 11 | ``` 12 | > par "echo foo; sleep 1; echo foo; sleep 1; echo foo" "echo bar; sleep 1; echo bar; sleep 1; echo bar" && echo "success" 13 | foo 14 | bar 15 | bar 16 | foo 17 | bar 18 | foo 19 | success 20 | > par "echo foo; sleep 1; foofoo" "echo bar; sleep 1; echo bar; sleep 1; echo bar" && echo "success" 21 | bar 22 | foo 23 | bar 24 | /bin/sh: foofoo: command not found 25 | bar 26 | ``` 27 | 28 | Passing commands over stdin 29 | --------------------------- 30 | 31 | Plot 6 streams of data in real time with [feedgnuplot](https://github.com/dkogan/feedgnuplot): 32 | 33 | ``` 34 | for n in a b c d e f; do echo PARPREFIX=$n' (while true; do echo $RANDOM; sleep 0.2; done)'; done | par | feedgnuplot --dataid --stream 0.2 --xlen 1000 --lines --points --terminal qt --exit --autolegend 35 | ``` 36 | 37 | Adding prefix to output 38 | ----------------------- 39 | 40 | ``` 41 | > par "PARPREFIX=[fooechoer] echo foo" "PARPREFIX=[bar] echo bar" 42 | [fooechoer] foo 43 | [bar] bar 44 | ``` 45 | 46 | Force success exit-code 47 | ----------------------- 48 | 49 | ``` 50 | > par --succeed "foo" "bar" && echo 'wow' 51 | /bin/sh: foo: command not found 52 | /bin/sh: bar: command not found 53 | wow 54 | ``` 55 | 56 | Forcing processes to not buffer their output 57 | -------------------------------------------- 58 | 59 | Prefix your subprocesses with this command: 60 | 61 | ``` 62 | stdbuf -o 0 63 | ``` 64 | 65 | Installation 66 | ------------ 67 | 68 | For Ubuntu 12.04, 14.04 and MacOS X download some release and put it 69 | into $PATH. For others -- see "building from source" instructions. 70 | 71 | https://github.com/k-bx/par/releases 72 | 73 | Example: 74 | 75 | ``` 76 | cd /tmp 77 | wget https://github.com/k-bx/par/releases/download/1.0.1/par-ubuntu-12.04 78 | sudo mv ./par-ubuntu-12.04 /usr/local/bin/ 79 | ``` 80 | 81 | Building from source 82 | -------------------- 83 | 84 | 1. Install [haskell stack tool](https://github.com/commercialhaskell/stack) 85 | 2. Run `stack install`. It'll build and install tool into `~/.local/bin/par` 86 | 87 | Footnote on strings in bash/zsh 88 | ------------------------------- 89 | 90 | Many people know that strings in bash and zsh are "weird", but not 91 | many people know that there are good old ASCII-strings also present. 92 | 93 | Double-quoted strings are interpolating variables and do other interesting 94 | things like reacting on "!" sign, for example. 95 | 96 | Single-quotes don't interpolate variables and don't react on "!" sign, but 97 | they also don't let you quote neither single-quote nor double-quote. 98 | 99 | Turns out good old ASCII-quotes are available as $'string' syntax! Example: 100 | 101 | > echo $'foo' 102 | foo 103 | > echo $'foo with "doublequotes and \'singletuoes\' inside"!' 104 | foo with "doublequotes and 'singletuoes' inside"! 105 | 106 | You are a better person with this knowledge now. $'Enjoy!' 107 | 108 | Par-like thing in pure Bash 109 | --------------------------- 110 | 111 | ``` 112 | prefixwith() { 113 | local prefix="$1" 114 | shift 115 | stdbuf -o 0 "$@" 1> >(sed "s/^/$prefix: /") 2> >(sed "s/^/$prefix (err): /" >&2) 116 | } 117 | listenqueue() { 118 | local queue="$1" 119 | prefixwith "[$queue]" kafkacat -b localhost -t $queue -o end & 120 | } 121 | listenqueue diarizer-input 122 | P01=$! 123 | listenqueue diarizer-output 124 | P02=$! 125 | wait $P01 $P02 126 | ``` 127 | 128 | But this has problems with stopping (need to re-create TTY). 129 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /par.cabal: -------------------------------------------------------------------------------- 1 | -- Initial par.cabal generated by cabal init. For further documentation, 2 | -- see http://haskell.org/cabal/users-guide/ 3 | 4 | name: par 5 | version: 1.0.9 6 | -- synopsis: 7 | -- description: 8 | license: MIT 9 | license-file: LICENSE 10 | author: Kostiantyn Rybnikov 11 | maintainer: k-bx@k-bx.com 12 | -- copyright: 13 | category: System 14 | build-type: Simple 15 | -- extra-source-files: 16 | cabal-version: >=1.10 17 | 18 | executable par 19 | main-is: Main.hs 20 | ghc-options: -O 21 | -threaded 22 | -Wall 23 | -- other-modules: 24 | -- other-extensions: 25 | build-depends: base 26 | , async 27 | , bytestring 28 | , enclosed-exceptions 29 | , optparse-applicative 30 | , process 31 | , stm 32 | , string-class 33 | , text 34 | hs-source-dirs: src 35 | default-language: Haskell2010 36 | default-extensions: OverloadedStrings 37 | , ScopedTypeVariables 38 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | module Main 2 | ( main 3 | ) where 4 | 5 | import Control.Concurrent.Async 6 | import Control.Concurrent.STM 7 | import Control.Exception (finally) 8 | import Control.Exception.Enclosed (handleAny) 9 | import Control.Monad (unless, void, when) 10 | import Data.ByteString (ByteString) 11 | import qualified Data.ByteString as B 12 | import Data.Foldable 13 | import qualified Data.List as L 14 | import Data.Maybe 15 | import Data.Semigroup ((<>)) 16 | import Data.String.Class (toStrictByteString) 17 | import Options.Applicative 18 | import Prelude hiding (mapM, mapM_) 19 | import System.Exit 20 | import System.IO 21 | import System.Process 22 | 23 | data Options = Options 24 | { optMasterProcess :: Maybe Int 25 | , optVerbose :: Bool 26 | , optCommands :: [String] 27 | } deriving (Eq, Show) 28 | 29 | parser :: Parser Options 30 | parser = 31 | Options 32 | -- TODO: instead of "read" use something better 33 | <$> 34 | (fmap (fmap read) . optional . strOption $ 35 | long "master-process" <> metavar "MASTER_PROCESS" <> 36 | help 37 | "Master process index, starting from 0. Indicates command, which lifetime and exit-code only matter") <*> 38 | option 39 | auto 40 | (long "verbose" <> help "Print debug output" <> showDefault <> value False <> 41 | metavar "BOOL") <*> 42 | many (argument str (metavar "COMMANDS...")) 43 | 44 | main :: IO () 45 | main = do 46 | hSetBuffering stderr LineBuffering 47 | hSetBuffering stdout NoBuffering 48 | execParser opts >>= tryStdin >>= work 49 | where 50 | opts = info (helper <*> parser) (fullDesc <> progDesc desc) 51 | desc = "Run several commands in parallel" 52 | 53 | tryStdin :: Options -> IO Options 54 | tryStdin o@Options{optCommands=_:_} = pure o 55 | tryStdin o@Options{optCommands=[]} = (\xs -> o{optCommands=xs}) . lines <$> getContents 56 | 57 | work :: Options -> IO () 58 | work opts = do 59 | let debug msg = when (optVerbose opts) $ hPutStrLn stderr msg 60 | outQ <- newTBQueueIO 1024 61 | errQ <- newTBQueueIO 1024 62 | let numCmds = length (optCommands opts) 63 | case optMasterProcess opts of 64 | Nothing -> do 65 | results <- 66 | waitingPipeHandlers 67 | (runOutqueueFlusher outQ stdout numCmds) 68 | (runOutqueueFlusher errQ stderr numCmds) 69 | (mapConcurrently (runSingle debug outQ errQ) (optCommands opts)) 70 | let cmdAndRes = zip (optCommands opts) results 71 | case filter ((/= ExitSuccess) . snd) cmdAndRes of 72 | [] -> exitSuccess 73 | (c, r):_ -> do 74 | hPutStrLn stderr $ "Failed command:\n" <> c 75 | exitWith r 76 | Just masterProcNum -> do 77 | outQMain <- newTBQueueIO 1024 78 | errQMain <- newTBQueueIO 1024 79 | withAsync (runOutqueueFlusher outQ stdout numCmds) $ \_ -> 80 | withAsync (runOutqueueFlusher errQ stderr numCmds) $ \_ -> do 81 | let (xs, m:ys) = splitAt masterProcNum (optCommands opts) 82 | (master, rest) = (m, xs ++ ys) 83 | mapM_ (async . runSingle debug outQ errQ) rest 84 | status <- 85 | waitingPipeHandlers 86 | (forwardWaiting outQMain outQ) 87 | (forwardWaiting errQMain errQ) $ 88 | runSingle debug outQMain errQMain master 89 | exitWith status 90 | where 91 | forwardWaiting from to = go 92 | where 93 | go = do 94 | v <- atomically (readTBQueue from) 95 | when (isJust v) (atomically (writeTBQueue to v) >> go) 96 | 97 | runSingle :: 98 | (String -> IO ()) 99 | -> TBQueue (Maybe ByteString) 100 | -> TBQueue (Maybe ByteString) 101 | -> String 102 | -> IO ExitCode 103 | runSingle debug outQ errQ cmdBig = do 104 | debug $ 105 | "Starting process " <> show cmd <> ", output prefix " <> show cmdPrefix 106 | (_, Just hout, Just herr, ph) <- 107 | createProcess (shell cmd) {std_out = CreatePipe, std_err = CreatePipe} 108 | s <- 109 | waitingPipeHandlers 110 | (forwardPrefixing hout outQ) 111 | (forwardPrefixing herr errQ) 112 | (waitForProcess ph) 113 | debug $ "Process " <> show cmdBig <> " exited with status " <> show s 114 | return s 115 | -- TODO: rewrite via Parsec or regex-applicative 116 | where 117 | (cmd, cmdPrefix) = 118 | if parprefix `L.isPrefixOf` cmdBig 119 | then let (pref, rest) = break (== ' ') (drop (length parprefix) cmdBig) 120 | in (rest, pref <> " ") 121 | else (cmdBig, "") 122 | parprefix = "PARPREFIX=" 123 | toBs = toStrictByteString 124 | prefixer chunk = [toBs cmdPrefix <> chunk] 125 | forwardPrefixing from to = forwardHandler from to prefixer 126 | 127 | waitingPipeHandlers :: IO a -> IO b -> IO c -> IO c 128 | waitingPipeHandlers outH errH inner = 129 | withAsync outH $ \out -> 130 | withAsync errH $ \err -> do 131 | res <- inner 132 | void $ waitBoth out err 133 | return res 134 | 135 | forwardHandler :: 136 | Handle 137 | -> TBQueue (Maybe ByteString) 138 | -> (ByteString -> [ByteString]) 139 | -> IO () 140 | forwardHandler from to f = fin (hndl go) 141 | where 142 | go = do 143 | eof <- hIsEOF from 144 | unless eof $ do 145 | line <- B.hGetLine from 146 | atomically (writeTBQueue to (Just (B.concat (map (<> "\n") (f line))))) 147 | go 148 | hndl = handleAny (const (return ())) 149 | fin f' = finally f' (atomically (writeTBQueue to Nothing)) 150 | 151 | runOutqueueFlusher :: TBQueue (Maybe ByteString) -> Handle -> Int -> IO () 152 | runOutqueueFlusher queue h numCmds = go numCmds 153 | where 154 | go 0 = return () 155 | go n = do 156 | ml <- atomically (readTBQueue queue) 157 | case ml of 158 | Nothing -> go (n - 1) 159 | Just l -> B.hPut h l >> go n 160 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-15.9 2 | packages: 3 | - '.' 4 | --------------------------------------------------------------------------------