ghc/lib/std/System.lhs

   1 -- -----------------------------------------------------------------------------
   2 -- $Id: System.lhs,v 1.33 2001/08/14 17:14:22 sof Exp $
   3 --
   4 -- (c) The University of Glasgow, 1994-2000
   5 --
   6
   7 \begin{code}
   8 module System
   9     (
  10       ExitCode(ExitSuccess,ExitFailure)
  11     , getArgs       -- :: IO [String]
  12     , getProgName   -- :: IO String
  13     , getEnv        -- :: String -> IO String
  14     , system        -- :: String -> IO ExitCode
  15     , exitWith      -- :: ExitCode -> IO a
  16     , exitFailure   -- :: IO a
  17   ) where
  18
  19 import Monad
  20 import Prelude
  21 import PrelCError
  22 import PrelCString
  23 import PrelCTypes
  24 import PrelMarshalArray
  25 import PrelMarshalAlloc
  26 import PrelPtr
  27 import PrelStorable
  28 import PrelIOBase
  29 import PrelConc
  30
  31 -- ---------------------------------------------------------------------------
  32 -- getArgs, getProgName, getEnv
  33
  34 -- Computation `getArgs' returns a list of the program's command
  35 -- line arguments (not including the program name).
  36
  37 getArgs :: IO [String]
  38 getArgs =
  39   alloca $ \ p_argc ->
  40   alloca $ \ p_argv -> do
  41    getProgArgv p_argc p_argv
  42    p    <- peek p_argc
  43    argv <- peek p_argv
  44    peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString
  45
  46
  47 foreign import "getProgArgv" getProgArgv :: Ptr Int -> Ptr (Ptr CString) -> IO ()
  48
  49 -- Computation `getProgName' returns the name of the program
  50 -- as it was invoked.
  51
  52 getProgName :: IO String
  53 getProgName =
  54   alloca $ \ p_argc ->
  55   alloca $ \ p_argv -> do
  56      getProgArgv p_argc p_argv
  57      argv <- peek p_argv
  58      unpackProgName argv
  59
  60 -- Computation `getEnv var' returns the value
  61 -- of the environment variable {\em var}.
  62
  63 -- This computation may fail with
  64 --    NoSuchThing: The environment variable does not exist.
  65
  66 getEnv :: String -> IO String
  67 getEnv name =
  68     withCString name $ \s -> do
  69       litstring <- _getenv s
  70       if litstring /= nullPtr
  71         then peekCString litstring
  72         else ioException (IOError Nothing NoSuchThing "getEnv"
  73                           "no environment variable" (Just name))
  74
  75 foreign import ccall "getenv" unsafe _getenv :: CString -> IO (Ptr CChar)
  76
  77 -- ---------------------------------------------------------------------------
  78 -- system
  79
  80 -- Computation `system cmd' returns the exit code
  81 -- produced when the operating system processes the command {\em cmd}.
  82
  83 -- This computation may fail with
  84 --   PermissionDenied
  85 --      The process has insufficient privileges to perform the operation.
  86 --   ResourceExhausted
  87 --      Insufficient resources are available to perform the operation.
  88 --   UnsupportedOperation
  89 --      The implementation does not support system calls.
  90
  91 system :: String -> IO ExitCode
  92 system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing)
  93 system cmd =
  94   withCString cmd $ \s -> do
  95     status <- throwErrnoIfMinus1 "system" (primSystem s)
  96     case status of
  97         0  -> return ExitSuccess
  98         n  -> return (ExitFailure n)
  99
 100 foreign import ccall "systemCmd" unsafe primSystem :: CString -> IO Int
 101
 102 -- ---------------------------------------------------------------------------
 103 -- exitWith
 104
 105 -- `exitWith code' terminates the program, returning `code' to the
 106 -- program's caller.  Before it terminates, any open or semi-closed
 107 -- handles are first closed.
 108
 109 exitWith :: ExitCode -> IO a
 110 exitWith ExitSuccess = throw (ExitException ExitSuccess)
 111 exitWith code@(ExitFailure n)
 112   | n == 0 = ioException (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing)
 113   | otherwise = throw (ExitException code)
 114
 115 exitFailure :: IO a
 116 exitFailure = exitWith (ExitFailure 1)
 117
 118 -- ---------------------------------------------------------------------------
 119 -- Local utilities
 120
 121 unpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]
 122 unpackProgName argv = do
 123   s <- peekElemOff argv 0 >>= peekCString
 124   return (de_slash "" s)
 125   where
 126     -- re-start accumulating at every '/'
 127     de_slash :: String -> String -> String
 128     de_slash  acc []       = reverse acc
 129     de_slash _acc ('/':xs) = de_slash []      xs
 130     de_slash  acc (x:xs)   = de_slash (x:acc) xs
 131 \end{code}