nptools-0.1: loopback.hs

import qualified Data.ByteString.Lazy.Char8 as L
import System.IO
import System.Environment
import System.Process
import System.Exit

me :: String
me = "loopback"

loopBack :: CreateProcess -> IO ProcessHandle
loopBack prc = do
  (Just inp,Just out,_,pid) <- createProcess prc{std_in=CreatePipe,std_out=CreatePipe}
  hSetBuffering inp LineBuffering
  mapM_ (hPutLnF inp) . L.split '\n' =<< L.hGetContents out
  return pid
  where hPutLnF h x = L.hPut h x >> hPutChar h '\n'

usage :: String -> IO a
usage msg = hPutStr stderr (unlines ls) >> exitFailure
  where ls = [msg
             ,"Usage: "++me++" <shell-command>"
             ,"       "++me++" <executable-path> <argument> <arguments>*"]

main :: IO ()
main = do args  <- getArgs
          prc   <- case args of
                     [arg]      -> return $ shell arg
                     exe:args'  -> return $ proc exe args'
                     []         -> usage "Not enough arguments"
          exitWith =<< waitForProcess =<< loopBack prc