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