ghc/lib/std/System.lhs

   1 -- -----------------------------------------------------------------------------
   2 -- $Id: System.lhs,v 1.30 2001/05/18 16:54:05 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       ( IOException(..), ioException, IOErrorType(..))
  28
  29 -- -----------------------------------------------------------------------------
  30 -- The ExitCode type
  31
  32 -- The `ExitCode' type defines the exit codes that a program
  33 -- can return.  `ExitSuccess' indicates successful termination;
  34 -- and `ExitFailure code' indicates program failure
  35 -- with value `code'.  The exact interpretation of `code'
  36 -- is operating-system dependent.  In particular, some values of
  37 -- `code' may be prohibited (e.g. 0 on a POSIX-compliant system).
  38
  39 data ExitCode = ExitSuccess | ExitFailure Int
  40                 deriving (Eq, Ord, Read, Show)
  41
  42
  43 -- Computation `getArgs' returns a list of the program's command
  44 -- line arguments (not including the program name).
  45
  46 getArgs :: IO [String]
  47 getArgs = unpackArgv primArgv primArgc
  48
  49 foreign import ccall "get_prog_argv" unsafe   primArgv :: Ptr (Ptr CChar)
  50 foreign import ccall "get_prog_argc" unsafe   primArgc :: Int
  51
  52 -- Computation `getProgName' returns the name of the program
  53 -- as it was invoked.
  54
  55 getProgName :: IO String
  56 getProgName = unpackProgName primArgv
  57
  58 -- Computation `getEnv var' returns the value
  59 -- of the environment variable {\em var}.
  60
  61 -- This computation may fail with
  62 --    NoSuchThing: The environment variable does not exist.
  63
  64 getEnv :: String -> IO String
  65 getEnv name =
  66     withUnsafeCString name $ \s -> do
  67       litstring <- _getenv s
  68       if litstring /= nullPtr
  69         then peekCString litstring
  70         else ioException (IOError Nothing NoSuchThing "getEnv"
  71                           "no environment variable" (Just name))
  72
  73 foreign import ccall "getenv" unsafe _getenv :: UnsafeCString -> IO (Ptr CChar)
  74
  75 -- ---------------------------------------------------------------------------
  76 -- system
  77
  78 -- Computation `system cmd' returns the exit code
  79 -- produced when the operating system processes the command {\em cmd}.
  80
  81 -- This computation may fail with
  82 --   PermissionDenied
  83 --      The process has insufficient privileges to perform the operation.
  84 --   ResourceExhausted
  85 --      Insufficient resources are available to perform the operation.
  86 --   UnsupportedOperation
  87 --      The implementation does not support system calls.
  88
  89 system :: String -> IO ExitCode
  90 system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing)
  91 system cmd =
  92   withUnsafeCString cmd $ \s -> do
  93     status <- throwErrnoIfMinus1 "system" (primSystem s)
  94     case status of
  95         0  -> return ExitSuccess
  96         n  -> return (ExitFailure n)
  97
  98 foreign import ccall "systemCmd" unsafe primSystem :: UnsafeCString -> IO Int
  99
 100 -- ---------------------------------------------------------------------------
 101 -- exitWith
 102
 103 -- `exitWith code' terminates the program, returning `code' to the
 104 -- program's caller.  Before it terminates, any open or semi-closed
 105 -- handles are first closed.
 106
 107 exitWith :: ExitCode -> IO a
 108 exitWith ExitSuccess = do
 109     primExit 0
 110     ioException (IOError Nothing OtherError "exitWith" "exit should not return" Nothing)
 111
 112 exitWith (ExitFailure n)
 113   | n == 0 = ioException (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing)
 114   | otherwise = do
 115     primExit n
 116     ioException (IOError Nothing OtherError "exitWith" "exit should not return" Nothing)
 117
 118 -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
 119 -- re-enter Haskell land through finalizers.
 120 foreign import ccall "shutdownHaskellAndExit" primExit :: Int -> IO ()
 121
 122 exitFailure :: IO a
 123 exitFailure = exitWith (ExitFailure 1)
 124
 125 -- ---------------------------------------------------------------------------
 126 -- Local utilities
 127
 128 unpackArgv :: Ptr (Ptr CChar) -> Int -> IO [String] -- argv[1 .. argc-1]
 129 unpackArgv argv argc
 130   = peekArray (argc-1) (advancePtr argv 1) >>= mapM peekCString
 131
 132 unpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]
 133 unpackProgName argv = do
 134   s <- peekElemOff argv 0 >>= peekCString
 135   return (de_slash "" s)
 136   where
 137     -- re-start accumulating at every '/'
 138     de_slash :: String -> String -> String
 139     de_slash  acc []       = reverse acc
 140     de_slash _acc ('/':xs) = de_slash []      xs
 141     de_slash  acc (x:xs)   = de_slash (x:acc) xs
 142
 143 \end{code}