packages feed

io-capture 0.1.0.0 → 0.2

raw patch · 8 files changed

+174/−219 lines, 8 filesdep +directorydep +strictdep −bytestringdep −hspecdep −hspec-coredep ~basedep ~unixsetup-changed

Dependencies added: directory, strict

Dependencies removed: bytestring, hspec, hspec-core, io-capture, streaming-bytestring

Dependency ranges changed: base, unix

Files

LICENSE view
@@ -1,24 +1,31 @@-Copyright (c) 2016 Mitchell Rosen+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 Mitchell Rosen nor the names of other contributors-      may be used to endorse or promote products derived from this software-      without specific prior written permission.+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met: -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.+    * 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.+
− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ System/IO/Capture.hs view
@@ -0,0 +1,88 @@+{-# 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+          (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)++ignoringException :: a -> IO a -> IO a+ignoringException value action = action `catch` do \(_::SomeException) -> return value+
io-capture.cabal view
@@ -1,48 +1,16 @@--- This file has been generated from package.yaml by hpack version 0.9.0.------ see: https://github.com/sol/hpack--name:           io-capture-version:        0.1.0.0-synopsis:       Capture IO actions' stdout and stderr-description:    Capture IO actions' stdout and stderr-homepage:       https://github.com/mitchellwrosen/io-capture#readme-bug-reports:    https://github.com/mitchellwrosen/io-capture/issues-author:         Mitchell Rosen-maintainer:     mitchellwrosen@gmail.com-copyright:      2016 Mitchell Rosen-license:        BSD3-license-file:   LICENSE-build-type:     Simple-cabal-version:  >= 1.10--source-repository head-  type: git-  location: https://github.com/mitchellwrosen/io-capture+name:                io-capture+version:             0.2+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 -library-  hs-source-dirs:-      src-  ghc-options: -Wall-  build-depends:-      base <5.0-    , bytestring <0.11-    , streaming-bytestring <0.2-    , unix <2.8-  exposed-modules:-      System.IO.Capture-  default-language: Haskell2010+exposed-modules:     System.IO.Capture -test-suite spec-  type: exitcode-stdio-1.0-  main-is: tests/Spec.hs-  ghc-options: -Wall-  build-depends:-      base <5.0-    , bytestring <0.11-    , streaming-bytestring <0.2-    , unix <2.8-    , hspec-    , hspec-core-    , io-capture-  default-language: Haskell2010+extra-source-files:  tests/Tests.hs
− src/System/IO/Capture.hs 
@@ -1,106 +0,0 @@-{-# LANGUAGE LambdaCase          #-}-{-# LANGUAGE ScopedTypeVariables #-}--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---- For haddocks-import Data.ByteString.Streaming (stdout)---- | Capture an IO action's @stdout@, @stderr@, and any thrown exception. Waits--- for the action to complete before returning.------ @--- > (out, _, _, _) <- 'capture' ('putStrLn' "foo")--- > 'print' out--- \"foo\"------ > (_, err, _, _) <- 'capture' ('System.IO.hPutStrLn' 'System.IO.stderr' \"bar\")--- > 'print' err--- \"bar\"------ > (_, _, exc, _) <- 'capture' 'undefined'--- > 'print' exc--- \"Prelude.undefined\"--- @-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---- | Stream an IO action's @stdout@, @stderr@, and any thrown exception. Also--- returns the spawned process's pid to @wait@ on (otherwise the process will--- become a zombie after terminating), kill, etc.------ @--- import qualified Data.ByteString.Streaming as S------ > let action = 'putStrLn' \"foo\" >> 'Control.Concurrent.threadDelay' 1000000--- > (out, _, _, pid) <- 'captureStream' ('Control.Monad.replicateM_' 5 action)--- > S.'stdout' out--- foo--- foo--- foo--- foo--- foo--- > 'getProcessStatus' True True pid--- Just ('Exited' 'System.Exit.ExitSuccess')--- @-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-       )
− tests/Spec.hs 
@@ -1,44 +0,0 @@-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}--import System.IO.Capture--import Control.Concurrent-import Control.Monad-import System.IO-import System.Posix.Process-import System.Posix.Signals-import System.Timeout-import Test.Hspec-import Test.Hspec.Core.Runner--import qualified Data.ByteString.Streaming as S--main :: IO ()-main = hspecWith config $ do-  describe "capture" $ do-    it "captures everything" $ do-      (out, err, exc, _) <- capture (putStr "foo" >> hPutStr stderr "bar" >> undefined)-      out `shouldBe` "foo"-      err `shouldBe` "bar"-      exc `shouldBe` "Prelude.undefined"--  describe "captureStream" $ do-    it "streams output" $ do-      (out, _, _, pid) <- captureStream (forever (putStrLn "foo" >> threadDelay (1*sec)))--      timeout (2*sec) (S.uncons out) >>= \case-        Just (Just _) -> do-          signalProcess sigKILL pid-          _ <- getProcessStatus True True pid-          pure ()-        _ -> expectationFailure "expected a byte, found nothing"--- where-  -- hspec in color mode messes with stdout-  config = defaultConfig-    { configColorMode = ColorNever }--sec :: Int-sec = 1000000
+ tests/Tests.hs view
@@ -0,0 +1,41 @@+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"++  (_,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"+ -}