runExternal utility for piped process io.

1 files changed, 48 insertions, 1 deletions

diff --git a/lib/ProcessUtils.hs b/lib/ProcessUtils.hs
index a6902be..492d666 100644
--- a/lib/ProcessUtils.hs
+++ b/lib/ProcessUtils.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 module ProcessUtils
     ( ExitCode(ExitFailure,ExitSuccess)
     , systemEnv
@@ -7,16 +8,19 @@ module ProcessUtils
     ) where
 
 import GHC.IO.Exception ( ioException, IOErrorType(..) )
+import System.FilePath
+import System.Directory
 import System.Process
 import System.Posix.Signals
 import System.Process.Internals (runGenProcess_,defaultSignal)
 import System.Environment
-import Data.Maybe ( isNothing )
+import Data.Maybe ( isNothing, fromMaybe )
 import System.IO.Error ( mkIOError, ioeSetErrorString ) 
 import System.Exit ( ExitCode(..) )
 import System.IO
 import Control.Applicative
 import Control.Exception (bracket)
+import qualified Data.ByteString as S
 
 
 -- | systemEnv
@@ -102,3 +106,46 @@ readProcessWithErrorH cmd args stdin erH = do
                 hPutStr sinh stdin
                 hClose sinh
                 hGetContents sout                )
+
+-- | run an external command.
+--
+-- Arguments:
+--
+--   [ cmd ]   command to run
+--
+--   [ input ] input to command (if any)
+--
+-- Returns:
+--
+--   [ code ]   exit code returned by command
+--
+--   [ output ] captured stdout of command
+--
+--   [ err ]    captured stderr of command
+runExternal :: String -> Maybe String -> IO (Int,(S.ByteString,S.ByteString))
+runExternal cmd input = do
+    cwd <- getCurrentDirectory
+    putStr $ takeFileName cwd ++ "> " ++ cmd
+                    ++ case input of
+                            Nothing -> "\n"
+                            Just s  -> " <<EOF\n" ++ s ++ "EOF\n"
+    let p = (shell cmd) { std_in  = maybe Inherit (const CreatePipe) input
+                        , std_out = CreatePipe
+                        , std_err = CreatePipe }
+    (mb_in,mb_out,mb_err,process) <- createProcess p
+    case mb_in of
+        Nothing -> return ()
+        Just hin -> hPutStr hin (fromMaybe "" input) >> hClose hin
+    out <- case mb_out of
+            Just hout -> S.hGetContents hout
+            Nothing   -> return ""
+    err <- case mb_err of
+            Just herr -> S.hGetContents herr
+            Nothing   -> return ""
+    code <- do
+        c <- waitForProcess process
+        return $ case c of
+                    ExitSuccess   -> 0
+                    ExitFailure x -> x
+    return (code,(out,err))
+