From 54cfece8e071df96435ea1abd3b083931f1d8cfd Mon Sep 17 00:00:00 2001
From: krasimir <unknown>
Date: Tue, 17 Aug 2004 16:48:09 +0000
Subject: [PATCH] [project @ 2004-08-17 16:48:09 by krasimir] Add
 getHomeDirectory and getAppUserDataDirectory functions

---
 System/Directory.hs |   44 ++++++++++++++++++++++++++++++++++++++++++++
 include/HsBase.h    |    7 +++++++
 package.conf.in     |    2 +-
 3 files changed, 52 insertions(+), 1 deletion(-)

diff --git a/System/Directory.hs b/System/Directory.hs
index 7d92473..69acc08 100644
--- 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
--- 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
--- 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
-- 
1.7.10.4