import Distribution.ParseUtils ( showError )
import Distribution.Package
import Distribution.Version
-import Compat.Directory ( getAppUserDataDirectory )
+import Compat.Directory ( getAppUserDataDirectory, createDirectoryIfMissing )
+import Compat.RawSystem ( rawSystem )
import Control.Exception ( evaluate )
import qualified Control.Exception as Exception
+import System.FilePath ( joinFileName )
import Prelude
import Monad
import Directory
import System ( getArgs, getProgName,
- system, exitWith,
- ExitCode(..)
+ exitWith, ExitCode(..)
)
import System.IO
import Data.List ( isPrefixOf, isSuffixOf, intersperse )
-#include "../../includes/ghcconfig.h"
-
-#ifdef mingw32_HOST_OS
+#ifdef mingw32_TARGET_OS
import Foreign
#if __GLASGOW_HASKELL__ >= 504
bye (usageInfo (usageHeader prog) flags)
(cli,_,[]) | FlagVersion `elem` cli ->
bye ourCopyright
- (cli@(_:_),nonopts,[]) ->
+ (cli,nonopts,[]) ->
runit cli nonopts
(_,_,errors) -> tryOldCmdLine errors args
let
subdir = targetARCH ++ '-':targetOS ++ '-':version
- user_conf = appdir `joinFileName` subdir `joinFileName` "package.conf"
+ archdir = appdir `joinFileName` subdir
+ user_conf = archdir `joinFileName` "package.conf"
b <- doesFileExist user_conf
when (not b) $ do
putStrLn ("Creating user package database in " ++ user_conf)
- createParents user_conf
+ createDirectoryIfMissing True archdir
writeFile user_conf emptyPackageConfig
let
batch_lib_file = dir ++ '/':batch_file
hPutStr stderr ("building GHCi library " ++ ghci_lib_file ++ "...")
#if defined(darwin_TARGET_OS)
- r <- system("ld -r -x -o " ++ ghci_lib_file ++
- " -all_load " ++ batch_lib_file)
+ r <- rawSystem "ld" ["-r","-x","-o",ghci_lib_file,"-all_load",batch_lib_file]
#elif defined(mingw32_HOST_OS)
execDir <- getExecDir "/bin/ghc-pkg.exe"
- r <- system (maybe "" (++"/gcc-lib/") execDir++"ld -r -x -o " ++
- ghci_lib_file ++ " --whole-archive " ++ batch_lib_file)
+ r <- rawSystem (maybe "" (++"/gcc-lib/") execDir++"ld") ["-r","-x","-o",ghci_lib_file,"--whole-archive",batch_lib_file]
#else
- r <- system("ld -r -x -o " ++ ghci_lib_file ++
- " --whole-archive " ++ batch_lib_file)
+ r <- rawSystem "ld" ["-r","-x","-o",ghci_lib_file,"--whole-archive",batch_lib_file]
#endif
when (r /= ExitSuccess) $ exitWith r
hPutStrLn stderr (" done.")
| otherwise = die s
------------------------------------------------------------------------------
--- Create a hierarchy of directories
-
-createParents :: FilePath -> IO ()
-createParents dir = do
- let parent = directoryOf dir
- b <- doesDirectoryExist parent
- when (not b) $ do
- createParents parent
- createDirectory parent
-
-----------------------------------------
-- Cut and pasted from ghc/compiler/SysTools
-#if defined(mingw32_HOST_OS)
+#if defined(mingw32_TARGET_OS)
subst a b ls = map (\ x -> if x == a then b else x) ls
unDosifyPath xs = subst '\\' '/' xs
getExecDir :: String -> IO (Maybe String)
getExecDir _ = return Nothing
#endif
-
--- -----------------------------------------------------------------------------
--- Utils from Krasimir's FilePath library, copied here for now
-
-directoryOf :: FilePath -> FilePath
-directoryOf = fst.splitFileName
-
-splitFileName :: FilePath -> (String, String)
-splitFileName p = (reverse (path2++drive), reverse fname)
- where
-#ifdef mingw32_TARGET_OS
- (path,drive) = break (== ':') (reverse p)
-#else
- (path,drive) = (reverse p,"")
-#endif
- (fname,path1) = break isPathSeparator path
- path2 = case path1 of
- [] -> "."
- [_] -> path1 -- don't remove the trailing slash if
- -- there is only one character
- (c:path) | isPathSeparator c -> path
- _ -> path1
-
-joinFileName :: String -> String -> FilePath
-joinFileName "" fname = fname
-joinFileName "." fname = fname
-joinFileName dir fname
- | isPathSeparator (last dir) = dir++fname
- | otherwise = dir++pathSeparator:fname
-
-isPathSeparator :: Char -> Bool
-isPathSeparator ch =
-#ifdef mingw32_TARGET_OS
- ch == '/' || ch == '\\'
-#else
- ch == '/'
-#endif
-
-pathSeparator :: Char
-#ifdef mingw32_TARGET_OS
-pathSeparator = '\\'
-#else
-pathSeparator = '/'
-#endif