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