Just lib_path -> return (DLL (lib ++ "_dyn"))
Nothing -> return (DLL lib) }} -- We assume
where
- mk_obj_path dir = dir ++ '/':lib ++ ".o"
- mk_dyn_lib_path dir = dir ++ '/':mkSOName (lib ++ "_dyn")
+ mk_obj_path dir = dir `joinFileName` (lib `joinFileExt` "o")
+ mk_dyn_lib_path dir = dir `joinFileName` mkSOName (lib ++ "_dyn")
-- ----------------------------------------------------------------------------
-- Tried all our known library paths, so let
-- dlopen() search its own builtin paths now.
where
- mk_dll_path dir = dir ++ '/':mkSOName rootname
+ mk_dll_path dir = dir `joinFileName` mkSOName rootname
#if defined(darwin_TARGET_OS)
-mkSOName root = "lib" ++ root ++ ".dylib"
+mkSOName root = ("lib" ++ root) `joinFileExt` "dylib"
#elif defined(mingw32_TARGET_OS)
-- Win32 DLLs have no .dll extension here, because addDLL tries
-- both foo.dll and foo.drv
mkSOName root = root
#else
-mkSOName root = "lib" ++ root ++ ".so"
+mkSOName root = ("lib" ++ root) `joinFileExt` "so"
#endif
-- Darwin / MacOS X only: load a framework
-- Tried all our known library paths, but dlopen()
-- has no built-in paths for frameworks: give up
where
- mk_fwk dir = dir ++ '/' : rootname ++ ".framework/" ++ rootname
+ mk_fwk dir = dir `joinFileName` (rootname ++ ".framework/" ++ rootname)
-- sorry for the hardcoded paths, I hope they won't change anytime soon:
defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"]
#endif
| path <- paths,
(ext,fn) <- exts,
let base | path == "." = basename
- | otherwise = path ++ '/':basename
+ | otherwise = path `joinFileName` basename
file = base `joinFileExt` ext
]
mkHomeModLocationSearched :: DynFlags -> Module -> FileExt
-> FilePath -> BaseName -> IO FinderCacheEntry
mkHomeModLocationSearched dflags mod suff path basename = do
- loc <- mkHomeModLocation2 dflags mod (path ++ '/':basename) suff
+ loc <- mkHomeModLocation2 dflags mod (path `joinFileName` basename) suff
return (loc, Nothing)
mkHiOnlyModLocation :: DynFlags -> FileExt -> FilePath -> BaseName
hiOnlyModLocation :: DynFlags -> FilePath -> String -> Suffix -> IO ModLocation
hiOnlyModLocation dflags path basename hisuf
- = do let full_basename = path++'/':basename
+ = do let full_basename = path `joinFileName` basename
obj_fn <- mkObjPath dflags full_basename basename
return ModLocation{ ml_hs_file = Nothing,
ml_hi_file = full_basename `joinFileExt` hisuf,
odir = outputDir dflags
osuf = objectSuf dflags
- obj_basename | Just dir <- odir = dir ++ '/':mod_basename
+ obj_basename | Just dir <- odir = dir `joinFileName` mod_basename
| otherwise = basename
return (obj_basename `joinFileExt` osuf)
hidir = hiDir dflags
hisuf = hiSuf dflags
- hi_basename | Just dir <- hidir = dir ++ '/':mod_basename
+ hi_basename | Just dir <- hidir = dir `joinFileName` mod_basename
| otherwise = basename
return (hi_basename `joinFileExt` hisuf)
(exists, pkgconf) <- catch (do
appdir <- getAppUserDataDirectory "ghc"
let
- pkgconf = appdir ++ '/':TARGET_ARCH ++ '-':TARGET_OS
- ++ '-':cProjectVersion ++ "/package.conf"
+ pkgconf = appdir
+ `joinFileName` (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
+ `joinFileName` "package.conf"
flg <- doesFileExist pkgconf
return (flg, pkgconf))
-- gobble them all up and turn into False.
import Outputable
import ErrUtils ( putMsg, debugTraceMsg )
import Panic ( GhcException(..) )
-import Util ( Suffix, global, notNull, consIORef,
- normalisePath, pgmPath, platformPath )
+import Util ( Suffix, global, notNull, consIORef, joinFileName,
+ normalisePath, pgmPath, platformPath, joinFileExt )
import DynFlags ( DynFlags(..), DynFlag(..), dopt, Option(..),
setTmpDir, defaultDynFlags )
; let installed, installed_bin :: FilePath -> FilePath
installed_bin pgm = pgmPath top_dir pgm
installed file = pgmPath top_dir file
- inplace dir pgm = pgmPath (top_dir `slash`
- cPROJECT_DIR `slash` dir) pgm
+ inplace dir pgm = pgmPath (top_dir `joinFileName`
+ cPROJECT_DIR `joinFileName` dir) pgm
; let pkgconfig_path
| am_installed = installed "package.conf"
= do { top_dir <- get_proto
-- Discover whether we're running in a build tree or in an installation,
-- by looking for the package configuration file.
- ; am_installed <- doesFileExist (top_dir `slash` "package.conf")
+ ; am_installed <- doesFileExist (top_dir `joinFileName` "package.conf")
; return (am_installed, top_dir)
}
findTempName (tmp_dir ++ "/ghc" ++ show x ++ "_") 0
where
findTempName prefix x
- = do let filename = prefix ++ show x ++ '.':extn
+ = do let filename = (prefix ++ show x) `joinFileExt` extn
b <- doesFileExist filename
if b then findTempName prefix (x+1)
else do consIORef v_FilesToClean filename -- clean it up later
; throwDyn (PhaseFailed phase_name (ExitFailure 1)) }
\end{code}
------------------------------------------------------------------------------
- Path name construction
-
-\begin{code}
-slash :: String -> String -> String
-slash s1 s2 = s1 ++ ('/' : s2)
-\end{code}
-
-
%************************************************************************
%* *
\subsection{Support code}
-- Filename utils
Suffix,
- splitFilename, getFileSuffix, splitFilenameDir, joinFileExt,
+ splitFilename, getFileSuffix, splitFilenameDir, joinFileExt, joinFileName,
splitFilename3, removeSuffix,
dropLongestPrefix, takeLongestPrefix, splitLongestPrefix,
replaceFilenameSuffix, directoryOf, filenameOf,
-- --------------------------------------------------------------
-- Filename manipulation
+-- Filenames are kept "normalised" inside GHC, using '/' as the path
+-- separator. On Windows these functions will also recognise '\\' as
+-- the path separator, but will generally construct paths using '/'.
+
type Suffix = String
splitFilename :: String -> (String,Suffix)
-- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext")
splitFilename3 :: String -> (String,String,Suffix)
splitFilename3 str
- = let (dir, rest) = splitLongestPrefix str isPathSeparator
- (dir', rest') | null rest = (".", dir)
- | otherwise = (dir, rest)
- (name, ext) = splitFilename rest'
- in (dir', name, ext)
+ = let (dir, rest) = splitFilenameDir str
+ (name, ext) = splitFilename rest
+ in (dir, name, ext)
+
+joinFileName :: String -> String -> FilePath
+joinFileName "" fname = fname
+joinFileName "." fname = fname
+joinFileName dir "" = dir
+joinFileName dir fname = dir ++ '/':fname
removeSuffix :: Char -> String -> Suffix
removeSuffix c s = takeLongestPrefix s (==c)
-- last character).
--
-- If 'pred' returns False for all characters in the string, the original
--- string is returned in the second component (and the first one is just
+-- string is returned in the first component (and the second one is just
-- empty).
splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
splitLongestPrefix s pred
(_:pre) -> (reverse pre, reverse suf)
where (suf,pre) = break pred (reverse s)
+basenameOf :: FilePath -> String
+basenameOf = fst . splitFilename
+
+suffixOf :: FilePath -> Suffix
+suffixOf = snd . splitFilename
+
replaceFilenameSuffix :: FilePath -> Suffix -> FilePath
-replaceFilenameSuffix s suf = removeSuffix '.' s ++ '.':suf
+replaceFilenameSuffix file suf = basenameOf file `joinFileExt` suf
-- directoryOf strips the filename off the input string, returning
-- the directory.
filenameOf = snd . splitFilenameDir
replaceFilenameDirectory :: FilePath -> String -> FilePath
-replaceFilenameDirectory s dir
- = dir ++ '/':dropLongestPrefix s isPathSeparator
+replaceFilenameDirectory path dir = dir `joinFileName` filenameOf path
escapeSpaces :: String -> String
escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""
projects / ghc-hetmet.git / commitdiff