[commit: Cabal] master: Unicode: use wide APIs on Windows and withFilePath on GHC (b1ae6a1)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/b1ae6a1b0875b7eb32c7e0ccdd062241578328dc

>---------------------------------------------------------------

commit b1ae6a1b0875b7eb32c7e0ccdd062241578328dc
Author: Max Bolingbroke <batterseapower at hotmail.com>
Date:   Mon Apr 11 21:07:58 2011 +0000

    Unicode: use wide APIs on Windows and withFilePath on GHC

>---------------------------------------------------------------

 Distribution/Compat/CopyFile.hs          |   11 +++++++++--
 Distribution/Simple/Build/PathsModule.hs |   28 ++++++++++++++--------------
 Distribution/Simple/InstallDirs.hs       |   10 +++++-----
 3 files changed, 28 insertions(+), 21 deletions(-)

diff --git a/Distribution/Compat/CopyFile.hs b/Distribution/Compat/CopyFile.hs
index 3f0dba8..c8a5be0 100644
--- a/Distribution/Compat/CopyFile.hs
+++ b/Distribution/Compat/CopyFile.hs
@@ -40,12 +40,15 @@ import Foreign
 #endif /* __GLASGOW_HASKELL__ */
 
 #ifndef mingw32_HOST_OS
+#if __GLASGOW_HASKELL__ >= 611
+import System.Posix.Internals (withFilePath)
+#else
+import Foreign.C              (withCString)
+#endif
 import System.Posix.Types
          ( FileMode )
 import System.Posix.Internals
          ( c_chmod )
-import Foreign.C
-         ( withCString )
 #if __GLASGOW_HASKELL__ >= 608
 import Foreign.C
          ( throwErrnoPathIfMinus1_ )
@@ -66,7 +69,11 @@ setFileExecutable path = setFileMode path 0o755 -- file perms -rwxr-xr-x
 
 setFileMode :: FilePath -> FileMode -> IO ()
 setFileMode name m =
+#if __GLASGOW_HASKELL__ >= 611
+  withFilePath name $ \s -> do
+#else
   withCString name $ \s -> do
+#endif
 #if __GLASGOW_HASKELL__ >= 608
     throwErrnoPathIfMinus1_ "setFileMode" name (c_chmod s m)
 #else
diff --git a/Distribution/Simple/Build/PathsModule.hs b/Distribution/Simple/Build/PathsModule.hs
index 1edbded..eec847d 100644
--- a/Distribution/Simple/Build/PathsModule.hs
+++ b/Distribution/Simple/Build/PathsModule.hs
@@ -192,21 +192,21 @@ pkgPathEnvVar pkg_descr var =
 
 get_prefix_win32 :: String
 get_prefix_win32 =
-  "getPrefixDirRel :: FilePath -> IO FilePath\n"++
-  "getPrefixDirRel dirRel = do \n"++
-  "  let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.\n"++
-  "  buf <- mallocArray len\n"++
-  "  ret <- getModuleFileName nullPtr buf len\n"++
-  "  if ret == 0 \n"++
-  "     then do free buf;\n"++
-  "             return (prefix `joinFileName` dirRel)\n"++
-  "     else do exePath <- peekCString buf\n"++
-  "             free buf\n"++
-  "             let (bindir,_) = splitFileName exePath\n"++
-  "             return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)\n"++
+  "getPrefixDirRel dirRel = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.\n"++
+  "  where\n"++
+  "    try_size size = allocaArray (fromIntegral size) $ \\buf -> do\n"++
+  "        ret <- c_GetModuleFileName nullPtr buf size\n"++
+  "        case ret of\n"++
+  "          0 -> return (prefix `joinFileName` dirRel)\n"++
+  "          _ | ret < size -> do\n"++
+  "              exePath <- peekCWString buf\n"++
+  "              let (bindir,_) = splitFileName exePath\n"++
+  "              return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)\n"++
+  "            | otherwise  -> try_size (size * 2)\n"++
   "\n"++
-  "foreign import stdcall unsafe \"windows.h GetModuleFileNameA\"\n"++
-  "  getModuleFileName :: Ptr () -> CString -> Int -> IO Int32\n"
+  "foreign import stdcall unsafe \"windows.h GetModuleFileNameW\"\n"++
+  "  c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32\n"
+
 
 get_prefix_hugs :: String
 get_prefix_hugs =
diff --git a/Distribution/Simple/InstallDirs.hs b/Distribution/Simple/InstallDirs.hs
index b9b240f..a191711 100644
--- a/Distribution/Simple/InstallDirs.hs
+++ b/Distribution/Simple/InstallDirs.hs
@@ -560,13 +560,13 @@ shGetFolderPath n =
 # if __HUGS__
   return Nothing
 # else
-  allocaBytes long_path_size $ \pPath -> do
+  allocaArray long_path_size $ \pPath -> do
      r <- c_SHGetFolderPath nullPtr n nullPtr 0 pPath
      if (r /= 0)
         then return Nothing
-        else do s <- peekCString pPath; return (Just s)
+        else do s <- peekCWString pPath; return (Just s)
   where
-    long_path_size      = 1024
+    long_path_size      = 1024 -- MAX_PATH is 260, this should be plenty
 # endif
 
 csidl_PROGRAM_FILES :: CInt
@@ -574,12 +574,12 @@ csidl_PROGRAM_FILES = 0x0026
 -- csidl_PROGRAM_FILES_COMMON :: CInt
 -- csidl_PROGRAM_FILES_COMMON = 0x002b
 
-foreign import stdcall unsafe "shlobj.h SHGetFolderPathA"
+foreign import stdcall unsafe "shlobj.h SHGetFolderPathW"
             c_SHGetFolderPath :: Ptr ()
                               -> CInt
                               -> Ptr ()
                               -> CInt
-                              -> CString
+                              -> CWString
                               -> IO CInt
 #endif