Unicode fix for getExecPath on Windows
authorMax Bolingbroke <batterseapower@hotmail.com>
Sat, 14 May 2011 21:35:19 +0000 (22:35 +0100)
committerMax Bolingbroke <batterseapower@hotmail.com>
Sat, 14 May 2011 21:35:19 +0000 (22:35 +0100)
Main.hs

diff --git a/Main.hs b/Main.hs
index c2c281a..33324f2 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -220,15 +220,17 @@ getExecDir cmd =
 
 getExecPath :: IO (Maybe String)
 #if defined(mingw32_HOST_OS)
-getExecPath =
-     allocaArray len $ \buf -> do
-         ret <- getModuleFileName nullPtr buf len
-         if ret == 0 then return Nothing
-                    else liftM Just $ peekCString buf
-    where len = 2048 -- Plenty, PATH_MAX is 512 under Win32.
-
-foreign import stdcall unsafe "GetModuleFileNameA"
-    getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
+getExecPath = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
+  where
+    try_size size = allocaArray (fromIntegral size) $ \buf -> do
+        ret <- c_GetModuleFileName nullPtr buf size
+        case ret of
+          0 -> return Nothing
+          _ | ret < size -> fmap Just $ peekCWString buf
+            | otherwise  -> try_size (size * 2)
+
+foreign import stdcall unsafe "windows.h GetModuleFileNameW"
+  c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
 #else
 getExecPath = return Nothing
 #endif