-----------------------------------------------------------------------------
--- $Id: SysTools.lhs,v 1.54 2001/08/17 12:43:24 sewardj Exp $
--
-- (c) The University of Glasgow 2001
--
-- NB: top_dir is assumed to be in standard Unix format '/' separated
; let installed, installed_bin :: FilePath -> FilePath
- installed_bin pgm = pgmPath (top_dir `slash` "extra-bin") pgm
+ installed_bin pgm = pgmPath top_dir pgm
installed file = pgmPath top_dir file
inplace dir pgm = pgmPath (top_dir `slash` dir) pgm
setTmpDir dir
return ()
)
+#else
+ -- On Win32, consult GetTempPath() for a temp dir.
+ -- => it first tries TMP, TEMP, then finally the
+ -- Windows directory(!). The directory is in short-path
+ -- form and *does* have a trailing backslash.
+ ; IO.try (do
+ let len = (2048::Int)
+ buf <- mallocArray len
+ ret <- getTempPath len buf
+ tdir <-
+ if ret == 0 then do
+ -- failed, consult TEMP.
+ destructArray len buf
+ getEnv "TMP"
+ else do
+ s <- peekCString buf
+ destructArray len buf
+ return s
+ let
+ -- strip the trailing backslash (awful, but
+ -- we only do this once).
+ tmpdir =
+ case last tdir of
+ '/' -> init tdir
+ '\\' -> init tdir
+ _ -> tdir
+ setTmpDir tmpdir
+ return ())
#endif
-- Check that the package config exists
; return ()
}
+
+#if defined(mingw32_TARGET_OS)
+foreign import stdcall "GetTempPathA" getTempPath :: Int -> CString -> IO Int32
+#endif
\end{code}
setPgm is called when a command-line option like
this type gives us a handle on transforming filenames, and filenames only,
to whatever format they're expected to be on a particular platform.]
-
\begin{code}
data Option
- = FileOption String
+ = FileOption -- an entry that _contains_ filename(s) / filepaths.
+ String -- a non-filepath prefix that shouldn't be transformed (e.g., "/out="
+ String -- the filepath/filename portion
| Option String
showOptions :: [Option] -> String
showOptions ls = unwords (map (quote.showOpt) ls)
where
- showOpt (FileOption f) = dosifyPath f
+ showOpt (FileOption pre f) = pre ++ dosifyPath f
showOpt (Option s) = s
#if defined(mingw32_TARGET_OS)
touch :: String -> String -> IO ()
touch purpose arg = do p <- readIORef v_Pgm_T
- runSomething purpose p [FileOption arg]
+ runSomething purpose p [FileOption "" arg]
copy :: String -> String -> String -> IO ()
copy purpose from to = do
slash :: String -> String -> String
absPath, relPath :: [String] -> String
-isSlash '/' = True
-isSlash other = False
-
relPath [] = ""
relPath xs = foldr1 slash xs
#if defined(mingw32_TARGET_OS)
getExecDir :: IO (Maybe String)
-getExecDir = do let len = 2048 -- plenty, PATH_MAX is 512 under Win32.
- buf <- mallocArray (fromIntegral len)
+getExecDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
+ buf <- mallocArray len
ret <- getModuleFileName nullAddr buf len
- if ret == 0 then return Nothing
+ if ret == 0 then destructArray len buf >> return Nothing
else do s <- peekCString buf
- destructArray (fromIntegral len) buf
+ destructArray len buf
return (Just (reverse (drop (length "/bin/ghc.exe") (reverse (unDosifyPath s)))))
-foreign import stdcall "GetModuleFileNameA" getModuleFileName :: Addr -> CString -> Int32 -> IO Int32
+foreign import stdcall "GetModuleFileNameA" getModuleFileName :: Addr -> CString -> Int -> IO Int32
#else
getExecDir :: IO (Maybe String) = do return Nothing
#endif