{-# LANGUAGE CPP #-}
--
-- | A Posix.popen compatibility mapping.
--
-- If we use this, we should build -threaded
--
module System.Plugins.Process (exec, popen) where

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

import qualified Control.Exception as E

--
-- slight wrapper over popen for calls that don't care about stdin to the program
--
exec :: String -> [String] -> IO ([String],[String],Bool)
exec f as = do
        (a,b,c,_) <- popen f as (Just [])
        return (lines a, lines b,c)

type ProcessID = ProcessHandle

--
-- Ignoring exit status for now.
--
-- XXX there are still issues. Large amounts of output can cause what
-- seems to be a dead lock on the pipe write from runplugs, for example.
-- Posix.popen doesn't have this problem, so maybe we can reproduce its
-- pipe handling somehow.
--
popen :: FilePath -> [String] -> Maybe String -> IO (String,String,Bool,ProcessID)
popen file args minput =
    E.handle (\e -> return ([],show (e::E.IOException), False, error (show e))) $ do

    (inp,out,err,pid) <- runInteractiveProcess file args Nothing Nothing

    case minput of
        Just input -> hPutStr inp input >> hClose inp -- importante!
        Nothing    -> return ()

    -- Now, grab the input
    output <- hGetContents out
    errput <- hGetContents 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.
    --
    _ <- forkIO (E.evaluate (length output) >> return ())
    _ <- forkIO (E.evaluate (length errput) >> return ())

    -- And now we wait. We must wait after we read, unsurprisingly.
    exitCode <- waitForProcess pid -- blocks without -threaded, you're warned.
    case exitCode of
      ExitFailure code
          | null errput -> let errMsg = file ++ ": failed with error code " ++ show code
                           in return ([],errMsg,False,error errMsg)
          | otherwise -> return ([],errput,False,error errput)
      _ -> return (output,errput,True,pid)