% -----------------------------------------------------------------------------
% $Id: SystemExts.lhs,v 1.7 2002/04/12 03:55:53 sof Exp $
%
% (c) The GHC Team, 2001
%

Systemy extensions.

\begin{code}
{-# OPTIONS -#include "HsLang.h" #-}
module SystemExts
	( rawSystem,     -- :: String -> IO ExitCode

	, withArgs       -- :: [String] -> IO a -> IO a
	, withProgName   -- :: String -> IO a -> IO a
	
	, getEnvironment -- :: IO [(String, String)]
	
	) where

import Foreign.C
import Foreign

import System.Environment
import Control.Exception as Exception
import Foreign.Ptr
import Control.Monad

import GHC.IOBase
\end{code}

rawSystem

The same as system, but bypasses the shell.

\begin{code}
rawSystem :: String -> IO ExitCode
rawSystem "" = ioException (IOError Nothing InvalidArgument "rawSystem" "null command" Nothing)
rawSystem cmd =
  withCString cmd $ \s -> do
    status <- throwErrnoIfMinus1 "rawSystem" (primRawSystem s)
    case status of
        0  -> return ExitSuccess
        n  -> return (ExitFailure n)

foreign import ccall "rawSystemCmd" unsafe primRawSystem :: CString -> IO Int
\end{code}

@withArgs args act@ - while executing action @act@, have @System.getArgs@
return @args@.

@withProgName name act@ - while executing action @act@, have @System.getProgName@
return @name@.

When either of these actions return, the values of @getArgs@ / @getProgName@
are restored.

\begin{code}
withArgs xs act = do
   p <- System.Environment.getProgName
   withArgv (p:xs) act

withProgName nm act = do
   xs <- System.Environment.getArgs
   withArgv (nm:xs) act
\end{code}

Worker routine which marshals and replaces an argv vector for
the duration of an action.

\begin{code}
withArgv new_args act = do
  pName <- System.Environment.getProgName
  existing_args <- System.Environment.getArgs
  bracket (setArgs new_args) 
	  (\argv -> do setArgs (pName:existing_args); freeArgv argv)
  	  (const act)

freeArgv :: Ptr CString -> IO ()
freeArgv argv = do
  size <- lengthArray0 nullPtr argv
  sequence_ [peek (argv `advancePtr` i) >>= free | i <- [size, size-1 .. 0]]
  free argv

setArgs :: [String] -> IO (Ptr CString)
setArgs argv = do
  vs <- mapM newCString argv >>= newArray0 nullPtr
  setArgsPrim (length argv) vs
  return vs

foreign import "setProgArgv" setArgsPrim :: Int -> Ptr CString -> IO ()
\end{code}

Get at the environment block -- also provided by Posix.

\begin{code}
getEnvironment :: IO [(String, String)]
getEnvironment = do
   pBlock <- getEnvBlock
   if pBlock == nullPtr then return []
    else do
      stuff <- peekArray0 nullPtr pBlock >>= mapM peekCString
      return (map divvy stuff)
  where
   divvy str = 
      case break (=='=') str of
        (xs,[])        -> (xs,[]) -- don't barf (like Posix.getEnvironment)
	(name,_:value) -> (name,value)

foreign import "getEnvBlock" getEnvBlock :: IO (Ptr CString)
\end{code}
