diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2012 David Lazar + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,9 @@ +# About + +Extra functionality for the [Process library](http://hackage.haskell.org/package/process). + +# Contributing + +This project is available on [GitHub](https://github.com/davidlazar/process-extras) and [Bitbucket](https://bitbucket.org/davidlazar/process-extras/). You may contribute changes using either. + +Please report bugs and feature requests using the [GitHub issue tracker](https://github.com/davidlazar/process-extras/issues). diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/process-extras.cabal b/process-extras.cabal new file mode 100644 --- /dev/null +++ b/process-extras.cabal @@ -0,0 +1,26 @@ +Name: process-extras +Version: 0.1.0 +Synopsis: Process extras +Description: Extra functionality for the Process library + . +Homepage: https://github.com/davidlazar/process-extras +License: MIT +License-file: LICENSE +Author: David Lazar +Maintainer: David Lazar +Category: System +Build-type: Simple +Cabal-version: >=1.6 +Extra-source-files: + README.md + +source-repository head + Type: git + Location: https://github.com/davidlazar/process-extras + +Library + Hs-source-dirs: src + Exposed-modules: + System.Process.ByteString + System.Process.Text + Build-depends: base >= 4 && < 5, process, bytestring, text diff --git a/src/System/Process/ByteString.hs b/src/System/Process/ByteString.hs new file mode 100644 --- /dev/null +++ b/src/System/Process/ByteString.hs @@ -0,0 +1,52 @@ +module System.Process.ByteString where + +import Control.Concurrent +import Control.Monad +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import System.Process +import System.Exit (ExitCode) +import System.IO + +-- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString' +readProcessWithExitCode + :: FilePath -- ^ command to run + -> [String] -- ^ any arguments + -> ByteString -- ^ standard input + -> IO (ExitCode, ByteString, ByteString) -- ^ exitcode, stdout, stderr +readProcessWithExitCode cmd args input = 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 + + -- 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 stderr + forkIO $ do + err <- B.hGetContents errh + putMVar errM err + putMVar outMVar () + + -- now write and flush any input + when (not (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 + + -- wait on the process + ex <- waitForProcess pid + out <- readMVar outM + err <- readMVar errM + + return (ex, out, err) diff --git a/src/System/Process/Text.hs b/src/System/Process/Text.hs new file mode 100644 --- /dev/null +++ b/src/System/Process/Text.hs @@ -0,0 +1,53 @@ +module System.Process.Text where + +import Control.Concurrent +import Control.Monad +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import System.Process +import System.Exit (ExitCode) +import System.IO + +-- | 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 = 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 + + -- 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 stderr + forkIO $ do + err <- T.hGetContents errh + putMVar errM err + putMVar outMVar () + + -- now write and flush any input + when (not (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 + + -- wait on the process + ex <- waitForProcess pid + out <- readMVar outM + err <- readMVar errM + + return (ex, out, err)