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