{-# OPTIONS -cpp -fglasgow-exts #-}
module RawSystem (rawSystem) where

#include "config.h"

import Foreign
import Foreign.C
import System.Exit

{- | 
The same as 'system', but bypasses the shell (GHC only).
Will behave more portably between systems,
because there is no interpretation of shell metasyntax.
-}

rawSystem :: FilePath -> [String] -> IO ExitCode

#ifndef mingw32_TARGET_OS

rawSystem cmd args =
  withCString cmd $ \pcmd ->
    withMany withCString (cmd:args) $ \cstrs ->
      withArray0 nullPtr cstrs $ \arr -> do
	status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmd arr)
        case status of
            0  -> return ExitSuccess
            n  -> return (ExitFailure n)

#if __GLASGOW_HASKELL__ >= 602
foreign import ccall unsafe "rawSystem"
  c_rawSystem :: CString -> Ptr CString -> IO Int
#else
#error "Doesn't work with GHC < 6.2 on Unix"
#endif

#else

-- On Windows, the command line is passed to the operating system as
-- a single string.  Command-line parsing is done by the executable
-- itself.
rawSystem cmd args = do
	-- NOTE: 'cmd' is assumed to contain the application to run _only_,
	-- as it'll be quoted surrounded in quotes here.
  let cmdline = translate cmd ++ concat (map ((' ':) . translate) args)
  withCString cmdline $ \pcmdline -> do
    status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmdline)
    case status of
       0  -> return ExitSuccess
       n  -> return (ExitFailure n)

translate :: String -> String
translate str@('"':_) = str -- already escaped.
	-- ToDo: this case is wrong.  It is only here because we
	-- abuse the system in GHC's SysTools by putting arguments into
	-- the command name; at some point we should fix it up and remove
	-- the case above.
translate str = '"' : snd (foldr escape (True,"\"") str)
  where escape '"'  (b,     str) = (True,  '\\' : '"'  : str)
        escape '\\' (True,  str) = (True,  '\\' : '\\' : str)
        escape '\\' (False, str) = (False, '\\' : str)
	escape c    (b,     str) = (False, c : str)
	-- This function attempts to invert the Microsoft C runtime's
	-- quoting rules, which can be found here:
	--     http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp
	-- (if this URL stops working, you might be able to find it by
	-- searching for "Parsing C Command-Line Arguments" on MSDN).
	--
	-- The Bool passed back along the string is True iff the
	-- rest of the string is a sequence of backslashes followed by
	-- a double quote.

#if __GLASGOW_HASKELL__ >= 602
foreign import ccall unsafe "rawSystem"
  c_rawSystem :: CString -> IO Int
#else
foreign import ccall unsafe "rawSystemCmd"
  c_rawSystem :: CString -> IO Int
#endif

#endif