module System.IO.Capture (
capture
) where
import Prelude hiding (catch)
import System.IO
import Control.Exception
import Control.Applicative
import Control.Monad
import System.Posix
import System.Posix.IO
capture :: IO a -> String -> IO (String,String)
capture action givenInput = do
(p,o,e) <- forkHandle (action >> return ()) givenInput
(o_str,e_str) <- (,) <$> hGetContents o <*> hGetContents e
getProcessStatus True True p
return (o_str,e_str)
forkHandle :: IO () -> String -> IO (ProcessID,Handle,Handle)
forkHandle action givenInput = do
(inr,inw) <- createPipe
(outr,outw) <- createPipe
(errr,errw) <- createPipe
pid <- forkProcess $ do
zipWithM_ dupTo [inr,outw,errw] [0,1,2]
inh <- fdToHandle inw
hPutStr inh givenInput >> hClose inh
catchSome action $ hPutStrLn stderr . ("*** Exception: "++) . show
hClose stdout >> hClose stderr
mapM_ closeFd [inr,outr,errr]
mapM_ closeFd [inr,inw,outw,errw]
[outh,errh] <- mapM fdToHandle [outr,errr]
return (pid,outh,errh)
catchSome :: IO a -> (SomeException -> IO a) -> IO a
catchSome = catch