[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
John Goerzen
jgoerzen at complete.org
Fri Apr 23 14:57:15 UTC 2010
The following commit has been merged in the master branch:
commit 68db46d663cc47a414817e67ff7f049671a271b3
Author: John Goerzen <jgoerzen at complete.org>
Date: Sun Apr 17 11:06:34 2005 +0100
Added more pipe utiilties to Cmd.hs
diff --git a/MissingH/Cmd.hs b/MissingH/Cmd.hs
index 27b1338..6469e34 100644
--- a/MissingH/Cmd.hs
+++ b/MissingH/Cmd.hs
@@ -36,6 +36,9 @@ module MissingH.Cmd(-- * High-Level Tools
safeSystem,
forceSuccess,
pipeFrom,
+ pipeLinesFrom,
+ pipeTo,
+ pipeBoth,
-- * Low-Level Tools
PipeMode(..),
pOpen, pOpen3)
@@ -52,6 +55,8 @@ import System.Posix.IO
import System.Posix.Process
import System.Posix.Types
import System.IO
+import Control.Concurrent(forkIO)
+import Control.Exception(finally)
import qualified System.Posix.Signals
@@ -78,9 +83,16 @@ See also: 'MissingH.Logging.Logger.updateGlobalLogger',
-}
+{- | Like 'pipeFrom', but returns data in lines instead of just a String.
+Shortcut for calling lines on the result from 'pipeFrom'. -}
+pipeLinesFrom :: FilePath -> [String] -> IO (ProcessID, [String])
+pipeLinesFrom fp args =
+ do (pid, c) <- pipeFrom fp args
+ return $ (pid, lines c)
+
{- | Read data from a pipe. Returns a lazy string and a ProcessID.
-ONLY AFTER the string has been read completely, you must call either
+ONLY AFTER the string has been read completely, You must call either
'System.Posix.Process.getProcessStatus' or 'forceSuccess' on the ProcessID.
Zombies will result otherwise.
-}
@@ -101,6 +113,58 @@ pipeFrom fp args =
c <- hGetContents h
return (pid, c)
+{- | Write data to a pipe. Returns a ProcessID.
+
+You must call either
+'System.Posix.Process.getProcessStatus' or 'forceSuccess' on the ProcessID.
+Zombies will result otherwise.
+-}
+pipeTo :: FilePath -> [String] -> String -> IO ProcessID
+pipeTo fp args message =
+ do pipepair <- createPipe
+ debugM (logbase ++ ".pipeto")
+ ("Running: " ++ fp ++ " " ++ show args)
+ let childstuff = do dupTo (fst pipepair) stdInput
+ executeFile fp True args Nothing
+ p <- try (forkProcess childstuff)
+ -- parent
+ pid <- case p of
+ Right x -> return x
+ Left e -> fail $ "Error in fork: " ++ show e
+ closeFd (fst pipepair)
+ h <- fdToHandle (snd pipepair)
+ finally (hPutStr h message)
+ (hClose h)
+ return pid
+
+{- | Like a combination of 'pipeTo' and 'pipeFrom'; forks an IO thread
+to send data to the piped program, and simultaneously returns its output
+stream.
+
+The same caveat about checking the return status applies here as with 'pipeFrom'. -}
+pipeBoth :: FilePath -> [String] -> String -> IO (ProcessID, String)
+pipeBoth fp args message =
+ do frompair <- createPipe
+ topair <- createPipe
+ debugM (logbase ++ ".pipeBoth")
+ ("Running: " ++ fp ++ " " ++ show args)
+ let childstuff = do dupTo (snd frompair) stdOutput
+ dupTo (fst topair) stdInput
+ executeFile fp True args Nothing
+ p <- try (forkProcess childstuff)
+ -- parent
+ pid <- case p of
+ Right x -> return x
+ Left e -> fail $ "Error in fork: " ++ show e
+ closeFd (snd frompair)
+ closeFd (fst topair)
+ fromh <- fdToHandle (fst frompair)
+ toh <- fdToHandle (snd topair)
+ forkIO $ finally (hPutStr toh message)
+ (hClose toh)
+ c <- hGetContents fromh
+ return (pid, c)
+
{- | Uses 'System.Posix.Process.getProcessStatus' to obtain the exit status
of the given process ID. If the process terminated normally, does nothing.
Otherwise, raises an exception with an appropriate error message. If error
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list