{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module EL.Private.Process where
import qualified Control.Concurrent as Concurrent
import qualified Control.Concurrent.Async as Async
import qualified Control.Concurrent.Chan as Chan
import Control.Monad (forever, void)
import qualified Data.String as String
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified EL.Private.File as File
import Global
import qualified System.Exit
import qualified System.IO as IO
import qualified System.Process as Process
data TalkOut = Stdout !Text | Stderr !Text
| Exit !Int
deriving (Eq, Show)
data TalkIn = Text !Text | EOF
deriving (Eq, Show)
instance String.IsString TalkIn where
fromString = Text . Text.pack
conversation :: FilePath -> [String] -> Maybe [(String, String)]
-> Chan.Chan TalkIn -> IO (Chan.Chan TalkOut)
conversation cmd args env input = do
output <- Chan.newChan
Concurrent.forkIO $ Process.withCreateProcess proc $
\(Just stdin) (Just stdout) (Just stderr) pid -> do
IO.hSetBuffering stdout IO.LineBuffering
IO.hSetBuffering stderr IO.LineBuffering
outThread <- Async.async $ void $ File.ignoreEOF $ forever $
Chan.writeChan output . Stdout =<< Text.IO.hGetLine stdout
errThread <- Async.async $ void $ File.ignoreEOF $ forever $
Chan.writeChan output . Stderr =<< Text.IO.hGetLine stderr
Concurrent.forkIO $ forever $ Chan.readChan input >>= \case
Text t -> Text.IO.hPutStrLn stdin t >> IO.hFlush stdin
EOF -> IO.hClose stdin
Async.waitBoth outThread errThread
code <- Process.waitForProcess pid
Chan.writeChan output $ Exit $ case code of
System.Exit.ExitFailure code -> code
System.Exit.ExitSuccess -> 0
return output
where
proc = (Process.proc cmd args)
{ Process.std_in = Process.CreatePipe
, Process.std_out = Process.CreatePipe
, Process.std_err = Process.CreatePipe
, Process.close_fds = True
, Process.env = env
}