2 module Main (main) where
4 import qualified Distribution.ModuleName as ModuleName
5 import Distribution.PackageDescription
6 import Distribution.PackageDescription.Check hiding (doesFileExist)
7 import Distribution.PackageDescription.Configuration
8 import Distribution.PackageDescription.Parse
9 import Distribution.Simple
10 import Distribution.Simple.Configure
11 import Distribution.Simple.LocalBuildInfo
12 import Distribution.Simple.Program
13 import Distribution.Simple.Utils (defaultPackageDesc, writeFileAtomic)
14 import Distribution.Simple.Build (writeAutogenFiles)
15 import Distribution.Simple.Register
16 import Distribution.Text
17 import Distribution.Verbosity
18 import qualified Distribution.InstalledPackageInfo as Installed
19 import qualified Distribution.Simple.PackageIndex as PackageIndex
24 import System.Directory
25 import System.Environment
27 import System.FilePath
31 main = do args <- getArgs
33 "haddock" : distDir : dir : args' ->
34 runHaddock distDir dir args'
37 "install" : ghc : ghcpkg : topdir : directory : distDir
38 : myDestDir : myPrefix : myLibdir : myDocdir : args' ->
39 doInstall ghc ghcpkg topdir directory distDir
40 myDestDir myPrefix myLibdir myDocdir args'
41 "configure" : args' -> case break (== "--") args' of
42 (config_args, "--" : distdir : directories) ->
43 mapM_ (generate config_args distdir) directories
47 syntax_error :: [String]
49 ["syntax: ghc-cabal configure <configure-args> -- <distdir> <directory>...",
50 " ghc-cabal install <ghc-pkg> <directory> <distdir> <destdir> <prefix> <args>...",
51 " ghc-cabal haddock <distdir> <directory> <args>..."]
53 die :: [String] -> IO ()
54 die errs = do mapM_ (hPutStrLn stderr) errs
55 exitWith (ExitFailure 1)
57 -- XXX Should use bracket
58 withCurrentDirectory :: FilePath -> IO a -> IO a
59 withCurrentDirectory directory io
60 = do curDirectory <- getCurrentDirectory
61 setCurrentDirectory directory
63 setCurrentDirectory curDirectory
66 -- We need to use the autoconfUserHooks, as the packages that use
67 -- configure can create a .buildinfo file, and we need any info that
69 userHooks :: UserHooks
70 userHooks = autoconfUserHooks
72 doCheck :: FilePath -> IO ()
74 = withCurrentDirectory directory
75 $ do let verbosity = normal
76 gpdFile <- defaultPackageDesc verbosity
77 gpd <- readPackageDescription verbosity gpdFile
78 case partition isFailure $ checkPackage gpd Nothing of
80 ([], warnings) -> mapM_ print warnings
81 (errs, _) -> do mapM_ print errs
82 exitWith (ExitFailure 1)
83 where isFailure (PackageDistSuspicious {}) = False
86 runHaddock :: FilePath -> FilePath -> [String] -> IO ()
87 runHaddock distdir directory args
88 = withCurrentDirectory directory
89 $ defaultMainWithHooksArgs hooks ("haddock" : "--builddir" : distdir : args)
92 haddockHook = modHook (haddockHook userHooks)
94 modHook f pd lbi us flags
95 | packageName pd == PackageName "ghc-prim"
96 = let pd' = case library pd of
98 let ghcPrim = fromJust (simpleParse "GHC.Prim")
99 ems = filter (ghcPrim /=)
101 lib' = lib { exposedModules = ems }
102 in pd { library = Just lib' }
104 error "Expected a library, but none found"
105 pc = withPrograms lbi
106 pc' = userSpecifyArgs "haddock"
107 ["dist-install/build/autogen/GHC/Prim.hs"] pc
108 lbi' = lbi { withPrograms = pc' }
109 in f pd' lbi' us flags
113 doInstall :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath
114 -> FilePath -> FilePath -> FilePath -> FilePath -> [String]
116 doInstall ghc ghcpkg topdir directory distDir myDestDir myPrefix myLibdir myDocdir args
117 = withCurrentDirectory directory $ do
118 defaultMainWithHooksArgs hooks (["copy", "--builddir", distDir]
119 ++ (if null myDestDir then []
120 else ["--destdir", myDestDir])
122 defaultMainWithHooksArgs hooks ("register" : "--builddir" : distDir : args)
125 copyHook = noGhcPrimHook (modHook (copyHook userHooks)),
126 regHook = modHook (regHook userHooks)
129 noGhcPrimHook f pd lbi us flags
131 | packageName pd == PackageName "ghc-prim" =
134 let ghcPrim = fromJust (simpleParse "GHC.Prim")
135 ems = filter (ghcPrim /=) (exposedModules lib)
136 lib' = lib { exposedModules = ems }
137 in pd { library = Just lib' }
139 error "Expected a library, but none found"
141 in f pd' lbi us flags
142 modHook f pd lbi us flags
143 = let idts = installDirTemplates lbi
144 idts' = idts { prefix = toPathTemplate myPrefix,
145 libdir = toPathTemplate myLibdir,
146 libsubdir = toPathTemplate "$pkgid",
147 docdir = toPathTemplate (myDocdir </> "$pkg"),
148 htmldir = toPathTemplate "$docdir" }
149 progs = withPrograms lbi
150 ghcProg = ConfiguredProgram {
151 programId = programName ghcProgram,
152 programVersion = Nothing,
153 programArgs = ["-B" ++ topdir],
154 programLocation = UserSpecified ghc
156 ghcpkgconf = topdir </> "package.conf"
157 ghcPkgProg = ConfiguredProgram {
158 programId = programName ghcPkgProgram,
159 programVersion = Nothing,
160 programArgs = ["--global-conf",
162 ++ if not (null myDestDir)
165 programLocation = UserSpecified ghcpkg
167 progs' = updateProgram ghcProg
168 $ updateProgram ghcPkgProg progs
170 installDirTemplates = idts',
171 withPrograms = progs'
173 in f pd lbi' us flags
175 generate :: [String] -> FilePath -> FilePath -> IO ()
176 generate config_args distdir directory
177 = withCurrentDirectory directory
178 $ do let verbosity = normal
179 gpdFile <- defaultPackageDesc verbosity
180 gpd <- readPackageDescription verbosity gpdFile
182 -- XXX We shouldn't just configure with the default flags
183 -- XXX And this, and thus the "getPersistBuildConfig distdir" below,
184 -- aren't going to work when the deps aren't built yet
185 withArgs (["configure", "--distdir", distdir] ++ config_args)
186 (case buildType (flattenPackageDescription gpd) of
187 Just Configure -> defaultMainWithHooks autoconfUserHooks
188 -- time has a "Custom" Setup.hs, but it's actually Configure
189 -- plus a "./Setup test" hook. However, Cabal is also
190 -- "Custom", but doesn't have a configure script.
192 do configureExists <- doesFileExist "configure"
194 then defaultMainWithHooks autoconfUserHooks
196 -- not quite right, but good enough for us:
199 lbi <- getPersistBuildConfig distdir
200 let pd0 = localPkgDescr lbi
203 if (buildType pd0 == Just Configure) || (buildType pd0 == Just Custom)
205 maybe_infoFile <- defaultHookedPackageDesc
206 case maybe_infoFile of
207 Nothing -> return emptyHookedBuildInfo
208 Just infoFile -> readHookedBuildInfo verbosity infoFile
210 return emptyHookedBuildInfo
212 let pd = updatePackageDescription hooked_bi pd0
214 -- generate Paths_<pkg>.hs and cabal-macros.h
215 writeAutogenFiles verbosity pd lbi
217 -- generate inplace-pkg-config
218 case (library pd, libraryConfig lbi) of
219 (Nothing, Nothing) -> return ()
220 (Just lib, Just clbi) -> do
221 cwd <- getCurrentDirectory
222 let ipid = InstalledPackageId (display (packageId pd) ++ "-inplace")
223 let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir
225 final_ipi = installedPkgInfo{ Installed.installedPackageId = ipid }
226 content = Installed.showInstalledPackageInfo final_ipi ++ "\n"
227 writeFileAtomic (distdir </> "inplace-pkg-config") content
228 _ -> error "Inconsistent lib components; can't happen?"
231 libBiModules lib = (libBuildInfo lib, libModules lib)
232 exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe)
233 biModuless = (maybeToList $ fmap libBiModules $ library pd)
234 ++ (map exeBiModules $ executables pd)
235 buildableBiModuless = filter isBuildable biModuless
236 where isBuildable (bi', _) = buildable bi'
237 (bi, modules) = case buildableBiModuless of
238 [] -> error "No buildable component found"
239 [biModules] -> biModules
240 _ -> error ("XXX ghc-cabal can't handle " ++
241 "more than one buildinfo yet")
242 -- XXX Another Just...
243 Just ghcProg = lookupProgram ghcProgram (withPrograms lbi)
245 dep_pkgs = PackageIndex.topologicalOrder (packageHacks (installedPkgs lbi))
246 forDeps f = concatMap f dep_pkgs
248 -- copied from Distribution.Simple.PreProcess.ppHsc2Hs
249 packageHacks = case compilerFlavor (compiler lbi) of
250 GHC -> hackRtsPackage
252 -- We don't link in the actual Haskell libraries of our
253 -- dependencies, so the -u flags in the ldOptions of the rts
254 -- package mean linking fails on OS X (it's ld is a tad
255 -- stricter than gnu ld). Thus we remove the ldOptions for
256 -- GHC's rts package:
257 hackRtsPackage index =
258 case PackageIndex.lookupInstalledPackageByName index (PackageName "rts") of
259 [rts] -> PackageIndex.addToInstalledPackageIndex rts { Installed.ldOptions = [] } index
260 _ -> error "No (or multiple) ghc rts package is registered!!"
262 dep_ids = map (packageId.getLocalPackageInfo lbi) $
263 externalPackageDeps lbi
265 let variablePrefix = directory ++ '_':distdir
266 let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
267 variablePrefix ++ "_MODULES = " ++ unwords (map display modules),
268 variablePrefix ++ "_HS_SRC_DIRS = " ++ unwords (hsSourceDirs bi),
269 variablePrefix ++ "_DEPS = " ++ unwords (map display dep_ids),
270 variablePrefix ++ "_DEP_NAMES = " ++ unwords (map (display . packageName) dep_ids),
271 variablePrefix ++ "_INCLUDE_DIRS = " ++ unwords (includeDirs bi),
272 variablePrefix ++ "_INCLUDES = " ++ unwords (includes bi),
273 variablePrefix ++ "_INSTALL_INCLUDES = " ++ unwords (installIncludes bi),
274 variablePrefix ++ "_EXTRA_LIBRARIES = " ++ unwords (extraLibs bi),
275 variablePrefix ++ "_EXTRA_LIBDIRS = " ++ unwords (extraLibDirs bi),
276 variablePrefix ++ "_C_SRCS = " ++ unwords (cSources bi),
277 variablePrefix ++ "_CMM_SRCS = $(addprefix cbits/,$(notdir $(wildcard " ++ directory ++ "/cbits/*.cmm)))",
278 -- XXX This includes things it shouldn't, like:
279 -- -odir dist-bootstrapping/build
280 variablePrefix ++ "_HC_OPTS = " ++ escape (unwords
283 ++ extensionsToFlags (compiler lbi) (extensions bi))),
284 variablePrefix ++ "_CC_OPTS = " ++ unwords (ccOptions bi),
285 variablePrefix ++ "_CPP_OPTS = " ++ unwords (cppOptions bi),
286 variablePrefix ++ "_LD_OPTS = " ++ unwords (ldOptions bi),
287 variablePrefix ++ "_DEP_INCLUDE_DIRS = " ++ unwords (forDeps Installed.includeDirs),
288 variablePrefix ++ "_DEP_CC_OPTS = " ++ unwords (forDeps Installed.ccOptions),
289 variablePrefix ++ "_DEP_LIB_DIRS = " ++ unwords (forDeps Installed.libraryDirs),
290 variablePrefix ++ "_DEP_EXTRA_LIBS = " ++ unwords (forDeps Installed.extraLibraries),
291 variablePrefix ++ "_DEP_LD_OPTS = " ++ unwords (forDeps Installed.ldOptions)]
292 writeFile (distdir ++ "/package-data.mk") $ unlines xs
294 escape = foldr (\c xs -> if c == '#' then '\\':'#':xs else c:xs) []