[project @ 2002-04-24 16:31:37 by simonmar]
[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/core/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : provisional
9 -- Portability : portable
10 --
11 -- $Id: Environment.hs,v 1.6 2002/04/24 16:31:45 simonmar Exp $
12 --
13 -- Miscellaneous information about the system environment.
14 --
15 -----------------------------------------------------------------------------
16
17 module System.Environment
18 (
19 , getArgs -- :: IO [String]
20 , getProgName -- :: IO String
21 , getEnv -- :: String -> IO String
22 ) where
23
24 import Prelude
25
26 import Foreign
27 import Foreign.C
28 import Control.Monad
29
30 #ifdef __GLASGOW_HASKELL__
31 import GHC.IOBase
32 #endif
33
34 -- ---------------------------------------------------------------------------
35 -- getArgs, getProgName, getEnv
36
37 -- Computation `getArgs' returns a list of the program's command
38 -- line arguments (not including the program name).
39
40 getArgs :: IO [String]
41 getArgs =
42 alloca $ \ p_argc ->
43 alloca $ \ p_argv -> do
44 getProgArgv p_argc p_argv
45 p <- fromIntegral `liftM` peek p_argc
46 argv <- peek p_argv
47 peekArray (p - 1) (advancePtr argv 1) >>= mapM peekCString
48
49
50 foreign import ccall unsafe "getProgArgv"
51 getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
52
53 -- Computation `getProgName' returns the name of the program
54 -- as it was invoked.
55
56 getProgName :: IO String
57 getProgName =
58 alloca $ \ p_argc ->
59 alloca $ \ p_argv -> do
60 getProgArgv p_argc p_argv
61 argv <- peek p_argv
62 unpackProgName argv
63
64 unpackProgName :: Ptr (Ptr CChar) -> IO String -- argv[0]
65 unpackProgName argv = do
66 s <- peekElemOff argv 0 >>= peekCString
67 return (basename s)
68 where
69 basename :: String -> String
70 basename f = go f f
71 where
72 go acc [] = acc
73 go acc (x:xs)
74 | isPathSeparator x = go xs xs
75 | otherwise = go acc xs
76
77 isPathSeparator :: Char -> Bool
78 isPathSeparator '/' = True
79 #ifdef mingw32_TARGET_OS
80 isPathSeparator '\\' = True
81 #endif
82 isPathSeparator _ = False
83
84
85 -- Computation `getEnv var' returns the value
86 -- of the environment variable {\em var}.
87
88 -- This computation may fail with
89 -- NoSuchThing: The environment variable does not exist.
90
91 getEnv :: String -> IO String
92 getEnv name =
93 withCString name $ \s -> do
94 litstring <- c_getenv s
95 if litstring /= nullPtr
96 then peekCString litstring
97 else ioException (IOError Nothing NoSuchThing "getEnv"
98 "no environment variable" (Just name))
99
100 foreign import ccall unsafe "getenv"
101 c_getenv :: CString -> IO (Ptr CChar)