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