Run

Run.hs

Copyright © 2008 Dave Bayer. Subject to a BSD-style license.

This module is part of the Annote project.

module Run (runCommand) where

Run provides the function runCommand, which forks threads to call runInteractiveCommand, waiting for the result and handling errors.


System.Process handles sub-processes. We import the following functions:

runInteractiveCommand :: String ->
    IO (Handle, Handle, Handle, ProcessHandle)
waitForProcess :: ProcessHandle -> IO ExitCode
import System.Process (runInteractiveCommand,waitForProcess)

Control.Concurrent provides concurrency abstractions. We import the following function:

forkIO :: IO () -> IO ThreadId
import Control.Concurrent (forkIO)

Control.Concurrent.MVar provides MVar synchronizing variables. We import the following functions:

newEmptyMVar :: IO (MVar a)
takeMVar :: MVar a -> IO a
putMVar :: MVar a -> a -> IO ()
import Control.Concurrent.MVar (newEmptyMVar,takeMVar,putMVar)

Control.Exception provides support for raising and catching exceptions. We import finally, which is a specialized version of bracket with just a computation to run afterward.

finally :: IO a -> IO b -> IO a
import Control.Exception (finally)

System.IO is the standard IO library. We import the following functions:

hGetContents :: Handle -> IO String
hPutStr :: Handle -> String -> IO ()
hPutStrLn :: Handle -> String -> IO ()
import System.IO (stderr,hGetContents,hPutStr,hPutStrLn)

System.Exit handles exiting the program. It defines ExitSuccess and ExitFailure.

import System.Exit (ExitCode(..))

runCommand

runCommand forks threads to call runInteractiveCommand, waiting for the result and handling errors.

Basic instructions on good form for doing this, using finally and an MVar synchronizing variable, are given in the Control-Concurrent library documentation. runCommand is also modeled after the examples

runCommand ::  String → String → Bool → IO (String,Bool)
runCommand cmd input silent = do
    (inp,out,err,pid) ← runInteractiveCommand cmd
    let get h = do
            mvar ← newEmptyMVar
            let put xs = seq (length xs) (putMVar mvar xs)
            forkIO $ finally (hGetContents h >>= put) (put [])
            takeMVar mvar            
    if null input then return () else hPutStr inp input
    output ← get out
    errmsg ← get err
    exit   ← waitForProcess pid
    case exit of
        ExitSuccess → return (output,True)
        ExitFailure _ → do
            if silent then return () else hPutStrLn stderr errmsg
            return (errmsg,False)