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