-----------------------------------------------------------------------------
-- 
-- Module      :  POpen
-- Copyright   :  (c) The University of Glasgow 2002
--  		  (c) 2001-2002 Jens-Ulrik Holger Petersen
-- License     :  BSD-style
-- 
-- Maintainer  :  petersen@haskell.org
-- Stability   :  experimental
-- Portability :  non-portable (requires POSIX support from the OS)
--
-- $Id: POpen.hs,v 1.1 2002/03/19 11:38:37 simonmar Exp $
--
-- Convenient string input to and output from a subprocess
--
-----------------------------------------------------------------------------
--
-- Description
--
-- POpen provides a convenient way of sending string input to a
-- subprocess and reading output from it lazily.
-- 
-- It provides two functions popen and popenEnvDir.
-- 
-- * popen gives lazy output and error streams from a
--   subprocess command, and optionally can direct input from a
--   string to the process.
-- 
-- * popenEnvDir in addition lets one specify the environment
--   and directory in which to run the subprocess command.
--
-- This code is originally based on Posix.runProcess, but it
-- uses file descriptors and pipes internally instead of
-- handles and returns the output and error streams lazily as
-- strings and also the pid of forked process.

module POpen (popen, popenEnvDir)
where

import PosixFiles (stdInput, stdOutput, stdError)
import PosixIO (createPipe, dupTo, fdClose, fdToHandle)
import PosixProcPrim (executeFile, forkProcess)
import PosixUtil (Fd, ProcessID)

import Directory
import IO (hGetContents, hPutStr, hClose)
import Maybe (fromJust, isJust)
import Monad (when)

popen :: FilePath			-- Command
      -> [String]			-- Arguments
      -> Maybe String			-- Input
      -> IO (String, String, ProcessID)	-- (stdout, stderr, pid)
popen path args inpt =
    popenEnvDir path args inpt Nothing Nothing

popenEnvDir :: FilePath				-- Command
	    -> [String]				-- Arguments
	    -> Maybe String			-- Input
	    -> Maybe [(String, String)]		-- Environment
	    -> Maybe FilePath 			-- Working directory    
	    -> IO (String, String, ProcessID)	-- (stdout, stderr, pid)
popenEnvDir path args inpt env dir =
    do
    inr <- if (isJust inpt)
	   then
	       do
	       (inr', inw) <- createPipe
	       hin <- fdToHandle inw
	       hPutStr hin $ fromJust inpt
	       hClose hin
	       return $ Just inr'
	   else
	       return Nothing
    (outr, outw) <- createPipe
    (errr, errw) <- createPipe
    pid <- forkProcess
    case pid of
	Nothing -> doTheBusiness inr outw errw
	Just p -> do
	  -- close other end of pipes in here
	  when (isJust inr) $
	       fdClose $ fromJust inr
	  fdClose outw
	  fdClose errw
	  hout <- fdToHandle outr
	  outstrm <- hGetContents hout
	  herr <- fdToHandle errr
	  errstrm <- hGetContents herr
	  return (outstrm, errstrm , p)
    where
    doTheBusiness :: 
	Maybe Fd	    -- stdin
	-> Fd		    -- stdout
	-> Fd		    -- stderr
        -> IO (String, String, ProcessID)    -- (stdout, stderr)
    doTheBusiness inr outw errw = 
	do
	maybeChangeWorkingDirectory dir
	when (isJust inr) $
	     dupTo (fromJust inr) stdInput
	dupTo outw stdOutput
	dupTo errw stdError
	executeFile path True args env
	-- for typing, should never actually run
	error "executeFile failed!"

maybeChangeWorkingDirectory :: Maybe FilePath -> IO ()
maybeChangeWorkingDirectory dir =
    case dir of
	     Nothing -> return ()
	     Just x  -> setCurrentDirectory x
