--  popen-like library
--
--  Author : Jens-Ulrik Petersen
--  Created: 16 August 2001
--
--  Version:  $Revision: 1.2 $ from $Date: 2003/09/25 15:03:27 $
--
--  Copyright (c) 2001 Jens-Ulrik Holger Petersen
--  (c) The GRASP/AQUA Project, Glasgow University, 1995-1996
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 of the License, or (at your option) any later version.
--
--  This library 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
--  Library General Public License for more details.
--
-- Description
--

-- This code is based on runProcess from the hslibs posix
-- library, but internally it uses file descriptors instead
-- of handles and returns the output and error streams
-- lazily as strings as well as the pid of forked process,
-- instead of just IO ().

module POpen (popen, popenEnvDir)
where

-- import Posix
import Directory
import IO (isEOFError, hGetContents, Handle, hPutStr, hClose)
import Maybe (fromJust, isJust)
import Monad (when)

--  Replace definitions from Posix
type ProcessID = Int
type Fd = Int
stdInput  = 0::Int
stdOutput = 1::Int
stdError  = 2::Int
dupTo :: Fd -> Fd -> IO ()
dupTo fr to = return ()
executeFile :: FilePath                         -- Command
              -> Bool                           -- ??
              -> [String]                       -- Arguments
              -> Maybe [(String, String)]       -- Environment
              -> IO ()
executeFile path flag args env = return ()
createPipe :: IO (Fd,Fd)
createPipe = return (99,99)
fdToHandle :: Fd -> IO Handle
fdToHandle fd = error "No fdToHandle"
forkProcess :: IO ( Maybe ProcessID )
forkProcess = return Nothing
fdClose :: Fd -> IO ()
fdClose fd = return ()
--

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
                                                -- (stdin, stdout, stderr, pid)
              -> IO (String, String, ProcessID)
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) $
             do
             dupTo (fromJust inr) stdInput
             return ()
        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