io-capture (empty) → 0.1

raw patch · 5 files changed

+169/−0 lines, 5 filesdep +basedep +directorydep +strictsetup-changed

Dependencies added: base, directory, strict, unix

Files

• LICENSE +31/−0
• Setup.lhs +3/−0
• System/IO/Capture.hs +87/−0
• io-capture.cabal +16/−0
• tests/Tests.hs +32/−0

@@ -0,0 +1,31 @@+Copyright Yusaku Hashimoto 2009++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Yusaku Hashimoto nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,87 @@+{-# LANGUAGE ScopedTypeVariables #-}++module System.IO.Capture (+  -- * As usual, You specify import only this function.+  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 Control.Exception+import Control.Applicative+import Control.Monad+import System.Directory+import System.Posix++{-|++  Takes an IO as action to run, and a String as given stdin,+  then returns whole stdout and stderr as String of tuple.++  > import System.IO.Capture (capture)+  >+  > 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+          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++-- 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)++ignoringException :: a -> IO a -> IO a+ignoringException value action = action `catch` do \(_::SomeException) -> return value+

@@ -0,0 +1,16 @@+name:                io-capture+version:             0.1+synopsis:            capture IO action's stdout and stderr+description:         capture IO action's stdout and stderr+category:            System+license:             BSD3+license-file:        LICENSE+author:              Yusaku Hashimoto+maintainer:          nonowarn@gmail.com+build-depends:       base >= 4 && < 5, unix, strict, directory+build-type:          Simple+ghc-options:         -Wall++exposed-modules:     System.IO.Capture++extra-source-files:  tests/Tests.hs

@@ -0,0 +1,32 @@+import Test.Torch+import Control.Monad.Trans+import Prelude hiding (getContents)+import System.IO (hPutStrLn,stderr)+import System.IO.Capture (capture,getContents)++main = run $ do+  (out,err) <- liftIO $ capture (putStrLn "foo") []+  is out "foo\n" "stdout is captured"+  ok (null err)  "stderr is also captured"++  (out,err) <- liftIO $ capture (getLine >>= putStrLn >>+                                 getLine >>= hPutStrLn stderr)+                                "foo\nbar\n"+  is out "foo\n" "stdin can be given; stdout is still captured"+  is err "bar\n" "stdin can be given; stderr is still captured"++  (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"++  (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"+ -}