packages feed

process-extras 0.1.3 → 0.2.0

raw patch · 6 files changed

+139/−80 lines, 6 filesdep +deepseq

Dependencies added: deepseq

Files

process-extras.cabal view
@@ -1,12 +1,12 @@ Name:               process-extras-Version:            0.1.3+Version:            0.2.0 Synopsis:           Process extras Description:        Extra functionality for the Process library                     <http://hackage.haskell.org/package/process>. Homepage:           https://github.com/davidlazar/process-extras License:            MIT License-file:       LICENSE-Author:             David Lazar+Author:             David Lazar, Bas van Dijk Maintainer:         David Lazar <lazar6@illinois.edu> Category:           System Build-type:         Simple@@ -27,9 +27,14 @@     System.Process.ByteString     System.Process.ByteString.Lazy     System.Process.Text+    System.Process.Text.Lazy +  Other-modules:+    Utils+   Build-depends:     base >= 4 && < 5,     process,     bytestring,-    text+    text,+    deepseq
src/System/Process/ByteString.hs view
@@ -1,12 +1,13 @@ module System.Process.ByteString where -import Control.Concurrent+import Control.Exception import Control.Monad import Data.ByteString (ByteString) import qualified Data.ByteString as B import System.Process import System.Exit (ExitCode) import System.IO+import Utils (forkWait)  -- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString' readProcessWithExitCode@@ -14,40 +15,33 @@     -> [String]                 -- ^ any arguments     -> ByteString               -- ^ standard input     -> IO (ExitCode, ByteString, ByteString) -- ^ exitcode, stdout, stderr-readProcessWithExitCode cmd args input = do+readProcessWithExitCode cmd args input = mask $ \restore -> do     (Just inh, Just outh, Just errh, pid) <-         createProcess (proc cmd args){ std_in  = CreatePipe,                                        std_out = CreatePipe,                                        std_err = CreatePipe }-    outMVar <- newEmptyMVar-    outM <- newEmptyMVar-    errM <- newEmptyMVar+    flip onException+      (do hClose inh; hClose outh; hClose errh;+          terminateProcess pid; waitForProcess pid) $ restore $ do -    -- fork off a thread to start consuming stdout-    _ <- forkIO $ do-        out <- B.hGetContents outh-        putMVar outM out-        putMVar outMVar ()+      -- fork off a thread to start consuming stdout+      waitOut <- forkWait $ B.hGetContents outh -    -- fork off a thread to start consuming stderr-    _ <- forkIO $ do-        err  <- B.hGetContents errh-        putMVar errM err-        putMVar outMVar ()+      -- fork off a thread to start consuming stderr+      waitErr <- forkWait $ B.hGetContents errh -    -- now write and flush any input-    when (not (B.null input)) $ do B.hPutStr inh input; hFlush inh-    hClose inh -- done with stdin+      -- now write and flush any input+      unless (B.null input) $ do B.hPutStr inh input; hFlush inh+      hClose inh -- done with stdin -    -- wait on the output-    takeMVar outMVar-    takeMVar outMVar-    hClose outh-    hClose errh+      -- wait on the output+      out <- waitOut+      err <- waitErr -    -- wait on the process-    ex <- waitForProcess pid-    out <- readMVar outM-    err <- readMVar errM+      hClose outh+      hClose errh -    return (ex, out, err)+      -- wait on the process+      ex <- waitForProcess pid++      return (ex, out, err)
src/System/Process/ByteString/Lazy.hs view
@@ -1,13 +1,14 @@ module System.Process.ByteString.Lazy where -import Control.Concurrent-import qualified Control.Exception as C+import Control.Exception+import qualified Control.Exception as C (evaluate) import Control.Monad import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as B import System.Process import System.Exit (ExitCode) import System.IO+import Utils (forkWait)  -- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString' readProcessWithExitCode@@ -15,32 +16,35 @@     -> [String]                 -- ^ any arguments     -> ByteString               -- ^ standard input     -> IO (ExitCode, ByteString, ByteString) -- ^ exitcode, stdout, stderr-readProcessWithExitCode cmd args input = do+readProcessWithExitCode cmd args input = mask $ \restore -> do     (Just inh, Just outh, Just errh, pid) <-         createProcess (proc cmd args){ std_in  = CreatePipe,                                        std_out = CreatePipe,                                        std_err = CreatePipe }-    outMVar <- newEmptyMVar+    flip onException+      (do hClose inh; hClose outh; hClose errh;+            terminateProcess pid; waitForProcess pid) $ restore $ do -    -- fork off a thread to start consuming stdout-    out  <- B.hGetContents outh-    _ <- forkIO $ C.evaluate (B.length out) >> putMVar outMVar ()+      -- fork off a thread to start consuming stdout+      out <- B.hGetContents outh+      waitOut <- forkWait $ void $ C.evaluate $ B.length out -    -- fork off a thread to start consuming stderr-    err  <- B.hGetContents errh-    _ <- forkIO $ C.evaluate (B.length err) >> putMVar outMVar ()+      -- fork off a thread to start consuming stderr+      err <- B.hGetContents errh+      waitErr <- forkWait $ void $ C.evaluate $ B.length err -    -- now write and flush any input-    when (not (B.null input)) $ do B.hPutStr inh input; hFlush inh-    hClose inh -- done with stdin+      -- now write and flush any input+      unless (B.null input) $ do B.hPutStr inh input; hFlush inh+      hClose inh -- done with stdin -    -- wait on the output-    takeMVar outMVar-    takeMVar outMVar-    hClose outh-    hClose errh+      -- wait on the output+      waitOut+      waitErr -    -- wait on the process-    ex <- waitForProcess pid+      hClose outh+      hClose errh -    return (ex, out, err)+      -- wait on the process+      ex <- waitForProcess pid++      return (ex, out, err)
src/System/Process/Text.hs view
@@ -1,6 +1,6 @@ module System.Process.Text where -import Control.Concurrent+import Control.Exception import Control.Monad import Data.Text (Text) import qualified Data.Text as T@@ -8,6 +8,7 @@ import System.Process import System.Exit (ExitCode) import System.IO+import Utils (forkWait)  -- | Like 'System.Process.readProcessWithExitCode', but using 'Text' readProcessWithExitCode@@ -15,40 +16,33 @@     -> [String]                 -- ^ any arguments     -> Text                     -- ^ standard input     -> IO (ExitCode, Text, Text) -- ^ exitcode, stdout, stderr-readProcessWithExitCode cmd args input = do+readProcessWithExitCode cmd args input = mask $ \restore -> do     (Just inh, Just outh, Just errh, pid) <-         createProcess (proc cmd args){ std_in  = CreatePipe,                                        std_out = CreatePipe,                                        std_err = CreatePipe }-    outMVar <- newEmptyMVar-    outM <- newEmptyMVar-    errM <- newEmptyMVar+    flip onException+      (do hClose inh; hClose outh; hClose errh;+          terminateProcess pid; waitForProcess pid) $ restore $ do -    -- fork off a thread to start consuming stdout-    _ <- forkIO $ do-        out <- T.hGetContents outh-        putMVar outM out-        putMVar outMVar ()+      -- fork off a thread to start consuming stdout+      waitOut <- forkWait $ T.hGetContents outh -    -- fork off a thread to start consuming stderr-    _ <- forkIO $ do-        err  <- T.hGetContents errh-        putMVar errM err-        putMVar outMVar ()+      -- fork off a thread to start consuming stderr+      waitErr <- forkWait $ T.hGetContents errh -    -- now write and flush any input-    when (not (T.null input)) $ do T.hPutStr inh input; hFlush inh-    hClose inh -- done with stdin+      -- now write and flush any input+      unless (T.null input) $ do T.hPutStr inh input; hFlush inh+      hClose inh -- done with stdin -    -- wait on the output-    takeMVar outMVar-    takeMVar outMVar-    hClose outh-    hClose errh+      -- wait on the output+      out <- waitOut+      err <- waitErr -    -- wait on the process-    ex <- waitForProcess pid-    out <- readMVar outM-    err <- readMVar errM+      hClose outh+      hClose errh -    return (ex, out, err)+      -- wait on the process+      ex <- waitForProcess pid++      return (ex, out, err)
+ src/System/Process/Text/Lazy.hs view
@@ -0,0 +1,52 @@+module System.Process.Text.Lazy where++import Control.DeepSeq (rnf)+import Control.Exception+import qualified Control.Exception as C (evaluate)+import Control.Monad+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.IO as T+import System.Process+import System.Exit (ExitCode)+import System.IO+import Utils (forkWait)++-- | Like 'System.Process.readProcessWithExitCode', but using 'Text'+readProcessWithExitCode+    :: FilePath                  -- ^ command to run+    -> [String]                  -- ^ any arguments+    -> Text                      -- ^ standard input+    -> IO (ExitCode, Text, Text) -- ^ exitcode, stdout, stderr+readProcessWithExitCode cmd args input = mask $ \restore -> do+    (Just inh, Just outh, Just errh, pid) <-+        createProcess (proc cmd args){ std_in  = CreatePipe,+                                       std_out = CreatePipe,+                                       std_err = CreatePipe }+    flip onException+      (do hClose inh; hClose outh; hClose errh;+            terminateProcess pid; waitForProcess pid) $ restore $ do++      -- fork off a thread to start consuming stdout+      out <- T.hGetContents outh+      waitOut <- forkWait $ C.evaluate $ rnf out++      -- fork off a thread to start consuming stderr+      err <- T.hGetContents errh+      waitErr <- forkWait $ C.evaluate $ rnf err++      -- now write and flush any input+      unless (T.null input) $ do T.hPutStr inh input; hFlush inh+      hClose inh -- done with stdin++      -- wait on the output+      waitOut+      waitErr++      hClose outh+      hClose errh++      -- wait on the process+      ex <- waitForProcess pid++      return (ex, out, err)
+ src/Utils.hs view
@@ -0,0 +1,10 @@+module Utils where++import Control.Concurrent+import Control.Exception++forkWait :: IO a -> IO (IO a)+forkWait a = do+  res <- newEmptyMVar+  _ <- mask $ \restore -> forkIO $ try (restore a) >>= putMVar res+  return (takeMVar res >>= either (\ex -> throwIO (ex :: SomeException)) return)