System/Environment.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  System.Environment
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/core/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  provisional
   9 -- Portability :  portable
  10 --
  11 -- Miscellaneous information about the system environment.
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 module System.Environment
  16     (
  17     , getArgs       -- :: IO [String]
  18     , getProgName   -- :: IO String
  19     , getEnv        -- :: String -> IO String
  20   ) where
  21
  22 import Prelude
  23
  24 import Foreign
  25 import Foreign.C
  26 import Control.Monad
  27
  28 #ifdef __GLASGOW_HASKELL__
  29 import GHC.IOBase
  30 #endif
  31
  32 -- ---------------------------------------------------------------------------
  33 -- getArgs, getProgName, getEnv
  34
  35 -- Computation `getArgs' returns a list of the program's command
  36 -- line arguments (not including the program name).
  37
  38 getArgs :: IO [String]
  39 getArgs =
  40   alloca $ \ p_argc ->
  41   alloca $ \ p_argv -> do
  42    getProgArgv p_argc p_argv
  43    p    <- fromIntegral `liftM` peek p_argc
  44    argv <- peek p_argv
  45    peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString
  46
  47
  48 foreign import ccall unsafe "getProgArgv"
  49   getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
  50
  51 -- Computation `getProgName' returns the name of the program
  52 -- as it was invoked.
  53
  54 getProgName :: IO String
  55 getProgName =
  56   alloca $ \ p_argc ->
  57   alloca $ \ p_argv -> do
  58      getProgArgv p_argc p_argv
  59      argv <- peek p_argv
  60      unpackProgName argv
  61
  62 unpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]
  63 unpackProgName argv = do
  64   s <- peekElemOff argv 0 >>= peekCString
  65   return (basename s)
  66   where
  67    basename :: String -> String
  68    basename f = go f f
  69     where
  70       go acc [] = acc
  71       go acc (x:xs)
  72         | isPathSeparator x = go xs xs
  73         | otherwise         = go acc xs
  74
  75    isPathSeparator :: Char -> Bool
  76    isPathSeparator '/'  = True
  77 #ifdef mingw32_TARGET_OS
  78    isPathSeparator '\\' = True
  79 #endif
  80    isPathSeparator _    = False
  81
  82
  83 -- Computation `getEnv var' returns the value
  84 -- of the environment variable {\em var}.
  85
  86 -- This computation may fail with
  87 --    NoSuchThing: The environment variable does not exist.
  88
  89 getEnv :: String -> IO String
  90 getEnv name =
  91     withCString name $ \s -> do
  92       litstring <- c_getenv s
  93       if litstring /= nullPtr
  94         then peekCString litstring
  95         else ioException (IOError Nothing NoSuchThing "getEnv"
  96                           "no environment variable" (Just name))
  97
  98 foreign import ccall unsafe "getenv"
  99    c_getenv :: CString -> IO (Ptr CChar)