module System.IO.Capture (
capture
, getContents
, hGetContents
, readFile
) where
import Prelude hiding (getContents,readFile,catch)
import System.IO hiding (getContents,hGetContents,readFile)
import qualified System.IO.Strict as SIO (getContents,hGetContents,readFile)
import Control.Exception
import Control.Applicative
import Control.Monad
import System.Directory
import System.Posix
capture :: IO a -> String -> IO (String,String)
capture action givenInput =
withTempFile $ \(outh,outpath) ->
withTempFile $ \(errh,errpath) -> ignoringException ("","") $ do
let stds = [stdin,stdout,stderr]
stdbufs <- mapM hGetBuffering stds
mapM_ (flip hSetBuffering NoBuffering) stds
(inr,inw) <- createPipe
fd_in <- dup 0
fd_out <- dup 1
fd_err <- dup 2
let capture' = do
inr `dupTo` 0
flip dupTo 1 =<< handleToFd outh
flip dupTo 2 =<< handleToFd errh
fdWrite inw givenInput
closeFd inw
ignoringException () (action >> return ())
(,) <$> readFile outpath <*> readFile errpath
recover = do
fd_in `dupTo` 0
fd_out `dupTo` 1
fd_err `dupTo` 2
forM_ [inr,inw,fd_in,fd_out,fd_err] $ \fd -> ignoringException () $ closeFd fd
zipWithM_ ((ignoringException () .) . hSetBuffering) stds stdbufs
capture' `finally` recover
readFile :: FilePath -> IO String
getContents :: IO String
hGetContents :: Handle -> IO String
readFile = ignoringException "" . SIO.readFile
getContents = ignoringException "" SIO.getContents
hGetContents = ignoringException "" . SIO.hGetContents
withTempFile :: ((Handle,FilePath) -> IO a) -> IO a
withTempFile action = do
(path,hdl) <- flip openTempFile "tmpXXXXX" =<< getTemporaryDirectory
action (hdl,path) `finally` (hClose hdl >> removeFile path)
ignoringException :: a -> IO a -> IO a
ignoringException value action = action `catch` do \(_::SomeException) -> return value