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