1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
module Process (mkProcess) where
import Control.Concurrent.Async (async, cancel)
import Control.Concurrent.Chan.Unagi (newChan, readChan, writeChan)
import Control.Exception (IOException)
import Control.Monad (forever, unless)
import Data.Bifunctor (bimap)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as BS8
import System.IO (hClose, hIsEOF)
import System.Process qualified as P
mkProcess :: FilePath -> [String] -> IO (IO (Either IOException ByteString), IO ())
mkProcess prog args = do
(Just hin, Just hout, Just herr, ph) <-
P.createProcess (P.proc prog args)
{ P.std_in = P.CreatePipe
, P.std_out = P.CreatePipe
, P.std_err = P.CreatePipe
}
(putOutput, takeOutput) <- bimap writeChan readChan <$> newChan
let reader h = forever do
eof <- hIsEOF h
unless eof do
BS8.hGetLine h >>= putOutput -- TODO mark as stdout/stderr
outReader <- async (reader hout)
errReader <- async (reader herr)
let
-- normal termination path: wait for process, then kill readers
waitProcessAndReaders = do
_ <- P.waitForProcess ph
shutdown
--cancel outReader
--cancel errReader
-- explicit shutdown: kill everything
shutdown = do
P.terminateProcess ph
cancel outReader
cancel errReader
hClose hin
hClose hout
hClose herr
-- optionally run waitProcessAndReaders in background:
_ <- async waitProcessAndReaders
pure (Right <$> takeOutput, shutdown)
|
