70 lines
1.8 KiB
Haskell
70 lines
1.8 KiB
Haskell
module RunCommand (runCommandStrWait) where
|
|
import System.Process
|
|
import System.Exit
|
|
import System.IO
|
|
import Control.Concurrent
|
|
import Control.Concurrent.Chan
|
|
import Data.Either
|
|
|
|
type Pipe = Chan (Either Char ())
|
|
|
|
pipeGetContents :: Pipe -> IO String
|
|
pipeGetContents p =
|
|
do
|
|
s <- getChanContents p
|
|
return $ map fromLeft $ takeWhile isLeft s
|
|
|
|
pipeWrite :: Pipe -> String -> IO ()
|
|
pipeWrite p s = writeList2Chan p (map Left s)
|
|
|
|
-- close the pipe for writing
|
|
pipeClose :: Pipe -> IO ()
|
|
pipeClose p = writeChan p (Right ())
|
|
|
|
|
|
--
|
|
-- * Either utilities
|
|
--
|
|
|
|
isLeft :: Either a b -> Bool
|
|
isLeft = either (const True) (const False)
|
|
|
|
fromLeft :: Either a b -> a
|
|
fromLeft = either id (error "fromLeft: Right")
|
|
|
|
--
|
|
-- * Various versions of runCommand
|
|
--
|
|
|
|
runCommandChan :: String -- ^ command
|
|
-> IO (Pipe,Pipe,Pipe,ProcessHandle) -- ^ stdin, stdout, stderr, process
|
|
runCommandChan c =
|
|
do
|
|
inC <- newChan
|
|
outC <- newChan
|
|
errC <- newChan
|
|
(pin,pout,perr,p) <- runInteractiveCommand c
|
|
forkIO (pipeGetContents inC >>= hPutStr pin >> hClose pin)
|
|
forkIO (hGetContents pout >>= pipeWrite outC >> pipeClose outC)
|
|
forkIO (hGetContents perr >>= pipeWrite errC >> pipeClose errC)
|
|
return (inC,outC,errC,p)
|
|
|
|
runCommandStr :: String -- ^ command
|
|
-> String -- ^ stdin data
|
|
-> IO (String,String,ProcessHandle) -- ^ stdout, stderr, process
|
|
runCommandStr c inStr =
|
|
do
|
|
(inC,outC,errC,p) <- runCommandChan c
|
|
forkIO (pipeWrite inC inStr >> pipeClose inC)
|
|
out <- pipeGetContents outC
|
|
err <- pipeGetContents errC
|
|
return (out,err,p)
|
|
|
|
runCommandStrWait :: String -- ^ command
|
|
-> String -- ^ stdin data
|
|
-> IO (String,String,ExitCode) -- ^ stdout, stderr, process exit status
|
|
runCommandStrWait c inStr =
|
|
do
|
|
(out,err,p) <- runCommandStr c inStr
|
|
s <- waitForProcess p
|
|
return (out,err,s)
|