io-capture 0.2 → 0.3

raw patch · 3 files changed

+31/−80 lines, 3 filesdep −directorydep −strictPVP ok

version bump matches the API change (PVP)

Dependencies removed: directory, strict

API changes (from Hackage documentation)

Files

• System/IO/Capture.hs +26/−62
• io-capture.cabal +2/−2
• tests/Tests.hs +3/−16

@@ -1,24 +1,17 @@ {-# LANGUAGE ScopedTypeVariables #-}  module System.IO.Capture (-  -- * As usual, You specify import only this function.+  -- * Capturing std(out|err)   capture--  -- * If you want to use lazy reading in the action, I recomend you use these.-, 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)-    -- in package strict (not in strict-io)+import Prelude hiding (catch)+import System.IO import Control.Exception import Control.Applicative import Control.Monad-import System.Directory import System.Posix+import System.Posix.IO  {-| @@ -30,59 +23,30 @@   > main = print =<< capture (getLine >>= putStr) "foobar"   >   -- prints ("foobar","") -  WARNING: If Lazy Reading such as @getContents@ was contained in the-  action, its behavior is very strange. For detail, see-  tests/Tests.hs.-  -}  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-          (action >> return ()) `catch`-            (\(e::SomeException) -> hPutStrLn stderr ("*** Exception: " ++ show e))-          (,) <$> 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---- override for forcing strictness---- if exception was thrown, they returns empty string.--readFile     :: FilePath -> IO String-getContents  :: IO String-hGetContents :: Handle -> IO String--readFile     = ignoringException "" . SIO.readFile-getContents  = ignoringException "" SIO.getContents-hGetContents = ignoringException "" . SIO.hGetContents---- utilities--withTempFile :: ((Handle,FilePath) -> IO a) -> IO a-withTempFile action = do-  (path,hdl) <- flip openTempFile "tmpXXXXX" =<< getTemporaryDirectory-  action (hdl,path) `finally` (hClose hdl >> removeFile path)+capture action givenInput = do+  (p,o,e) <- forkHandle (action >> return ()) givenInput+  (o_str,e_str) <- (,) <$> hGetContents o <*> hGetContents e+  getProcessStatus True True p -- >>= hPutStrLn stderr . show+  return (o_str,e_str) -ignoringException :: a -> IO a -> IO a-ignoringException value action = action `catch` do \(_::SomeException) -> return value+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

@@ -1,5 +1,5 @@ name:                io-capture-version:             0.2+version:             0.3 synopsis:            capture IO action's stdout and stderr description:         capture IO action's stdout and stderr category:            System@@ -7,7 +7,7 @@ license-file:        LICENSE author:              Yusaku Hashimoto maintainer:          nonowarn@gmail.com-build-depends:       base >= 4 && < 5, unix, strict, directory+build-depends:       base >= 4 && < 5, unix build-type:          Simple ghc-options:         -Wall 

@@ -1,8 +1,7 @@ import Test.Torch import Control.Monad.Trans-import Prelude hiding (getContents) import System.IO (hPutStrLn,stderr)-import System.IO.Capture (capture,getContents)+import System.IO.Capture (capture)  main = run $ do   (out,err) <- liftIO $ capture (putStrLn "foo") []@@ -18,24 +17,12 @@   (_,err) <- liftIO $ capture undefined []   is err "*** Exception: Prelude.undefined\n" "error message in stderr is also captured" -  -- This getContents is strict. Because lazy getContents don't return-  -- from action.-   (out,err) <- liftIO $ capture (getContents >>= putStr) "foobarbaz\nquux\n"   is out "foobarbaz\nquux\n" "lazy io also works; stdout captured"   ok (null err)              "lazy io also works; stderr captured" -  -- getContents closes stdin, But I don't know why I can't read-  -- std(out|err) any more.-   (out,err) <- liftIO $ capture (getLine >>= putStrLn >>                                  getLine >>= hPutStrLn stderr)                                 "foo\nbar\n"-  isn't out "foo\n" "after lazy reading stdin, stdin is not can be given any more"-  isn't err "bar\n" "after lazy reading stdin, stdin is not can be given any more"--{--  (out,err) <- liftIO $ capture (putStrLn "foo") []-  is out "foo\n" "but stdout is still captured, after lazy reading"-  ok (null err)  "stderr is still also captured, after lazy reading"- -}+  is out "foo\n" "after lazy-io, stdout is still captured"+  is err "bar\n" "after lazy-io, stderr is still captured"