move Win32 SearchPath and SHGetFolderPath into the Win32 package

That completes the transition to Unicode FilePath support in the
directory package on Win32 (#3300).

The main cleanup remaining to do here is to use native Win32
implementations of getPermissions/setPermissions/copyPermissions
instead of calls to stat().

We are very close to being able to remove the last bits of C and
autoconf here...

diff --git a/System/Directory.hs b/System/Directory.hs
index 6e86c22..2a846f7 100644 (file)
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -686,14 +686,7 @@ canonicalizePath fpath =
        return (normalise path)
         -- normalise does more stuff, like upper-casing the drive letter
 
        return (normalise path)
         -- normalise does more stuff, like upper-casing the drive letter
 

-#if defined(mingw32_HOST_OS)
-foreign import stdcall unsafe "GetFullPathNameA"
-            c_GetFullPathName :: CString
-                              -> CInt
-                              -> CString
-                              -> Ptr CString
-                              -> IO CInt
-#else
+#if !defined(mingw32_HOST_OS)

 foreign import ccall unsafe "realpath"
                    c_realpath :: CString
                               -> CString
 foreign import ccall unsafe "realpath"
                    c_realpath :: CString
                               -> CString

@@ -727,24 +720,7 @@ makeRelativeToCurrentDirectory x = do
 findExecutable :: String -> IO (Maybe FilePath)
 findExecutable binary =
 #if defined(mingw32_HOST_OS)
 findExecutable :: String -> IO (Maybe FilePath)
 findExecutable binary =
 #if defined(mingw32_HOST_OS)

-  withCString binary $ \c_binary ->
-  withCString ('.':exeExtension) $ \c_ext ->
-  allocaBytes long_path_size $ \pOutPath ->
-  alloca $ \ppFilePart -> do
-    res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart
-    if res > 0 && res < fromIntegral long_path_size
-      then do fpath <- peekCString pOutPath
-              return (Just fpath)
-      else return Nothing
-
-foreign import stdcall unsafe "SearchPathA"
-            c_SearchPath :: CString
-                         -> CString
-                         -> CString
-                         -> CInt
-                         -> CString
-                         -> Ptr CString
-                         -> IO CInt
+  Win32.searchPath Nothing binary ('.':exeExtension)

 #else
  do
   path <- getEnv "PATH"
 #else
  do
   path <- getEnv "PATH"

@@ -994,10 +970,6 @@ fileNameEndClean :: String -> String
 fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
                                         else dropTrailingPathSeparator name
 
 fileNameEndClean name = if isDrive name then addTrailingPathSeparator name
                                         else dropTrailingPathSeparator name
 

-foreign import ccall unsafe "HsDirectory.h __hscore_R_OK" r_OK :: CInt
-foreign import ccall unsafe "HsDirectory.h __hscore_W_OK" w_OK :: CInt
-foreign import ccall unsafe "HsDirectory.h __hscore_X_OK" x_OK :: CInt
-

 foreign import ccall unsafe "HsDirectory.h __hscore_S_IRUSR" s_IRUSR :: CMode
 foreign import ccall unsafe "HsDirectory.h __hscore_S_IWUSR" s_IWUSR :: CMode
 foreign import ccall unsafe "HsDirectory.h __hscore_S_IXUSR" s_IXUSR :: CMode
 foreign import ccall unsafe "HsDirectory.h __hscore_S_IRUSR" s_IRUSR :: CMode
 foreign import ccall unsafe "HsDirectory.h __hscore_S_IWUSR" s_IWUSR :: CMode
 foreign import ccall unsafe "HsDirectory.h __hscore_S_IXUSR" s_IXUSR :: CMode

@@ -1036,15 +1008,16 @@ cannot be found.
 -}
 getHomeDirectory :: IO FilePath
 getHomeDirectory =
 -}
 getHomeDirectory :: IO FilePath
 getHomeDirectory =

+  modifyIOError ((`ioeSetLocation` "getHomeDirectory")) $ do

 #if defined(mingw32_HOST_OS)
 #if defined(mingw32_HOST_OS)

-  allocaBytes long_path_size $ \pPath -> do
-     r0 <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath
-     if (r0 < 0)
-       then do
-          r1 <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath
-         when (r1 < 0) (raiseUnsupported "System.Directory.getHomeDirectory")
-       else return ()
-     peekCString pPath
+  r <- try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_PROFILE nullPtr 0
+  case (r :: Either IOException String) of
+    Right s -> return s
+    Left  _ -> do
+      r1 <- try $ Win32.sHGetFolderPath nullPtr Win32.cSIDL_WINDOWS nullPtr 0
+      case r1 of
+        Right s -> return s
+        Left  e -> ioError (e :: IOException)

 #else
   getEnv "HOME"
 #endif
 #else
   getEnv "HOME"
 #endif

@@ -1078,12 +1051,10 @@ cannot be found.
 -}
 getAppUserDataDirectory :: String -> IO FilePath
 getAppUserDataDirectory appName = do
 -}
 getAppUserDataDirectory :: String -> IO FilePath
 getAppUserDataDirectory appName = do

+  modifyIOError ((`ioeSetLocation` "getAppUserDataDirectory")) $ do

 #if defined(mingw32_HOST_OS)
 #if defined(mingw32_HOST_OS)

-  allocaBytes long_path_size $ \pPath -> do
-     r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
-     when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")
-     s <- peekCString pPath
-     return (s++'\\':appName)
+  s <- Win32.sHGetFolderPath nullPtr Win32.cSIDL_APPDATA nullPtr 0
+  return (s++'\\':appName)

 #else
   path <- getEnv "HOME"
   return (path++'/':'.':appName)
 #else
   path <- getEnv "HOME"
   return (path++'/':'.':appName)

@@ -1112,11 +1083,9 @@ cannot be found.
 -}
 getUserDocumentsDirectory :: IO FilePath
 getUserDocumentsDirectory = do
 -}
 getUserDocumentsDirectory :: IO FilePath
 getUserDocumentsDirectory = do

+  modifyIOError ((`ioeSetLocation` "getUserDocumentsDirectory")) $ do

 #if defined(mingw32_HOST_OS)
 #if defined(mingw32_HOST_OS)

-  allocaBytes long_path_size $ \pPath -> do
-     r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath
-     when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")
-     peekCString pPath
+  Win32.sHGetFolderPath nullPtr Win32.cSIDL_PERSONAL nullPtr 0

 #else
   getEnv "HOME"
 #endif
 #else
   getEnv "HOME"
 #endif

@@ -1161,25 +1130,6 @@ getTemporaryDirectory = do
 #endif
 #endif
 
 #endif
 #endif
 

-#if defined(mingw32_HOST_OS)
-foreign import ccall unsafe "__hscore_getFolderPath"
-            c_SHGetFolderPath :: Ptr () 
-                              -> CInt 
-                              -> Ptr () 
-                              -> CInt 
-                              -> CString 
-                              -> IO CInt
-foreign import ccall unsafe "__hscore_CSIDL_PROFILE"  csidl_PROFILE  :: CInt
-foreign import ccall unsafe "__hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
-foreign import ccall unsafe "__hscore_CSIDL_WINDOWS"  csidl_WINDOWS  :: CInt
-foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
-
-raiseUnsupported :: String -> IO ()
-raiseUnsupported loc = 
-   ioException (ioeSetErrorString (mkIOError UnsupportedOperation loc Nothing Nothing) "unsupported operation")
-
-#endif
-

 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
 -- | Extension for executable files
 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
 -- | Extension for executable files
 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)

diff --git a/cbits/directory.c b/cbits/directory.c
index 6ea722b..97e72d8 100644 (file)
--- a/cbits/directory.c
+++ b/cbits/directory.c
@@ -7,49 +7,5 @@
 #define INLINE
 #include "HsDirectory.h"
 
 #define INLINE
 #include "HsDirectory.h"
 

-/*
- * Function: __hscore_getFolderPath()
- *
- * Late-bound version of SHGetFolderPath(), coping with OS versions
- * that have shell32's lacking that particular API.
- *
- */
-#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
-typedef HRESULT (*HSCORE_GETAPPFOLDERFUNTY)(HWND,int,HANDLE,DWORD,char*);
-int
-__hscore_getFolderPath(HWND hwndOwner,
-                      int nFolder,
-                      HANDLE hToken,
-                      DWORD dwFlags,
-                      char*  pszPath)
-{
-    static int loaded_dll = 0;
-    static HMODULE hMod = (HMODULE)NULL;
-    static HSCORE_GETAPPFOLDERFUNTY funcPtr = NULL;
-    /* The DLLs to try loading entry point from */
-    char* dlls[] = { "shell32.dll", "shfolder.dll" };
-    
-    if (loaded_dll < 0) {
-       return (-1);
-    } else if (loaded_dll == 0) {
-       int i;
-       for(i=0;i < sizeof(dlls); i++) {
-           hMod = LoadLibrary(dlls[i]);
-           if ( hMod != NULL &&
-                (funcPtr = (HSCORE_GETAPPFOLDERFUNTY)GetProcAddress(hMod, "SHGetFolderPathA")) ) {
-               loaded_dll = 1;
-               break;
-           }
-       }
-       if (loaded_dll == 0) {
-           loaded_dll = (-1);
-           return (-1);
-       }
-    }
-    /* OK, if we got this far the function has been bound */
-    return (int)funcPtr(hwndOwner,nFolder,hToken,dwFlags,pszPath);
-    /* ToDo: unload the DLL on shutdown? */
-}
-#endif /* WIN32 */

 #endif /* !__NHC__ */
 
 #endif /* !__NHC__ */
 

diff --git a/include/HsDirectory.h b/include/HsDirectory.h
index e5c4fb3..23f23d4 100644 (file)
--- a/include/HsDirectory.h
+++ b/include/HsDirectory.h
@@ -21,30 +21,12 @@
 #undef PACKAGE_TARNAME
 #undef PACKAGE_VERSION
 
 #undef PACKAGE_TARNAME
 #undef PACKAGE_VERSION
 

-#if HAVE_SYS_TYPES_H
-#include <sys/types.h>
-#endif
-#if HAVE_UNISTD_H
-#include <unistd.h>
-#endif

 #if HAVE_SYS_STAT_H
 #include <sys/stat.h>
 #endif
 
 #include "HsFFI.h"
 
 #if HAVE_SYS_STAT_H
 #include <sys/stat.h>
 #endif
 
 #include "HsFFI.h"
 

-#if defined(__MINGW32__)
-#include <shlobj.h>
-#endif
-
-#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)
-extern int __hscore_getFolderPath(HWND hwndOwner,
-                  int nFolder,
-                  HANDLE hToken,
-                  DWORD dwFlags,
-                  char*  pszPath);
-#endif
-

 /* -----------------------------------------------------------------------------
    INLINE functions.
 
 /* -----------------------------------------------------------------------------
    INLINE functions.
 

@@ -73,38 +55,10 @@ INLINE HsInt __hscore_long_path_size() {
 #endif
 }
 
 #endif
 }
 

-INLINE int __hscore_R_OK() { return R_OK; }
-INLINE int __hscore_W_OK() { return W_OK; }
-INLINE int __hscore_X_OK() { return X_OK; }
-

 INLINE mode_t __hscore_S_IRUSR() { return S_IRUSR; }
 INLINE mode_t __hscore_S_IWUSR() { return S_IWUSR; }
 INLINE mode_t __hscore_S_IXUSR() { return S_IXUSR; }
 INLINE mode_t __hscore_S_IFDIR() { return S_IFDIR; }
 
 INLINE mode_t __hscore_S_IRUSR() { return S_IRUSR; }
 INLINE mode_t __hscore_S_IWUSR() { return S_IWUSR; }
 INLINE mode_t __hscore_S_IXUSR() { return S_IXUSR; }
 INLINE mode_t __hscore_S_IFDIR() { return S_IFDIR; }
 

-#if defined(__MINGW32__)
-
-/* Make sure we've got the reqd CSIDL_ constants in scope;
- * w32api header files are lagging a bit in defining the full set.
- */
-#if !defined(CSIDL_APPDATA)
-#define CSIDL_APPDATA 0x001a
-#endif
-#if !defined(CSIDL_PERSONAL)
-#define CSIDL_PERSONAL 0x0005
-#endif
-#if !defined(CSIDL_PROFILE)
-#define CSIDL_PROFILE 0x0028
-#endif
-#if !defined(CSIDL_WINDOWS)
-#define CSIDL_WINDOWS 0x0024
-#endif
-
-INLINE int __hscore_CSIDL_PROFILE()  { return CSIDL_PROFILE;  }
-INLINE int __hscore_CSIDL_APPDATA()  { return CSIDL_APPDATA;  }
-INLINE int __hscore_CSIDL_WINDOWS()  { return CSIDL_WINDOWS;  }
-INLINE int __hscore_CSIDL_PERSONAL() { return CSIDL_PERSONAL; }
-#endif
-

 #endif /* __HSDIRECTORY_H__ */
 
 #endif /* __HSDIRECTORY_H__ */