io-capture 0.3 → 1.0.0

raw patch · 8 files changed

+220/−125 lines, 8 filesdep +bytestringdep +hspecdep +hspec-coredep ~basedep ~unixsetup-changedPVP ok

version bump matches the API change (PVP)

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

Dependency ranges changed: base, unix

API changes (from Hackage documentation)

Files

• LICENSE +21/−28
• Setup.hs +2/−0
• Setup.lhs +0/−3
• System/IO/Capture.hs +0/−52
• io-capture.cabal +47/−14
• src/System/IO/Capture.hs +106/−0
• tests/Spec.hs +44/−0
• tests/Tests.hs +0/−28

@@ -1,31 +1,24 @@-Copyright Yusaku Hashimoto 2009-+Copyright (c) 2016 Mitchell Rosen 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.+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. +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,2 @@+import Distribution.Simple+main = defaultMain

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

@@ -1,52 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--module System.IO.Capture (-  -- * Capturing std(out|err)-  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--{-|--  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","")-- -}--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 -- >>= hPutStrLn stderr . show-  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

@@ -1,16 +1,49 @@-name:                io-capture-version:             0.3-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-build-type:          Simple-ghc-options:         -Wall+-- This file has been generated from package.yaml by hpack version 0.9.0.+--+-- see: https://github.com/sol/hpack -exposed-modules:     System.IO.Capture+name:           io-capture+version:        1.0.0+synopsis:       Capture IO actions' stdout and stderr+description:    Capture IO actions' stdout and stderr+category:       System+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 -extra-source-files:  tests/Tests.hs+source-repository head+  type: git+  location: https://github.com/mitchellwrosen/io-capture++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++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

@@ -0,0 +1,106 @@+{-# 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+       )

@@ -0,0 +1,44 @@+{-# 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

@@ -1,28 +0,0 @@-import Test.Torch-import Control.Monad.Trans-import System.IO (hPutStrLn,stderr)-import System.IO.Capture (capture)--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"--  (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"-  is out "foo\n" "after lazy-io, stdout is still captured"-  is err "bar\n" "after lazy-io, stderr is still captured"