From: ross <unknown>
Date: Wed, 6 Oct 2004 11:11:35 +0000 (+0000)
Subject: [project @ 2004-10-06 11:11:34 by ross]
X-Git-Tag: nhc98-1-18-release~226
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=de21f9f20b5a1f6bb7204de6e52a97eec26aba1c;p=ghc-base.git

[project @ 2004-10-06 11:11:34 by ross]
Add getEnvironment from hslibs/lang/SystemExts.  This differs from the
System.Posix.Env version in not failing if an entry lacks an '=' sign.
---

diff --git a/System/Environment.hs b/System/Environment.hs
index bd285e5..de60de8 100644
--- a/System/Environment.hs
+++ b/System/Environment.hs
@@ -21,6 +21,9 @@ module System.Environment
       withArgs,
       withProgName,
 #endif
+#ifdef __GLASGOW_HASKELL__
+      getEnvironment,
+#endif
   ) where
 
 import Prelude
@@ -168,4 +171,26 @@ setArgs argv = do
 
 foreign import ccall unsafe "setProgArgv" 
   setArgsPrim  :: Int -> Ptr CString -> IO ()
+
+-- |'getEnvironment' retrieves the entire environment as a
+-- list of @(key,value)@ pairs.
+--
+-- If an environment entry does not contain an @\'=\'@ character,
+-- the @key@ is the whole entry and the @value@ is the empty string.
+
+getEnvironment :: IO [(String, String)]
+getEnvironment = do
+   pBlock <- getEnvBlock
+   if pBlock == nullPtr then return []
+    else do
+      stuff <- peekArray0 nullPtr pBlock >>= mapM peekCString
+      return (map divvy stuff)
+  where
+   divvy str = 
+      case break (=='=') str of
+        (xs,[])        -> (xs,[]) -- don't barf (like Posix.getEnvironment)
+        (name,_:value) -> (name,value)
+
+foreign import ccall unsafe "__hscore_environ" 
+  getEnvBlock :: IO (Ptr CString)
 #endif  /* __GLASGOW_HASKELL__ */
diff --git a/include/HsBase.h b/include/HsBase.h
index 9738ffc..c27140e 100644
--- a/include/HsBase.h
+++ b/include/HsBase.h
@@ -737,5 +737,10 @@ INLINE int __hscore_CSIDL_WINDOWS()  { return CSIDL_WINDOWS;  }
 INLINE int __hscore_CSIDL_PERSONAL() { return CSIDL_PERSONAL; }
 #endif
 
+/* ToDo: write a feature test that doesn't assume 'environ' to
+ *    be in scope at link-time. */
+extern char** environ;
+INLINE char **__hscore_environ() { return environ; }
+
 #endif /* __HSBASE_H__ */