Capture the output while terminating a process - haskell

Question

I need to run a process, do something while it is running, and finally terminate it. The
process in question writes things to standard output that I would like to retain. Unfortunately,
it seems that the process dies before I can connect and extract its last words. Having scarce
experience with asynchronous programming, I am having a difficulty finding a nice solution. It
would be fortunate if I can accomplish this task within the framework of RIO.Process, although I
am prepared to step outside of it if it cannot be avoided. (Note that RIO employs an unusual
way of invoking external processes via a callback system.)
Below is a highly simplified runnable example of what I am trying to achieve.
Here is an emulation of the program to be run:
(Put it in a file called x.sh and say chmod +x x.sh to make it executable.)
#!/bin/sh
trap 'echo "Terminating..."; exit 0' TERM
echo "Initialization complete."
while true; do sleep 1; done
Here is my code:
(Put it in a file called X.hs and compile with ghc -package rio X.hs.)
{-# language NoImplicitPrelude #-}
{-# language BlockArguments #-}
{-# language OverloadedStrings #-}
module Main where
import RIO
import RIO.Process
import Data.Text.IO (hGetContents, hGetLine)
main :: IO ()
main = runSimpleApp do
proc "./x.sh" [ ]
\processConfig -> withProcessWait_ (setStdout createPipe processConfig)
\processHandle -> bracket_
(initialize processHandle)
(terminate processHandle)
(return ())
initialize :: (HasProcessContext env, HasLogFunc env) => Process () Handle () -> RIO env ()
initialize processHandle = do
x <- liftIO $ hGetLine (getStdout processHandle)
if x == "Initialization complete." then return () else error "This should not happen."
terminate :: HasLogFunc env => Process () Handle () -> RIO env ()
terminate processHandle = do
log' <- async $ liftIO $ hGetContents (getStdout processHandle)
stopProcess processHandle
log <- wait log'
logInfo $ display log
Here is what happens:
% ./X
X: fd:3: hGetBuffering: illegal operation (handle is closed)
— x.sh is saying something, but I cannot hear.
What is the right way to manage this?

Answer 1

From the documentation for stopProcess:
Close a process and release any resources acquired. This will ensure terminateProcess is called, wait for the process to actually exit, and then close out resources allocated for the streams. In the event of any cleanup exceptions being thrown this will throw an exception.
(emphasis mine) You don't want stopProcess to do that before you read the output. You just want terminateProcess. withProcessWait_ will take care of the rest of it. Unfortuntately, you do have to step outside of RIO to do that, with import System.Process (terminateProcess) and then liftIO $ terminateProcess (unsafeProcessHandle processHandle).
Side notes: You're kind of misusing bracket_. Since the "middle" of your bracket_ is a no-op, and especially now that the beginning and end aren't actually acquiring or releasing any resources, it's kind of pointless. Also, instead of using async at all, you can just read the output normally after terminating the process, since the output that a process already produced doesn't just disappear when it's terminated.
Here's your code with all of the above fixed:
{-# language NoImplicitPrelude #-}
{-# language BlockArguments #-}
{-# language OverloadedStrings #-}
module Main where
import RIO
import RIO.Process
import Data.Text.IO (hGetContents, hGetLine)
import System.Process (terminateProcess)
main :: IO ()
main = runSimpleApp do
proc "./x.sh" [ ]
\processConfig -> withProcessWait_ (setStdout createPipe processConfig)
\processHandle -> do
initialize processHandle
terminate processHandle
initialize :: (HasProcessContext env, HasLogFunc env) => Process () Handle () -> RIO env ()
initialize processHandle = do
x <- liftIO $ hGetLine (getStdout processHandle)
if x == "Initialization complete." then return () else error "This should not happen."
terminate :: HasLogFunc env => Process () Handle () -> RIO env ()
terminate processHandle = do
liftIO $ terminateProcess (unsafeProcessHandle processHandle)
log <- liftIO $ hGetContents (getStdout processHandle)
logInfo $ display log