+
+
+-----------------------------------------
+-- Modified version from ghc/compiler/SysTools
+-- Convert paths foo/baz to foo\baz on Windows
+
+subst :: Char -> Char -> String -> String
+#if defined(mingw32_HOST_OS) || defined(__CYGWIN32__)
+subst a b = map (\x -> if x == a then b else x)
+#else
+subst _ _ = id
+#endif
+
+dosifyPath :: String -> String
+dosifyPath = subst '/' '\\'
+
+-- (getExecDir cmd) returns the directory in which the current
+-- executable, which should be called 'cmd', is running
+-- So if the full path is /a/b/c/d/e, and you pass "d/e" as cmd,
+-- you'll get "/a/b/c" back as the result
+getExecDir :: String -> IO (Maybe String)
+getExecDir cmd =
+ getExecPath >>= maybe (return Nothing) removeCmdSuffix
+ where unDosifyPath = subst '\\' '/'
+ initN n = reverse . drop n . reverse
+ removeCmdSuffix = return . Just . initN (length cmd) . unDosifyPath
+
+getExecPath :: IO (Maybe String)
+#if defined(__HUGS__)
+getExecPath = liftM Just getProgName
+#elif 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
+#else
+getExecPath = return Nothing
+#endif