-- | This module offers a family of functions that provides behavior
-- similar to the Unix popen(3) command.  The simplest function is
-- 'popenStrict', which executes a command given your input and
-- returns its outputs as fully evaluated ("strict") strings.  The
-- 'popen' function is similar but returns the command's output as
-- lazily-generated strings.  With this version, it is up to you to
-- consume the strings and then reap the child process.  Finally,
-- 'popenRaw' gives you control over the raw I/O handles used to
-- communicate with the child process.  This version gives you
-- everything you need to control interactive programs, but you must
-- be careful to avoid deadlock situations.
--
-- As a rule of thumb, you should use 'popenStrict' unless you have
-- a good reason to do otherwise.


-- CVS: $Id: POpen.hs,v 1.8 2004/04/05 05:49:01 thor Exp $
--
-- Copyright (C) 2004 Thomas Moertel.
-- 
-- This program is free software; you can redistribute it and/or
-- modify it under the terms of the GNU General Public License
-- as published by the Free Software Foundation; either version 2
-- of the License, or (at your option) any later version.
-- 
-- The text of the GNU GPL may be found in the LICENSE file,
-- included with this software, or online at the following URL:
-- 
--     http://www.gnu.org/copyleft/gpl.html
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- 
-- Except as provided for under the terms of the GNU GPL, all rights
-- are reserved worldwide.
--

module POpen ( popenStrict, popen, popenRaw, exhaustString )
where


import Control.Concurrent
import Control.Monad
import Data.Maybe
import System.IO
import System.Posix.Directory
import System.Posix.IO
import System.Posix.Process
import System.Posix.Signals
import System.Posix.Types

-- | Executes a command with the given arguments within the (optional)
-- given environment, taking the (optional) given input.  The stdout
-- and stderr generated by the command, as well as the exit status (if
-- any) of the process that executed the command are returned.  If you
-- supply a working directory, the child process will "cd" into it
-- before executing the command.
--
-- If you want to read the outputs lazily and reap the child process
-- yourself, use 'popen' instead.  If you want control over the raw
-- I/O handles used by the child process, use 'popenRaw' instead.
--
-- Example:
--
-- @
-- main = do
--     (out, err, exitStatus) <- 
--         popenStrict "./echo" ["-n"] (Just "hi!") Nothing (Just "/usr/bin")
--     putStrLn $ "out = [" ++ out ++ "]"
--     putStrLn $ "err = [" ++ err ++ "]"
--     putStrLn $ "exitStatus = [" ++ show exitStatus ++ "]"
-- @

popenStrict
      :: FilePath                       -- ^ Command
      -> [String]                       -- ^ Arguments
      -> Maybe String                   -- ^ Input
      -> Maybe [(String,String)]        -- ^ Environment
      -> Maybe FilePath                 -- ^ Working directory
      -> IO (String, String,
             Maybe ProcessStatus)       -- ^ (stdout, stderr, exit code)

popenStrict cmd args input env cwd = do

    (out, err, pid) <- popen cmd args input env cwd

    sync <- newEmptyMVar
    forkIO $ foldr seq () out `seq` putMVar sync ()
    forkIO $ foldr seq () err `seq` putMVar sync ()
    takeMVar sync >> takeMVar sync

    exitCode <- getProcessStatus True False pid

    return (out, err, exitCode)


-- | Executes a command with the given arguments within the (optional)
--   given environment, taking the (optional) given input.  The stdout
--   and stderr generated by the command, as well as the process ID
--   of the process that is executing the command, are returned.
--   If you supply a working directory, the child process will
--   "cd" into it before executing the command.
--
--   As the caller, it is your responsibility to ensure that the
--   stdout and stderr strings, which are read lazily from the child
--   process, are completely consumed and *then* you must reap the
--   child process via getProcessStatus.  If you call getProcessStatus
--   before consuming the outputs, the call may block, and your
--   program may deadlock.  The helper function exhaustString may
--   help.  If you don't want to handle these responsibilities
--   yourself (which should almost always be the case), use
--   'popenStrict' instead.
--
--   Example:
--
-- @
--     main = do
--         (stdout, stderr, pid) <-
--             popen "./md5sum" [] (Just "hi!") Nothing (Just "/usr/bin")
--         putStr stdout          -- print stdout
--         exhaustString stderr   -- don't care about stderr
--         maybeExitCode <- getProcessStatus True False pid
-- @



popen :: FilePath                       -- ^ Command
      -> [String]                       -- ^ Arguments
      -> Maybe String                   -- ^ Input
      -> Maybe [(String,String)]        -- ^ Environment
      -> Maybe FilePath                 -- ^ Working directory
      -> IO (String, String, ProcessID) -- ^ (stdout, stderr, pid)

popen cmd args input env cwd = do

    (wInH, rOutH, rErrH, childPid) <- popenRaw cmd args env cwd

    case input of
        Nothing -> hClose wInH
        Just s  -> do forkIO $ hPutStr wInH s >> hClose wInH
                      return ()

    stdoutStr <- hGetContents rOutH
    stderrStr <- hGetContents rErrH

    return (stdoutStr, stderrStr, childPid)


-- | Executes a command with the given arguments within the (optional)
--   given environment.  The command executes within a new child
--   process.  If you supply a working directory, the child process will
--   "cd" into it before executing the command.
--
--   The return value is a 4-tuple comprising the stdin, stdout, and
--   stderr (as IO handles) and the pid of the child process.  You may
--   control I/O to the process by reading and writing from these 
--   handles, but be careful to avoid deadlock.  Unless you really
--   want this degree of low-level control, you should probably use
--   the plain 'popen' call or, more likely, 'popenStrict'.
--
--  
--   Example:
--
-- @
-- main = do
--     (wInH, rOutH, rErrH, childPid) <- popenRaw "cat" [] Nothing Nothing
--     mapM_ (flip hSetBuffering LineBuffering) [wInH, rOutH]
--     hPutStrLn wInH "Line one"  -- write line to child's stdin
--     out1 <- hGetLine rOutH     -- read same line from child's stdout
--     putStrLn out1              -- print it to screen
--     hPutStrLn wInH "Line two"  -- and again . . .
--     out2 <- hGetLine rOutH
--     putStrLn out2
--     hClose wInH
--     maybeExitCode <- getProcessStatus True False childPid
--     print maybeExitCode
-- @


popenRaw
      :: FilePath                       -- ^ Command
      -> [String]                       -- ^ Arguments
      -> Maybe [(String,String)]        -- ^ Environment
      -> Maybe FilePath                 -- ^ Working directory
      -> IO (Handle, Handle, Handle, ProcessID) -- ^ (stdin, stdout, stderr, pid)

popenRaw cmd args env cwd = do

    (rInFd,  wInFd ) <- createPipe
    (rOutFd, wOutFd) <- createPipe
    (rErrFd, wErrFd) <- createPipe

    childPid <- forkProcess (do mapM_ closeFd [wInFd, rOutFd, rErrFd]
                                spawn rInFd wOutFd wErrFd)

    mapM_ closeFd [rInFd, wOutFd, wErrFd]

    wInH  <- fdToHandle wInFd
    rOutH <- fdToHandle rOutFd
    rErrH <- fdToHandle rErrFd

    return (wInH, rOutH, rErrH, childPid)

    where

    spawn myStdin myStdout myStderr = do
        maybe (return ()) changeWorkingDirectory cwd
        zipWithM_ moveFd [myStdin, myStdout, myStderr] [0,1,2]
        executeFile cmd True args env

    moveFd from to = when (from /= to) (dupTo from to >> closeFd from)


-- | Ensures that a lazily-generated string has been completely
--   consumed ("exhausted").

exhaustString :: String -> IO ()
exhaustString s = appendFile "/dev/null" s