[project @ 2004-08-17 16:48:09 by krasimir]

Add getHomeDirectory and getAppUserDataDirectory functions

diff --git a/System/Directory.hs b/System/Directory.hs
index 7d92473..69acc08 100644 (file)
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -24,6 +24,8 @@ module System.Directory
     , getDirectoryContents      -- :: FilePath -> IO [FilePath]
     , getCurrentDirectory       -- :: IO FilePath
     , setCurrentDirectory       -- :: FilePath -> IO ()
+    , getHomeDirectory
+    , getAppUserDataDirectory 
 
     -- * Actions on files
     , removeFile               -- :: FilePath -> IO ()
@@ -78,6 +80,10 @@ import Foreign.C
 import GHC.IOBase      ( IOException(..), IOErrorType(..), ioException )
 #endif
 
+#ifndef mingw32_TARGET_OS
+import System.Environment
+#endif
+
 {- $intro
 A directory contains a series of entries, each of which is a named
 reference to a file system object (file, directory etc.).  Some
@@ -602,6 +608,44 @@ setCurrentDirectory path = do
        throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)
        -- ToDo: add path to error
 
+getHomeDirectory :: IO FilePath
+getHomeDirectory =
+#ifdef mingw32_TARGET_OS
+  allocaBytes long_path_size $ \pPath -> do
+     r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
+     if (r < 0)
+       then c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
+       else return 0
+     peekCString pPath
+#else
+  getEnv "HOME"
+#endif
+
+getAppUserDataDirectory :: String -> IO FilePath
+getAppUserDataDirectory appName = do
+#ifdef mingw32_TARGET_OS
+  allocaBytes long_path_size $ \pPath -> do
+     r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
+     s <- peekCString pPath
+     return (s++'\\':appName)
+#else
+  path <- getEnv "HOME"
+  return (path++'/':'.':appName)
+#endif
+
+#ifdef mingw32_TARGET_OS
+foreign import stdcall unsafe "SHGetFolderPath" 
+            c_SHGetFolderPath :: Ptr () 
+                              -> CInt 
+                              -> Ptr () 
+                              -> CInt 
+                              -> CString 
+                              -> IO CInt
+foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: Int
+foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: Int
+foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: Int
+#endif
+
 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 exists and is a directory, and 'False' otherwise.
 -}

diff --git a/include/HsBase.h b/include/HsBase.h
index b291451..11d89ba 100644 (file)
--- a/include/HsBase.h
+++ b/include/HsBase.h
@@ -112,6 +112,7 @@
 #include <io.h>
 #include <fcntl.h>
 #include "timeUtils.h"
+#include <shlobj.h>
 #endif
 
 /* in system.c */
@@ -709,5 +710,11 @@ INLINE int __hscore_fstat(int fd, struct stat *buf) {
        return (fstat(fd,buf));
 }
 
+#if defined(mingw32_TARGET_OS)
+INLINE int __hscore_CSIDL_PROFILE() { return CSIDL_PROFILE; }
+INLINE int __hscore_CSIDL_APPDATA() { return CSIDL_APPDATA; }
+INLINE int __hscore_CSIDL_WINDOWS() { return CSIDL_WINDOWS; }
+#endif
+
 #endif /* __HSBASE_H__ */
 

diff --git a/package.conf.in b/package.conf.in
index 99fac4c..8ddeb31 100644 (file)
--- a/package.conf.in
+++ b/package.conf.in
@@ -27,7 +27,7 @@ Package {
 #                           endif
        extra_libraries   = [ "HSbase_cbits"
 #if defined(mingw32_TARGET_OS) || defined(__MINGW32__) || defined(_MSC_VER)
-                            , "wsock32", "msvcrt", "kernel32", "user32"
+                            , "wsock32", "msvcrt", "kernel32", "user32", "shfolder"
 #endif
                            ],
 #ifdef INSTALLING