ghc/lib/std/System.lhs

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