From: Simon Marlow Date: Mon, 29 Jun 2009 11:26:04 +0000 (+0000) Subject: move Win32 SearchPath and SHGetFolderPath into the Win32 package X-Git-Tag: ghc-darcs-git-switchover~21 X-Git-Url: http://git.megacz.com/?p=haskell-directory.git;a=commitdiff_plain;h=d7117d2b7b7c89bb57eb21b24bf9f80da63d38b0 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 --- 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 -#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 @@ -727,24 +720,7 @@ makeRelativeToCurrentDirectory x = do 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" @@ -994,10 +970,6 @@ fileNameEndClean :: String -> String 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 @@ -1036,15 +1008,16 @@ cannot be found. -} getHomeDirectory :: IO FilePath getHomeDirectory = + modifyIOError ((`ioeSetLocation` "getHomeDirectory")) $ do #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 @@ -1078,12 +1051,10 @@ cannot be found. -} getAppUserDataDirectory :: String -> IO FilePath getAppUserDataDirectory appName = do + modifyIOError ((`ioeSetLocation` "getAppUserDataDirectory")) $ do #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) @@ -1112,11 +1083,9 @@ cannot be found. -} getUserDocumentsDirectory :: IO FilePath getUserDocumentsDirectory = do + modifyIOError ((`ioeSetLocation` "getUserDocumentsDirectory")) $ do #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 @@ -1161,25 +1130,6 @@ getTemporaryDirectory = do #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) diff --git a/cbits/directory.c b/cbits/directory.c index 6ea722b..97e72d8 100644 --- a/cbits/directory.c +++ b/cbits/directory.c @@ -7,49 +7,5 @@ #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__ */ diff --git a/include/HsDirectory.h b/include/HsDirectory.h index e5c4fb3..23f23d4 100644 --- a/include/HsDirectory.h +++ b/include/HsDirectory.h @@ -21,30 +21,12 @@ #undef PACKAGE_TARNAME #undef PACKAGE_VERSION -#if HAVE_SYS_TYPES_H -#include -#endif -#if HAVE_UNISTD_H -#include -#endif #if HAVE_SYS_STAT_H #include #endif #include "HsFFI.h" -#if defined(__MINGW32__) -#include -#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. @@ -73,38 +55,10 @@ INLINE HsInt __hscore_long_path_size() { #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; } -#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__ */