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