module System.IO.Capture
( capture
, captureStream
) where
import Control.Exception
import Control.Monad
import System.IO (hClose, hPutStr)
import System.Posix.IO
import System.Posix.Process
import System.Posix.Types (ProcessID)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Streaming as S
import Data.ByteString.Streaming (stdout)
capture :: IO a -> IO (LBS.ByteString, LBS.ByteString, LBS.ByteString, Maybe ProcessStatus)
capture act = do
(out, err, exc, pid) <- captureStream act
status <- getProcessStatus True True pid
(,,,)
<$> S.toLazy_ out
<*> S.toLazy_ err
<*> S.toLazy_ exc
<*> pure status
captureStream
:: IO a
-> IO ( S.ByteString IO ()
, S.ByteString IO ()
, S.ByteString IO ()
, ProcessID
)
captureStream act = do
(out_r, out_w) <- createPipe
(err_r, err_w) <- createPipe
(exc_r, exc_w) <- createPipe
pid <- forkProcess $ do
closeFd out_r
closeFd err_r
closeFd exc_r
_ <- dupTo out_w stdOutput
_ <- dupTo err_w stdError
exc_wh <- fdToHandle exc_w
void act `catch` \(e :: SomeException) -> hPutStr exc_wh (show e)
closeFd out_w
closeFd err_w
hClose exc_wh
closeFd out_w
closeFd err_w
closeFd exc_w
out_rh <- fdToHandle out_r
err_rh <- fdToHandle err_r
exc_rh <- fdToHandle exc_r
pure ( S.hGetContents out_rh
, S.hGetContents err_rh
, S.hGetContents exc_rh
, pid
)