1 {-# LANGUAGE CPP, ForeignFunctionInterface #-}
3 -----------------------------------------------------------------------------
5 -- Module : System.Environment
6 -- Copyright : (c) The University of Glasgow 2001
7 -- License : BSD-style (see the file libraries/base/LICENSE)
9 -- Maintainer : libraries@haskell.org
10 -- Stability : provisional
11 -- Portability : portable
13 -- Miscellaneous information about the system environment.
15 -----------------------------------------------------------------------------
17 module System.Environment
19 getArgs, -- :: IO [String]
20 getProgName, -- :: IO String
21 getEnv, -- :: String -> IO String
26 #ifdef __GLASGOW_HASKELL__
33 #ifdef __GLASGOW_HASKELL__
36 import Control.Exception.Base ( bracket )
38 import GHC.IO.Exception
39 import GHC.IO.Encoding (fileSystemEncoding)
40 import qualified GHC.Foreign as GHC
42 #ifdef mingw32_HOST_OS
43 import GHC.Environment
62 #ifdef __GLASGOW_HASKELL__
63 -- ---------------------------------------------------------------------------
64 -- getArgs, getProgName, getEnv
66 #ifdef mingw32_HOST_OS
68 -- Ignore the arguments to hs_init on Windows for the sake of Unicode compat
70 getWin32ProgArgv_certainly :: IO [String]
71 getWin32ProgArgv_certainly = do
72 mb_argv <- getWin32ProgArgv
74 Nothing -> fmap dropRTSArgs getFullArgs
75 Just argv -> return argv
77 withWin32ProgArgv :: [String] -> IO a -> IO a
78 withWin32ProgArgv argv act = bracket begin setWin32ProgArgv (\_ -> act)
81 mb_old_argv <- getWin32ProgArgv
82 setWin32ProgArgv (Just argv)
85 getWin32ProgArgv :: IO (Maybe [String])
86 getWin32ProgArgv = alloca $ \p_argc -> alloca $ \p_argv -> do
87 c_getWin32ProgArgv p_argc p_argv
93 argv_ps <- peekArray (fromIntegral argc) argv_p
94 fmap Just $ mapM peekCWString argv_ps
96 setWin32ProgArgv :: Maybe [String] -> IO ()
97 setWin32ProgArgv Nothing = c_setWin32ProgArgv 0 nullPtr
98 setWin32ProgArgv (Just argv) = withMany withCWString argv $ \argv_ps -> withArrayLen argv_ps $ \argc argv_p -> do
99 c_setWin32ProgArgv (fromIntegral argc) argv_p
101 foreign import ccall unsafe "getWin32ProgArgv"
102 c_getWin32ProgArgv :: Ptr CInt -> Ptr (Ptr CWString) -> IO ()
104 foreign import ccall unsafe "setWin32ProgArgv"
105 c_setWin32ProgArgv :: CInt -> Ptr CWString -> IO ()
107 dropRTSArgs :: [String] -> [String]
109 dropRTSArgs ("+RTS":rest) = dropRTSArgs (dropWhile (/= "-RTS") rest)
110 dropRTSArgs ("--RTS":rest) = rest
111 dropRTSArgs ("-RTS":rest) = dropRTSArgs rest
112 dropRTSArgs (arg:rest) = arg : dropRTSArgs rest
116 -- | Computation 'getArgs' returns a list of the program's command
117 -- line arguments (not including the program name).
118 getArgs :: IO [String]
120 #ifdef mingw32_HOST_OS
121 getArgs = fmap tail getWin32ProgArgv_certainly
125 alloca $ \ p_argv -> do
126 getProgArgv p_argc p_argv
127 p <- fromIntegral `liftM` peek p_argc
129 peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString fileSystemEncoding)
131 foreign import ccall unsafe "getProgArgv"
132 getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
136 Computation 'getProgName' returns the name of the program as it was
139 However, this is hard-to-impossible to implement on some non-Unix
140 OSes, so instead, for maximum portability, we just return the leafname
141 of the program as invoked. Even then there are some differences
142 between platforms: on Windows, for example, a program invoked as foo
143 is probably really @FOO.EXE@, and that is what 'getProgName' will return.
145 getProgName :: IO String
146 #ifdef mingw32_HOST_OS
147 -- Ignore the arguments to hs_init on Windows for the sake of Unicode compat
148 getProgName = fmap (basename . head) getWin32ProgArgv_certainly
152 alloca $ \ p_argv -> do
153 getProgArgv p_argc p_argv
157 unpackProgName :: Ptr (Ptr CChar) -> IO String -- argv[0]
158 unpackProgName argv = do
159 s <- peekElemOff argv 0 >>= GHC.peekCString fileSystemEncoding
163 basename :: FilePath -> FilePath
168 | isPathSeparator x = go xs xs
169 | otherwise = go acc xs
171 isPathSeparator :: Char -> Bool
172 isPathSeparator '/' = True
173 #ifdef mingw32_HOST_OS
174 isPathSeparator '\\' = True
176 isPathSeparator _ = False
179 -- | Computation 'getEnv' @var@ returns the value
180 -- of the environment variable @var@.
182 -- This computation may fail with:
184 -- * 'System.IO.Error.isDoesNotExistError' if the environment variable
187 getEnv :: String -> IO String
188 #ifdef mingw32_HOST_OS
189 getEnv name = withCWString name $ \s -> try_size s 256
191 try_size s size = allocaArray (fromIntegral size) $ \p_value -> do
192 res <- c_GetEnvironmentVariable s p_value size
195 err <- c_GetLastError
196 if err == eRROR_ENVVAR_NOT_FOUND
197 then ioe_missingEnvVar name
198 else throwGetLastError "getEnv"
199 _ | res > size -> try_size s res -- Rare: size increased between calls to GetEnvironmentVariable
200 | otherwise -> peekCWString p_value
202 eRROR_ENVVAR_NOT_FOUND :: DWORD
203 eRROR_ENVVAR_NOT_FOUND = 203
205 foreign import stdcall unsafe "windows.h GetLastError"
206 c_GetLastError:: IO DWORD
208 foreign import stdcall unsafe "windows.h GetEnvironmentVariableW"
209 c_GetEnvironmentVariable :: LPTSTR -> LPTSTR -> DWORD -> IO DWORD
212 withCString name $ \s -> do
213 litstring <- c_getenv s
214 if litstring /= nullPtr
215 then GHC.peekCString fileSystemEncoding litstring
216 else ioe_missingEnvVar name
218 foreign import ccall unsafe "getenv"
219 c_getenv :: CString -> IO (Ptr CChar)
222 ioe_missingEnvVar :: String -> IO a
223 ioe_missingEnvVar name = ioException (IOError Nothing NoSuchThing "getEnv"
224 "no environment variable" Nothing (Just name))
227 'withArgs' @args act@ - while executing action @act@, have 'getArgs'
230 withArgs :: [String] -> IO a -> IO a
232 p <- System.Environment.getProgName
236 'withProgName' @name act@ - while executing action @act@,
237 have 'getProgName' return @name@.
239 withProgName :: String -> IO a -> IO a
240 withProgName nm act = do
241 xs <- System.Environment.getArgs
244 -- Worker routine which marshals and replaces an argv vector for
245 -- the duration of an action.
247 withArgv :: [String] -> IO a -> IO a
249 #ifdef mingw32_HOST_OS
250 -- We have to reflect the updated arguments in the RTS-side variables as
251 -- well, because the RTS still consults them for error messages and the like.
252 -- If we don't do this then ghc-e005 fails.
253 withArgv new_args act = withWin32ProgArgv new_args $ withProgArgv new_args act
255 withArgv = withProgArgv
258 withProgArgv :: [String] -> IO a -> IO a
259 withProgArgv new_args act = do
260 pName <- System.Environment.getProgName
261 existing_args <- System.Environment.getArgs
262 bracket (setProgArgv new_args)
263 (\argv -> do _ <- setProgArgv (pName:existing_args)
267 freeProgArgv :: Ptr CString -> IO ()
268 freeProgArgv argv = do
269 size <- lengthArray0 nullPtr argv
270 sequence_ [peek (argv `advancePtr` i) >>= free | i <- [size, size-1 .. 0]]
273 setProgArgv :: [String] -> IO (Ptr CString)
274 setProgArgv argv = do
275 vs <- mapM (GHC.newCString fileSystemEncoding) argv >>= newArray0 nullPtr
276 c_setProgArgv (genericLength argv) vs
279 foreign import ccall unsafe "setProgArgv"
280 c_setProgArgv :: CInt -> Ptr CString -> IO ()
282 -- |'getEnvironment' retrieves the entire environment as a
283 -- list of @(key,value)@ pairs.
285 -- If an environment entry does not contain an @\'=\'@ character,
286 -- the @key@ is the whole entry and the @value@ is the empty string.
287 getEnvironment :: IO [(String, String)]
289 #ifdef mingw32_HOST_OS
290 getEnvironment = bracket c_GetEnvironmentStrings c_FreeEnvironmentStrings $ \pBlock ->
291 if pBlock == nullPtr then return []
295 -- The block is terminated by a null byte where there
296 -- should be an environment variable of the form X=Y
298 if c == 0 then return []
300 -- Seek the next pair (or terminating null):
301 pBlock' <- seekNull pBlock False
302 -- We now know the length in bytes, but ignore it when
303 -- getting the actual String:
304 str <- peekCWString pBlock
305 fmap (divvy str :) $ go pBlock'
307 -- Returns pointer to the byte *after* the next null
308 seekNull pBlock done = do
309 let pBlock' = pBlock `plusPtr` sizeOf (undefined :: CWchar)
310 if done then return pBlock'
313 seekNull pBlock' (c == (0 :: Word8 ))
315 foreign import stdcall unsafe "windows.h GetEnvironmentStringsW"
316 c_GetEnvironmentStrings :: IO (Ptr CWchar)
318 foreign import stdcall unsafe "windows.h FreeEnvironmentStringsW"
319 c_FreeEnvironmentStrings :: Ptr CWchar -> IO Bool
322 pBlock <- getEnvBlock
323 if pBlock == nullPtr then return []
325 stuff <- peekArray0 nullPtr pBlock >>= mapM (GHC.peekCString fileSystemEncoding)
326 return (map divvy stuff)
328 foreign import ccall unsafe "__hscore_environ"
329 getEnvBlock :: IO (Ptr CString)
332 divvy :: String -> (String, String)
334 case break (=='=') str of
335 (xs,[]) -> (xs,[]) -- don't barf (like Posix.getEnvironment)
336 (name,_:value) -> (name,value)
337 #endif /* __GLASGOW_HASKELL__ */