import Hugs.Directory
#endif /* __HUGS__ */
+#if defined(__GLASGOW_HASKELL__) || defined(mingw32_HOST_OS)
+import Foreign
+import Foreign.C
+#endif
+
#ifdef __GLASGOW_HASKELL__
import Prelude
import System.Posix.Internals
import System.Time ( ClockTime(..) )
import System.IO
-import Foreign
-import Foreign.C
import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )
peekCString pOutPath
#if defined(mingw32_HOST_OS)
-foreign import stdcall unsafe "GetFullPathName"
+foreign import stdcall unsafe "GetFullPathNameA"
c_GetFullPathName :: CString
-> CInt
-> CString
-- such executable. For example (findExecutable \"ghc\")
-- gives you the path to GHC.
findExecutable :: String -> IO (Maybe FilePath)
-findExecutable binary = do
+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
+# if !defined(__GLASGOW_HASKELL__)
+long_path_size :: Int
+long_path_size = 4096
+# endif
+#else
+ do
path <- getEnv "PATH"
search (parseSearchPath path)
where
b <- doesFileExist path
if b then return (Just path)
else search ds
+#endif
+
#ifdef __GLASGOW_HASKELL__
{- |@'getDirectoryContents' dir@ returns a list of /all/ entries
foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: CInt
foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt
-foreign import stdcall unsafe "GetTempPath" c_GetTempPath :: CInt -> CString -> IO CInt
+foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt
raiseUnsupported loc =
ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)