ghc/lib/std/System.lhs

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