[project @ 2002-10-11 11:05:20 by malcolm]
[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 #ifdef __GLASGOW_HASKELL__
21 withArgs,
22 withProgName,
23 #endif
24 ) where
25
26 import Prelude
27 import System.IO ( 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__ */