{-# LANGUAGE CPP,ScopedTypeVariables #-}
-- 
-- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 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
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
--

-- stolen from Yi

--
-- | A Posix.popen compatibility mapping.
-- Based on PosixCompat, originally written by Derek Elkins for lambdabot
--
module Test.Framework.Process ( popen, popenShell ) where

import System.IO
import System.Process
import System.Exit
import Control.Concurrent       (forkIO)
import qualified Control.Exception

-- | Run a command using the shell.
popenShell :: String        -- ^ Command
           -> Maybe String  -- ^ Content of stdin
           -> IO (String,String,ExitCode)  -- ^ (stdout, stderr, exit code)
popenShell :: String -> Maybe String -> IO (String, String, ExitCode)
popenShell String
cmd = IO (Handle, Handle, Handle, ProcessHandle)
-> Maybe String -> IO (String, String, ExitCode)
popen' (IO (Handle, Handle, Handle, ProcessHandle)
 -> Maybe String -> IO (String, String, ExitCode))
-> IO (Handle, Handle, Handle, ProcessHandle)
-> Maybe String
-> IO (String, String, ExitCode)
forall a b. (a -> b) -> a -> b
$ String -> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveCommand String
cmd

-- | Run a command.
popen :: FilePath         -- ^ Binary
      -> [String]         -- ^ Arguments
      -> Maybe String     -- ^ Content of stdin
      -> IO (String,String,ExitCode)  -- ^ (stdout, stderr, exit code)
popen :: String -> [String] -> Maybe String -> IO (String, String, ExitCode)
popen String
file [String]
args =
    IO (Handle, Handle, Handle, ProcessHandle)
-> Maybe String -> IO (String, String, ExitCode)
popen' (IO (Handle, Handle, Handle, ProcessHandle)
 -> Maybe String -> IO (String, String, ExitCode))
-> IO (Handle, Handle, Handle, ProcessHandle)
-> Maybe String
-> IO (String, String, ExitCode)
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess String
file [String]
args Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing

popen' :: IO (Handle, Handle, Handle, ProcessHandle)
       -> Maybe String
       -> IO (String,String,ExitCode)
popen' :: IO (Handle, Handle, Handle, ProcessHandle)
-> Maybe String -> IO (String, String, ExitCode)
popen' IO (Handle, Handle, Handle, ProcessHandle)
run Maybe String
minput =
    (SomeException -> IO (String, String, ExitCode))
-> IO (String, String, ExitCode) -> IO (String, String, ExitCode)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Control.Exception.handle (\ (SomeException
e :: Control.Exception.SomeException) ->
                                (String, String, ExitCode) -> IO (String, String, ExitCode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],SomeException -> String
forall a. Show a => a -> String
show SomeException
e,String -> ExitCode
forall a. HasCallStack => String -> a
error (SomeException -> String
forall a. Show a => a -> String
show SomeException
e))) (IO (String, String, ExitCode) -> IO (String, String, ExitCode))
-> IO (String, String, ExitCode) -> IO (String, String, ExitCode)
forall a b. (a -> b) -> a -> b
$ do

    (Handle
inp,Handle
out,Handle
err,ProcessHandle
pid) <- IO (Handle, Handle, Handle, ProcessHandle)
run

    case Maybe String
minput of
        Just String
input -> Handle -> String -> IO ()
hPutStr Handle
inp String
input IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
inp -- importante!
        Maybe String
Nothing    -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    -- Now, grab the input
    String
output <- Handle -> IO String
hGetContents Handle
out
    String
errput <- Handle -> IO String
hGetContents Handle
err

    -- SimonM sez:
    --  ... avoids blocking the main thread, but ensures that all the
    --  data gets pulled as it becomes available. you have to force the
    --  output strings before waiting for the process to terminate.
    --
    ThreadId
_ <- IO () -> IO ThreadId
forkIO (Int -> IO Int
forall a. a -> IO a
Control.Exception.evaluate (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
output) IO Int -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    ThreadId
_ <- IO () -> IO ThreadId
forkIO (Int -> IO Int
forall a. a -> IO a
Control.Exception.evaluate (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
errput) IO Int -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

    -- And now we wait. We must wait after we read, unsurprisingly.
    ExitCode
ecode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pid -- blocks without -threaded, you're warned.

    -- so what's the point of returning the pid then?
    (String, String, ExitCode) -> IO (String, String, ExitCode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
output,String
errput,ExitCode
ecode)