Haskell Shell Processing

shell.hs

module Command (
  execCommand
) where

import Control.Error
import Control.Monad
import Control.Monad.Trans 
import System.IO
import System.Process
import System.Exit

createCommand :: CmdSpec -> FilePath -> CreateProcess
createCommand (ShellCommand command) curDir =
  (shell command){std_out = CreatePipe, std_err = CreatePipe, cwd = Just curDir}
createCommand (RawCommand command arguments) curDir =
  (proc command arguments){std_out = CreatePipe, std_err = CreatePipe, cwd = Just curDir}

execCommand :: CmdSpec -> FilePath -> IO (Either String Bool)
execCommand command curDir = do
  (_, Just hout, Just herr, procHandle) <- createProcess $ createCommand command curDir
  exitCode <- waitForProcess procHandle
  stdOut   <- hGetContents hout
  stdErr   <- hGetContents herr
  if exitCode /= ExitSuccess
     then return $ Left  $ concat [stdOut, stdErr]
     else return $ Right True 

--runCommands :: [Text] -> FilePath -> 
runCommands cmds curDir = do
  result <- runEitherT $ forM cmds $ \cmd -> do
    execResult <- execCommand cmd curDir
    case execResult of
      Left execErr  -> return $ Left execErr
      Right success -> return $ Right ()
  case result of
    Left err      -> return $ Left err
    Right success -> return ()

execCommand (ShellCommand command) cwd = do
  let f act = do
     (_, Just hout, Just herr, procHandle) <- createProcess act {std_out = CreatePipe, std_err = CreatePipe, cwd = Just cwd}
    exitCode <- waitForProcess procHandle
    stdout <- hGetContents hout
    stderr <- hGetContents herr
    return (exitCode, stdout, stderr)
  f (shell command)
  f (proc command args)