ghc/lib/std/System.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: System.lhs,v 1.28 2001/01/11 17:25:57 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1994-2000
   5 %
   6
   7 \section[System]{Module @System@}
   8
   9 \begin{code}
  10 {-# OPTIONS -#include "cbits/stgio.h" #-}
  11 module System
  12     (
  13       ExitCode(ExitSuccess,ExitFailure)
  14     , getArgs       -- :: IO [String]
  15     , getProgName   -- :: IO String
  16     , getEnv        -- :: String -> IO String
  17     , system        -- :: String -> IO ExitCode
  18     , exitWith      -- :: ExitCode -> IO a
  19     , exitFailure   -- :: IO a
  20   ) where
  21 \end{code}
  22
  23 \begin{code}
  24 import Monad
  25 import Prelude
  26 import PrelCString
  27 import PrelCTypes
  28 import PrelMarshalArray
  29 import PrelPtr
  30 import PrelStorable
  31 import PrelIOBase       ( IOException(..), ioException,
  32                           IOErrorType(..), constructErrorAndFailWithInfo )
  33 import PrelByteArr      ( ByteArray )
  34 \end{code}
  35
  36 %*********************************************************
  37 %*                                                      *
  38 \subsection{The @ExitCode@ type}
  39 %*                                                      *
  40 %*********************************************************
  41
  42 The $ExitCode$ type defines the exit codes that a program
  43 can return.  $ExitSuccess$ indicates successful termination;
  44 and $ExitFailure code$ indicates program failure
  45 with value {\em code}.  The exact interpretation of {\em code}
  46 is operating-system dependent.  In particular, some values of
  47 {\em code} may be prohibited (e.g. 0 on a POSIX-compliant system).
  48
  49 \begin{code}
  50 data ExitCode = ExitSuccess | ExitFailure Int
  51                 deriving (Eq, Ord, Read, Show)
  52
  53 \end{code}
  54
  55 Computation $getArgs$ returns a list of the program's command
  56 line arguments (not including the program name).
  57
  58 \begin{code}
  59 getArgs :: IO [String]
  60 getArgs = unpackArgv primArgv primArgc
  61
  62 foreign import ccall "get_prog_argv" unsafe   primArgv :: Ptr (Ptr CChar)
  63 foreign import ccall "get_prog_argc" unsafe   primArgc :: Int
  64 \end{code}
  65
  66 Computation $getProgName$ returns the name of the program
  67 as it was invoked.
  68
  69 \begin{code}
  70 getProgName :: IO String
  71 getProgName = unpackProgName primArgv
  72 \end{code}
  73
  74 Computation $getEnv var$ returns the value
  75 of the environment variable {\em var}.
  76
  77 This computation may fail with
  78 \begin{itemize}
  79 \item $NoSuchThing$
  80 The environment variable does not exist.
  81 \end{itemize}
  82
  83 \begin{code}
  84 getEnv :: String -> IO String
  85 getEnv name =
  86     withUnsafeCString name $ \s -> do
  87       litstring <- _getenv s
  88       if litstring /= nullPtr
  89         then peekCString litstring
  90         else ioException (IOError Nothing NoSuchThing "getEnv"
  91                           "no environment variable" (Just name))
  92
  93 foreign import ccall "getenv" unsafe _getenv :: UnsafeCString -> IO (Ptr CChar)
  94 \end{code}
  95
  96 Computation $system cmd$ returns the exit code
  97 produced when the operating system processes the command {\em cmd}.
  98
  99 This computation may fail with
 100 \begin{itemize}
 101 \item $PermissionDenied$
 102 The process has insufficient privileges to perform the operation.
 103 \item $ResourceExhausted$
 104 Insufficient resources are available to perform the operation.
 105 \item $UnsupportedOperation$
 106 The implementation does not support system calls.
 107 \end{itemize}
 108
 109 \begin{code}
 110 system                  :: String -> IO ExitCode
 111 system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing)
 112 system cmd =
 113   withUnsafeCString cmd $ \s -> do
 114     status <- primSystem s
 115     case status of
 116         0  -> return ExitSuccess
 117         -1 -> constructErrorAndFailWithInfo "system" cmd
 118         n  -> return (ExitFailure n)
 119
 120 foreign import ccall "systemCmd" unsafe primSystem :: UnsafeCString -> IO Int
 121 \end{code}
 122
 123 @exitWith code@ terminates the program, returning {\em code} to the program's caller.
 124 Before it terminates, any open or semi-closed handles are first closed.
 125
 126 \begin{code}
 127 exitWith                :: ExitCode -> IO a
 128 exitWith ExitSuccess = do
 129     primExit 0
 130     ioException (IOError Nothing OtherError "exitWith" "exit should not return" Nothing)
 131
 132 exitWith (ExitFailure n)
 133   | n == 0 = ioException (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing)
 134   | otherwise = do
 135     primExit n
 136     ioException (IOError Nothing OtherError "exitWith" "exit should not return" Nothing)
 137
 138 -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
 139 -- re-enter Haskell land through finalizers.
 140 foreign import ccall "shutdownHaskellAndExit" primExit :: Int -> IO ()
 141
 142 exitFailure :: IO a
 143 exitFailure = exitWith (ExitFailure 1)
 144 \end{code}
 145
 146
 147 %*********************************************************
 148 %*                                                      *
 149 \subsection{Local utilities}
 150 %*                                                      *
 151 %*********************************************************
 152
 153 \begin{code}
 154 unpackArgv :: Ptr (Ptr CChar) -> Int -> IO [String] -- argv[1 .. argc-1]
 155 unpackArgv argv argc = peekArray argc argv >>= mapM peekCString
 156
 157 unpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]
 158 unpackProgName argv = do
 159   s <- peekElemOff argv 0 >>= peekCString
 160   return (de_slash "" s)
 161   where
 162     -- re-start accumulating at every '/'
 163     de_slash :: String -> String -> String
 164     de_slash  acc []       = reverse acc
 165     de_slash _acc ('/':xs) = de_slash []      xs
 166     de_slash  acc (x:xs)   = de_slash (x:acc) xs
 167 \end{code}