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/base/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 #ifdef __GLASGOW_HASKELL__
  21       withArgs,
  22       withProgName,
  23 #endif
  24   ) where
  25
  26 import Prelude
  27 #ifndef __NHC__
  28 import Control.Exception        ( bracket )
  29 #endif
  30
  31 #ifdef __GLASGOW_HASKELL__
  32 import Foreign
  33 import Foreign.C
  34 import Control.Monad
  35 import GHC.IOBase
  36 #endif
  37
  38 #ifdef __HUGS__
  39 import Hugs.System
  40 #endif
  41
  42 #ifdef __NHC__
  43 import System
  44   ( getArgs
  45   , getProgName
  46   , getEnv
  47   )
  48 #endif
  49
  50 -- ---------------------------------------------------------------------------
  51 -- getArgs, getProgName, getEnv
  52
  53 -- Computation `getArgs' returns a list of the program's command
  54 -- line arguments (not including the program name).
  55
  56 #ifdef __GLASGOW_HASKELL__
  57 getArgs :: IO [String]
  58 getArgs =
  59   alloca $ \ p_argc ->
  60   alloca $ \ p_argv -> do
  61    getProgArgv p_argc p_argv
  62    p    <- fromIntegral `liftM` peek p_argc
  63    argv <- peek p_argv
  64    peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString
  65
  66
  67 foreign import ccall unsafe "getProgArgv"
  68   getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
  69
  70 {-|
  71 Computation 'getProgName' returns the name of the program as it was
  72 invoked.
  73
  74 However, this is hard-to-impossible to implement on some non-Unix
  75 OSes, so instead, for maximum portability, we just return the leafname
  76 of the program as invoked. Even then there are some differences
  77 between platforms: on Windows, for example, a program invoked as foo
  78 is probably really @FOO.EXE@, and that is what 'getProgName' will return.
  79 -}
  80 getProgName :: IO String
  81 getProgName =
  82   alloca $ \ p_argc ->
  83   alloca $ \ p_argv -> do
  84      getProgArgv p_argc p_argv
  85      argv <- peek p_argv
  86      unpackProgName argv
  87
  88 unpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]
  89 unpackProgName argv = do
  90   s <- peekElemOff argv 0 >>= peekCString
  91   return (basename s)
  92   where
  93    basename :: String -> String
  94    basename f = go f f
  95     where
  96       go acc [] = acc
  97       go acc (x:xs)
  98         | isPathSeparator x = go xs xs
  99         | otherwise         = go acc xs
 100
 101    isPathSeparator :: Char -> Bool
 102    isPathSeparator '/'  = True
 103 #ifdef mingw32_TARGET_OS
 104    isPathSeparator '\\' = True
 105 #endif
 106    isPathSeparator _    = False
 107
 108
 109 -- Computation `getEnv var' returns the value
 110 -- of the environment variable {\em var}.
 111
 112 -- This computation may fail with
 113 --    NoSuchThing: The environment variable does not exist.
 114
 115 getEnv :: String -> IO String
 116 getEnv name =
 117     withCString name $ \s -> do
 118       litstring <- c_getenv s
 119       if litstring /= nullPtr
 120         then peekCString litstring
 121         else ioException (IOError Nothing NoSuchThing "getEnv"
 122                           "no environment variable" (Just name))
 123
 124 foreign import ccall unsafe "getenv"
 125    c_getenv :: CString -> IO (Ptr CChar)
 126
 127 {-|
 128 @withArgs args act@ - while executing action @act@, have 'System.getArgs'
 129 return @args@ (GHC only).
 130 -}
 131 withArgs xs act = do
 132    p <- System.Environment.getProgName
 133    withArgv (p:xs) act
 134
 135 {-|
 136 @withProgName name act@ - while executing action @act@,
 137 have 'System.getProgName' return @name@ (GHC only).
 138 -}
 139 withProgName nm act = do
 140    xs <- System.Environment.getArgs
 141    withArgv (nm:xs) act
 142
 143 -- Worker routine which marshals and replaces an argv vector for
 144 -- the duration of an action.
 145
 146 withArgv new_args act = do
 147   pName <- System.Environment.getProgName
 148   existing_args <- System.Environment.getArgs
 149   bracket (setArgs new_args)
 150           (\argv -> do setArgs (pName:existing_args); freeArgv argv)
 151           (const act)
 152
 153 freeArgv :: Ptr CString -> IO ()
 154 freeArgv argv = do
 155   size <- lengthArray0 nullPtr argv
 156   sequence_ [peek (argv `advancePtr` i) >>= free | i <- [size, size-1 .. 0]]
 157   free argv
 158
 159 setArgs :: [String] -> IO (Ptr CString)
 160 setArgs argv = do
 161   vs <- mapM newCString argv >>= newArray0 nullPtr
 162   setArgsPrim (length argv) vs
 163   return vs
 164
 165 foreign import ccall unsafe "setProgArgv"
 166   setArgsPrim  :: Int -> Ptr CString -> IO ()
 167 #endif  /* __GLASGOW_HASKELL__ */