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
30 main = do args <- getArgs
32 "haddock" : distDir : dir : args' ->
33 runHaddock distDir dir args'
36 "install" : ghcpkg : ghcpkgconfig : directory : distDir
37 : myDestDir : myPrefix : myLibdir : myDocdir : args' ->
38 doInstall ghcpkg ghcpkgconfig directory distDir
39 myDestDir myPrefix myLibdir myDocdir args'
40 "configure" : args' -> case break (== "--") args' of
41 (config_args, "--" : distdir : directories) ->
42 mapM_ (generate config_args distdir) directories
46 syntax_error :: [String]
48 ["syntax: ghc-cabal configure <configure-args> -- <distdir> <directory>...",
49 " ghc-cabal install <ghc-pkg> <directory> <distdir> <destdir> <prefix> <args>...",
50 " ghc-cabal haddock <distdir> <directory> <args>..."]
52 die :: [String] -> IO ()
53 die errs = do mapM_ (hPutStrLn stderr) errs
54 exitWith (ExitFailure 1)
56 -- XXX Should use bracket
57 withCurrentDirectory :: FilePath -> IO a -> IO a
58 withCurrentDirectory directory io
59 = do curDirectory <- getCurrentDirectory
60 setCurrentDirectory directory
62 setCurrentDirectory curDirectory
65 -- We need to use the autoconfUserHooks, as the packages that use
66 -- configure can create a .buildinfo file, and we need any info that
68 userHooks :: UserHooks
69 userHooks = autoconfUserHooks
71 doCheck :: FilePath -> IO ()
73 = withCurrentDirectory directory
74 $ do let verbosity = normal
75 gpdFile <- defaultPackageDesc verbosity
76 gpd <- readPackageDescription verbosity gpdFile
77 case partition isFailure $ checkPackage gpd Nothing of
79 ([], warnings) -> mapM_ print warnings
80 (errs, _) -> do mapM_ print errs
81 exitWith (ExitFailure 1)
82 where isFailure (PackageDistSuspicious {}) = False
85 runHaddock :: FilePath -> FilePath -> [String] -> IO ()
86 runHaddock distdir directory args
87 = withCurrentDirectory directory
88 $ defaultMainWithHooksArgs hooks ("haddock" : "--builddir" : distdir : args)
91 haddockHook = modHook (haddockHook userHooks)
93 modHook f pd lbi us flags
94 | packageName pd == PackageName "ghc-prim"
95 = let pd' = case library pd of
97 let ghcPrim = fromJust (simpleParse "GHC.Prim")
98 ems = filter (ghcPrim /=)
100 lib' = lib { exposedModules = ems }
101 in pd { library = Just lib' }
103 error "Expected a library, but none found"
104 pc = withPrograms lbi
105 pc' = userSpecifyArgs "haddock"
106 ["dist-install/build/autogen/GHC/Prim.hs"] pc
107 lbi' = lbi { withPrograms = pc' }
108 in f pd' lbi' us flags
112 doInstall :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath
113 -> FilePath -> FilePath -> FilePath -> [String] -> IO ()
114 doInstall ghcpkg ghcpkgconf directory distDir myDestDir myPrefix myLibdir myDocdir args
115 = withCurrentDirectory directory $ do
116 defaultMainWithHooksArgs hooks (["copy", "--builddir", distDir]
117 ++ (if null myDestDir then []
118 else ["--destdir", myDestDir])
120 defaultMainWithHooksArgs hooks ("register" : "--builddir" : distDir : args)
123 copyHook = noGhcPrimHook (modHook (copyHook userHooks)),
124 regHook = modHook (regHook userHooks)
127 noGhcPrimHook f pd lbi us flags
129 | packageName pd == PackageName "ghc-prim" =
132 let ghcPrim = fromJust (simpleParse "GHC.Prim")
133 ems = filter (ghcPrim /=) (exposedModules lib)
134 lib' = lib { exposedModules = ems }
135 in pd { library = Just lib' }
137 error "Expected a library, but none found"
139 in f pd' lbi us flags
140 modHook f pd lbi us flags
141 = let idts = installDirTemplates lbi
142 idts' = idts { prefix = toPathTemplate myPrefix,
143 libdir = toPathTemplate myLibdir,
144 libsubdir = toPathTemplate "$pkgid",
145 docdir = toPathTemplate (myDocdir </> "$pkg"),
146 htmldir = toPathTemplate "$docdir" }
147 progs = withPrograms lbi
148 prog = ConfiguredProgram {
149 programId = programName ghcPkgProgram,
150 programVersion = Nothing,
151 programArgs = ["--global-conf", ghcpkgconf]
152 ++ if not (null myDestDir)
155 programLocation = UserSpecified ghcpkg
157 progs' = updateProgram prog progs
159 installDirTemplates = idts',
160 withPrograms = progs'
162 in f pd lbi' us flags
164 generate :: [String] -> FilePath -> FilePath -> IO ()
165 generate config_args distdir directory
166 = withCurrentDirectory directory
167 $ do let verbosity = normal
168 gpdFile <- defaultPackageDesc verbosity
169 gpd <- readPackageDescription verbosity gpdFile
171 -- XXX We shouldn't just configure with the default flags
172 -- XXX And this, and thus the "getPersistBuildConfig distdir" below,
173 -- aren't going to work when the deps aren't built yet
174 withArgs (["configure", "--distdir", distdir] ++ config_args)
175 (case buildType (flattenPackageDescription gpd) of
176 Just Configure -> defaultMainWithHooks autoconfUserHooks
177 -- time has a "Custom" Setup.hs, but it's actually Configure
178 -- plus a "./Setup test" hook. However, Cabal is also
179 -- "Custom", but doesn't have a configure script.
181 do configureExists <- doesFileExist "configure"
183 then defaultMainWithHooks autoconfUserHooks
185 -- not quite right, but good enough for us:
188 lbi <- getPersistBuildConfig distdir
189 let pd0 = localPkgDescr lbi
192 if (buildType pd0 == Just Configure) || (buildType pd0 == Just Custom)
194 maybe_infoFile <- defaultHookedPackageDesc
195 case maybe_infoFile of
196 Nothing -> return emptyHookedBuildInfo
197 Just infoFile -> readHookedBuildInfo verbosity infoFile
199 return emptyHookedBuildInfo
201 let pd = updatePackageDescription hooked_bi pd0
203 -- generate Paths_<pkg>.hs and cabal-macros.h
204 writeAutogenFiles verbosity pd lbi
206 -- generate inplace-pkg-config
207 case (library pd, libraryConfig lbi) of
208 (Nothing, Nothing) -> return ()
209 (Just lib, Just clbi) -> do
210 cwd <- getCurrentDirectory
211 let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir
213 content = Installed.showInstalledPackageInfo installedPkgInfo ++ "\n"
214 writeFileAtomic (distdir </> "inplace-pkg-config") content
215 _ -> error "Inconsistent lib components; can't happen?"
218 libBiModules lib = (libBuildInfo lib, libModules lib)
219 exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe)
220 biModuless = (maybeToList $ fmap libBiModules $ library pd)
221 ++ (map exeBiModules $ executables pd)
222 buildableBiModuless = filter isBuildable biModuless
223 where isBuildable (bi', _) = buildable bi'
224 (bi, modules) = case buildableBiModuless of
225 [] -> error "No buildable component found"
226 [biModules] -> biModules
227 _ -> error ("XXX ghc-cabal can't handle " ++
228 "more than one buildinfo yet")
229 -- XXX Another Just...
230 Just ghcProg = lookupProgram ghcProgram (withPrograms lbi)
232 dep_pkgs = PackageIndex.topologicalOrder (packageHacks (installedPkgs lbi))
233 forDeps f = concatMap f dep_pkgs
235 -- copied from Distribution.Simple.PreProcess.ppHsc2Hs
236 packageHacks = case compilerFlavor (compiler lbi) of
237 GHC -> hackRtsPackage
239 -- We don't link in the actual Haskell libraries of our
240 -- dependencies, so the -u flags in the ldOptions of the rts
241 -- package mean linking fails on OS X (it's ld is a tad
242 -- stricter than gnu ld). Thus we remove the ldOptions for
243 -- GHC's rts package:
244 hackRtsPackage index =
245 case PackageIndex.lookupPackageName index (PackageName "rts") of
246 [rts] -> PackageIndex.insert rts { Installed.ldOptions = [] } index
247 _ -> error "No (or multiple) ghc rts package is registered!!"
249 let variablePrefix = directory ++ '_':distdir
250 let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
251 variablePrefix ++ "_MODULES = " ++ unwords (map display modules),
252 variablePrefix ++ "_HS_SRC_DIRS = " ++ unwords (hsSourceDirs bi),
253 variablePrefix ++ "_DEPS = " ++ unwords (map display (externalPackageDeps lbi)),
254 variablePrefix ++ "_DEP_NAMES = " ++ unwords (map (display . packageName) (externalPackageDeps lbi)),
255 variablePrefix ++ "_INCLUDE_DIRS = " ++ unwords (includeDirs bi),
256 variablePrefix ++ "_INCLUDES = " ++ unwords (includes bi),
257 variablePrefix ++ "_INSTALL_INCLUDES = " ++ unwords (installIncludes bi),
258 variablePrefix ++ "_EXTRA_LIBRARIES = " ++ unwords (extraLibs bi),
259 variablePrefix ++ "_EXTRA_LIBDIRS = " ++ unwords (extraLibDirs bi),
260 variablePrefix ++ "_C_SRCS = " ++ unwords (cSources bi),
261 variablePrefix ++ "_CMM_SRCS = $(addprefix cbits/,$(notdir $(wildcard " ++ directory ++ "/cbits/*.cmm)))",
262 -- XXX This includes things it shouldn't, like:
263 -- -odir dist-bootstrapping/build
264 variablePrefix ++ "_HC_OPTS = " ++ escape (unwords
267 ++ extensionsToFlags (compiler lbi) (extensions bi))),
268 variablePrefix ++ "_CC_OPTS = " ++ unwords (ccOptions bi),
269 variablePrefix ++ "_CPP_OPTS = " ++ unwords (cppOptions bi),
270 variablePrefix ++ "_LD_OPTS = " ++ unwords (ldOptions bi),
271 variablePrefix ++ "_DEP_INCLUDE_DIRS = " ++ unwords (forDeps Installed.includeDirs),
272 variablePrefix ++ "_DEP_CC_OPTS = " ++ unwords (forDeps Installed.ccOptions),
273 variablePrefix ++ "_DEP_LIB_DIRS = " ++ unwords (forDeps Installed.libraryDirs),
274 variablePrefix ++ "_DEP_EXTRA_LIBS = " ++ unwords (forDeps Installed.extraLibraries),
275 variablePrefix ++ "_DEP_LD_OPTS = " ++ unwords (forDeps Installed.ldOptions)]
276 writeFile (distdir ++ "/package-data.mk") $ unlines xs
278 escape = foldr (\c xs -> if c == '#' then '\\':'#':xs else c:xs) []