main :: IO ()
main = do args <- getArgs
case args of
- "haddock" : distDir : dir : args' ->
- runHaddock distDir dir args'
+ "hscolour" : distDir : dir : args' ->
+ runHsColour distDir dir args'
"check" : dir : [] ->
doCheck dir
- "install" : ghc : ghcpkg : topdir : directory : distDir
- : myDestDir : myPrefix : myLibdir : myDocdir : args' ->
- doInstall ghc ghcpkg topdir directory distDir
- myDestDir myPrefix myLibdir myDocdir args'
+ "install" : ghc : ghcpkg : strip : topdir : directory : distDir
+ : myDestDir : myPrefix : myLibdir : myDocdir
+ : relocatableBuild : args' ->
+ doInstall ghc ghcpkg strip topdir directory distDir
+ myDestDir myPrefix myLibdir myDocdir
+ relocatableBuild args'
"configure" : args' -> case break (== "--") args' of
(config_args, "--" : distdir : directories) ->
mapM_ (generate config_args distdir) directories
_ -> die syntax_error
+ "sdist" : dir : distDir : [] ->
+ doSdist dir distDir
_ -> die syntax_error
syntax_error :: [String]
syntax_error =
["syntax: ghc-cabal configure <configure-args> -- <distdir> <directory>...",
" ghc-cabal install <ghc-pkg> <directory> <distdir> <destdir> <prefix> <args>...",
- " ghc-cabal haddock <distdir> <directory> <args>..."]
+ " ghc-cabal hscolour <distdir> <directory> <args>..."]
-die :: [String] -> IO ()
+die :: [String] -> IO a
die errs = do mapM_ (hPutStrLn stderr) errs
exitWith (ExitFailure 1)
userHooks :: UserHooks
userHooks = autoconfUserHooks
+runDefaultMain :: IO ()
+runDefaultMain
+ = do let verbosity = normal
+ gpdFile <- defaultPackageDesc verbosity
+ gpd <- readPackageDescription verbosity gpdFile
+ case buildType (flattenPackageDescription gpd) of
+ Just Configure -> defaultMainWithHooks autoconfUserHooks
+ -- time has a "Custom" Setup.hs, but it's actually Configure
+ -- plus a "./Setup test" hook. However, Cabal is also
+ -- "Custom", but doesn't have a configure script.
+ Just Custom ->
+ do configureExists <- doesFileExist "configure"
+ if configureExists
+ then defaultMainWithHooks autoconfUserHooks
+ else defaultMain
+ -- not quite right, but good enough for us:
+ _ -> defaultMain
+
+doSdist :: FilePath -> FilePath -> IO ()
+doSdist directory distDir
+ = withCurrentDirectory directory
+ $ withArgs (["sdist", "--builddir", distDir])
+ runDefaultMain
+
doCheck :: FilePath -> IO ()
doCheck directory
= withCurrentDirectory directory
where isFailure (PackageDistSuspicious {}) = False
isFailure _ = True
-runHaddock :: FilePath -> FilePath -> [String] -> IO ()
-runHaddock distdir directory args
+runHsColour :: FilePath -> FilePath -> [String] -> IO ()
+runHsColour distdir directory args
= withCurrentDirectory directory
- $ defaultMainWithHooksArgs hooks ("haddock" : "--builddir" : distdir : args)
- where
- hooks = userHooks {
- haddockHook = modHook (haddockHook userHooks)
- }
- modHook f pd lbi us flags
- | packageName pd == PackageName "ghc-prim"
- = let pd' = case library pd of
- Just lib ->
- let ghcPrim = fromJust (simpleParse "GHC.Prim")
- ems = filter (ghcPrim /=)
- (exposedModules lib)
- lib' = lib { exposedModules = ems }
- in pd { library = Just lib' }
- Nothing ->
- error "Expected a library, but none found"
- pc = withPrograms lbi
- pc' = userSpecifyArgs "haddock"
- ["dist-install/build/autogen/GHC/Prim.hs"] pc
- lbi' = lbi { withPrograms = pc' }
- in f pd' lbi' us flags
- | otherwise
- = f pd lbi us flags
+ $ defaultMainArgs ("hscolour" : "--builddir" : distdir : args)
doInstall :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath
- -> FilePath -> FilePath -> FilePath -> FilePath -> [String]
+ -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath
+ -> String -> [String]
-> IO ()
-doInstall ghc ghcpkg topdir directory distDir myDestDir myPrefix myLibdir myDocdir args
+doInstall ghc ghcpkg strip topdir directory distDir
+ myDestDir myPrefix myLibdir myDocdir
+ relocatableBuildStr args
= withCurrentDirectory directory $ do
- defaultMainWithHooksArgs hooks (["copy", "--builddir", distDir]
- ++ (if null myDestDir then []
- else ["--destdir", myDestDir])
- ++ args)
- defaultMainWithHooksArgs hooks ("register" : "--builddir" : distDir : args)
- where
- hooks = userHooks {
- copyHook = noGhcPrimHook (modHook (copyHook userHooks)),
- regHook = modHook (regHook userHooks)
- }
+ relocatableBuild <- case relocatableBuildStr of
+ "YES" -> return True
+ "NO" -> return False
+ _ -> die ["Bad relocatableBuildStr: " ++
+ show relocatableBuildStr]
+ let copyArgs = ["copy", "--builddir", distDir]
+ ++ (if null myDestDir
+ then []
+ else ["--destdir", myDestDir])
+ ++ args
+ regArgs = "register" : "--builddir" : distDir : args
+ copyHooks = userHooks {
+ copyHook = noGhcPrimHook
+ $ modHook False
+ $ copyHook userHooks
+ }
+ regHooks = userHooks {
+ regHook = modHook relocatableBuild
+ $ regHook userHooks
+ }
+ defaultMainWithHooksArgs copyHooks copyArgs
+ defaultMainWithHooksArgs regHooks regArgs
+ where
noGhcPrimHook f pd lbi us flags
= let pd'
| packageName pd == PackageName "ghc-prim" =
error "Expected a library, but none found"
| otherwise = pd
in f pd' lbi us flags
- modHook f pd lbi us flags
+ modHook relocatableBuild f pd lbi us flags
= do let verbosity = normal
idts = installDirTemplates lbi
- idts' = idts { prefix = toPathTemplate myPrefix,
- libdir = toPathTemplate myLibdir,
- libsubdir = toPathTemplate "$pkgid",
- docdir = toPathTemplate (myDocdir </> "$pkg"),
- htmldir = toPathTemplate "$docdir" }
+ idts' = idts {
+ prefix = toPathTemplate $
+ if relocatableBuild
+ then "$topdir"
+ else myPrefix,
+ libdir = toPathTemplate $
+ if relocatableBuild
+ then "$topdir"
+ else myLibdir,
+ libsubdir = toPathTemplate "$pkgid",
+ docdir = toPathTemplate $
+ if relocatableBuild
+ then "$topdir/../doc/html/libraries/$pkgid"
+ else (myDocdir </> "$pkgid"),
+ htmldir = toPathTemplate "$docdir"
+ }
progs = withPrograms lbi
ghcProg = ConfiguredProgram {
programId = programName ghcProgram,
programVersion = Nothing,
- programArgs = ["-B" ++ topdir],
+ programDefaultArgs = ["-B" ++ topdir],
+ programOverrideArgs = [],
programLocation = UserSpecified ghc
}
ghcpkgconf = topdir </> "package.conf.d"
ghcPkgProg = ConfiguredProgram {
programId = programName ghcPkgProgram,
programVersion = Nothing,
- programArgs = ["--global-conf",
- ghcpkgconf]
+ programDefaultArgs = ["--global-conf",
+ ghcpkgconf]
++ if not (null myDestDir)
then ["--force"]
else [],
+ programOverrideArgs = [],
programLocation = UserSpecified ghcpkg
}
+ stripProg = ConfiguredProgram {
+ programId = programName stripProgram,
+ programVersion = Nothing,
+ programDefaultArgs = [],
+ programOverrideArgs = [],
+ programLocation = UserSpecified strip
+ }
progs' = updateProgram ghcProg
- $ updateProgram ghcPkgProg progs
+ $ updateProgram ghcPkgProg
+ $ updateProgram stripProg
+ progs
instInfos <- dump verbosity ghcPkgProg GlobalPackageDB
- let installedPkgs' = PackageIndex.listToInstalledPackageIndex
- instInfos
+ let installedPkgs' = PackageIndex.fromList instInfos
let mlc = libraryConfig lbi
mlc' = case mlc of
Just lc ->
- let cipds = componentInstalledPackageDeps lc
- cipds' = map (fixupPackageId instInfos) cipds
+ let cipds = componentPackageDeps lc
+ cipds' = [ (fixupPackageId instInfos ipid, pid)
+ | (ipid,pid) <- cipds ]
in Just $ lc {
- componentInstalledPackageDeps = cipds'
+ componentPackageDeps = cipds'
}
Nothing -> Nothing
lbi' = lbi {
-> InstalledPackageId
-> InstalledPackageId
fixupPackageId _ x@(InstalledPackageId ipi)
- | "builtin:" `isPrefixOf` ipi = x
+ | "builtin_" `isPrefixOf` ipi = x
fixupPackageId ipinfos (InstalledPackageId ipi)
= case stripPrefix (reverse "-inplace") $ reverse ipi of
Nothing ->
generate config_args distdir directory
= withCurrentDirectory directory
$ do let verbosity = normal
- gpdFile <- defaultPackageDesc verbosity
- gpd <- readPackageDescription verbosity gpdFile
-
-- XXX We shouldn't just configure with the default flags
-- XXX And this, and thus the "getPersistBuildConfig distdir" below,
-- aren't going to work when the deps aren't built yet
withArgs (["configure", "--distdir", distdir] ++ config_args)
- (case buildType (flattenPackageDescription gpd) of
- Just Configure -> defaultMainWithHooks autoconfUserHooks
- -- time has a "Custom" Setup.hs, but it's actually Configure
- -- plus a "./Setup test" hook. However, Cabal is also
- -- "Custom", but doesn't have a configure script.
- Just Custom ->
- do configureExists <- doesFileExist "configure"
- if configureExists
- then defaultMainWithHooks autoconfUserHooks
- else defaultMain
- -- not quite right, but good enough for us:
- _ -> defaultMain)
+ runDefaultMain
lbi <- getPersistBuildConfig distdir
let pd0 = localPkgDescr lbi
let ipid = InstalledPackageId (display (packageId pd) ++ "-inplace")
let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir
pd lib lbi clbi
- final_ipi = installedPkgInfo{ Installed.installedPackageId = ipid }
+ final_ipi = installedPkgInfo {
+ Installed.installedPackageId = ipid,
+ Installed.haddockHTMLs = ["../" ++ display (packageId pd)]
+ }
content = Installed.showInstalledPackageInfo final_ipi ++ "\n"
writeFileAtomic (distdir </> "inplace-pkg-config") content
_ -> error "Inconsistent lib components; can't happen?"
-- stricter than gnu ld). Thus we remove the ldOptions for
-- GHC's rts package:
hackRtsPackage index =
- case PackageIndex.lookupInstalledPackageByName index (PackageName "rts") of
- [rts] -> PackageIndex.addToInstalledPackageIndex rts { Installed.ldOptions = [] } index
+ case PackageIndex.lookupPackageName index (PackageName "rts") of
+ [(_,[rts])] ->
+ PackageIndex.insert rts{
+ Installed.ldOptions = [],
+ Installed.libraryDirs = filter (not . ("gcc-lib" `isSuffixOf`)) (Installed.libraryDirs rts)} index
+ -- GHC <= 6.12 had $topdir/gcc-lib in their
+ -- library-dirs for the rts package, which causes
+ -- problems when we try to use the in-tree mingw,
+ -- due to accidentally picking up the incompatible
+ -- libraries there. So we filter out gcc-lib from
+ -- the RTS's library-dirs here.
_ -> error "No (or multiple) ghc rts package is registered!!"
- dep_ids = map (packageId.getLocalPackageInfo lbi) $
- externalPackageDeps lbi
+ dep_ids = map snd (externalPackageDeps lbi)
let variablePrefix = directory ++ '_':distdir
let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
variablePrefix ++ "_MODULES = " ++ unwords (map display modules),
+ variablePrefix ++ "_HIDDEN_MODULES = " ++ unwords (map display (otherModules bi)),
+ variablePrefix ++ "_SYNOPSIS =" ++ synopsis pd,
variablePrefix ++ "_HS_SRC_DIRS = " ++ unwords (hsSourceDirs bi),
variablePrefix ++ "_DEPS = " ++ unwords (map display dep_ids),
variablePrefix ++ "_DEP_NAMES = " ++ unwords (map (display . packageName) dep_ids),
variablePrefix ++ "_EXTRA_LIBDIRS = " ++ unwords (extraLibDirs bi),
variablePrefix ++ "_C_SRCS = " ++ unwords (cSources bi),
variablePrefix ++ "_CMM_SRCS = $(addprefix cbits/,$(notdir $(wildcard " ++ directory ++ "/cbits/*.cmm)))",
+ variablePrefix ++ "_DATA_FILES = " ++ unwords (dataFiles pd),
-- XXX This includes things it shouldn't, like:
-- -odir dist-bootstrapping/build
- variablePrefix ++ "_HC_OPTS = " ++ escape (unwords
- (programArgs ghcProg
+ variablePrefix ++ "_HC_OPTS = " ++ escape (unwords
+ ( programDefaultArgs ghcProg
++ hcOptions GHC bi
- ++ extensionsToFlags (compiler lbi) (extensions bi))),
+ ++ extensionsToFlags (compiler lbi) (extensions bi)
+ ++ programOverrideArgs ghcProg)),
variablePrefix ++ "_CC_OPTS = " ++ unwords (ccOptions bi),
variablePrefix ++ "_CPP_OPTS = " ++ unwords (cppOptions bi),
variablePrefix ++ "_LD_OPTS = " ++ unwords (ldOptions bi),
- variablePrefix ++ "_DEP_INCLUDE_DIRS = " ++ unwords (forDeps Installed.includeDirs),
+ variablePrefix ++ "_DEP_INCLUDE_DIRS = " ++ unwords (wrap $ forDeps Installed.includeDirs),
variablePrefix ++ "_DEP_CC_OPTS = " ++ unwords (forDeps Installed.ccOptions),
- variablePrefix ++ "_DEP_LIB_DIRS = " ++ unwords (forDeps Installed.libraryDirs),
+ variablePrefix ++ "_DEP_LIB_DIRS = " ++ unwords (wrap $ forDeps Installed.libraryDirs),
variablePrefix ++ "_DEP_EXTRA_LIBS = " ++ unwords (forDeps Installed.extraLibraries),
variablePrefix ++ "_DEP_LD_OPTS = " ++ unwords (forDeps Installed.ldOptions)]
writeFile (distdir ++ "/package-data.mk") $ unlines xs
+ writeFile (distdir ++ "/haddock-prologue.txt") $
+ if null (description pd) then synopsis pd
+ else description pd
where
escape = foldr (\c xs -> if c == '#' then '\\':'#':xs else c:xs) []
-
+ wrap = map (\s -> "\'" ++ s ++ "\'")
projects / ghc-hetmet.git / blobdiff