-- Stability : provisional
-- Portability : portable
--
--- $Id: Environment.hs,v 1.1 2001/06/28 14:15:04 simonmar Exp $
+-- $Id: Environment.hs,v 1.5 2002/04/24 16:09:22 simonmar Exp $
--
-- Miscellaneous information about the system environment.
--
import Foreign
import Foreign.C
+import Control.Monad
#ifdef __GLASGOW_HASKELL__
import GHC.IOBase
-- line arguments (not including the program name).
getArgs :: IO [String]
-getArgs = do
- argv <- peek prog_argv_label
- argc <- peek prog_argc_label
- peekArray (fromIntegral argc - 1) (advancePtr argv 1) >>= mapM peekCString
+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 label "prog_argv" prog_argv_label :: Ptr (Ptr (Ptr CChar))
-foreign label "prog_argc" prog_argc_label :: Ptr CInt
+
+foreign import ccall unsafe "getProgArgv"
+ getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
-- Computation `getProgName' returns the name of the program
-- as it was invoked.
getProgName :: IO String
-getProgName = do
- argv <- peek prog_argv_label
- unpackProgName argv
-
+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 (de_slash "" s)
+ return (basename s)
where
- -- re-start accumulating at every '/'
- de_slash :: String -> String -> String
- de_slash acc [] = reverse acc
- de_slash _acc ('/':xs) = de_slash [] xs
- de_slash acc (x:xs) = de_slash (x:acc) xs
+ 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 {\em var}.
getEnv :: String -> IO String
getEnv name =
- withUnsafeCString name $ \s -> do
+ 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 "getenv" unsafe
- c_getenv :: UnsafeCString -> IO (Ptr CChar)
+foreign import ccall unsafe "getenv"
+ c_getenv :: CString -> IO (Ptr CChar)