2 module Main (main) where
4 import qualified Distribution.ModuleName as ModuleName
5 import Distribution.PackageDescription
6 import Distribution.PackageDescription.Configuration
7 import Distribution.PackageDescription.Parse
8 import Distribution.Simple
9 import Distribution.Simple.Configure
10 import Distribution.Simple.LocalBuildInfo
11 import Distribution.Simple.Program
12 import Distribution.Simple.Utils (defaultPackageDesc, writeFileAtomic)
13 import Distribution.Simple.Build (writeAutogenFiles)
14 import Distribution.Simple.Register
15 import Distribution.Simple.PackageIndex
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'
34 "install" : ghcpkg : ghcpkgconfig : directory : distDir
35 : myDestDir : myPrefix : myLibdir : myDocdir : args' ->
36 doInstall ghcpkg ghcpkgconfig directory distDir
37 myDestDir myPrefix myLibdir myDocdir args'
38 "configure" : args' -> case break (== "--") args' of
39 (config_args, "--" : distdir : directories) ->
40 mapM_ (generate config_args distdir) directories
44 syntax_error :: [String]
46 ["syntax: ghc-cabal configure <configure-args> -- <distdir> <directory>...",
47 " ghc-cabal install <ghc-pkg> <directory> <distdir> <destdir> <prefix> <args>...",
48 " ghc-cabal haddock <distdir> <directory> <args>..."]
50 die :: [String] -> IO ()
51 die errs = do mapM_ (hPutStrLn stderr) errs
52 exitWith (ExitFailure 1)
54 -- XXX Should use bracket
55 withCurrentDirectory :: FilePath -> IO a -> IO a
56 withCurrentDirectory directory io
57 = do curDirectory <- getCurrentDirectory
58 setCurrentDirectory directory
60 setCurrentDirectory curDirectory
63 -- We need to use the autoconfUserHooks, as the packages that use
64 -- configure can create a .buildinfo file, and we need any info that
66 userHooks :: UserHooks
67 userHooks = autoconfUserHooks
69 runHaddock :: FilePath -> FilePath -> [String] -> IO ()
70 runHaddock distdir directory args
71 = withCurrentDirectory directory
72 $ defaultMainWithHooksArgs hooks ("haddock" : "--builddir" : distdir : args)
75 haddockHook = modHook (haddockHook userHooks)
77 modHook f pd lbi us flags
78 | packageName pd == PackageName "ghc-prim"
79 = let pd' = case library pd of
81 let ghcPrim = fromJust (simpleParse "GHC.Prim")
82 ems = filter (ghcPrim /=)
84 lib' = lib { exposedModules = ems }
85 in pd { library = Just lib' }
87 error "Expected a library, but none found"
89 pc' = userSpecifyArgs "haddock"
90 ["dist-install/build/autogen/GHC/Prim.hs"] pc
91 lbi' = lbi { withPrograms = pc' }
92 in f pd' lbi' us flags
96 doInstall :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath
97 -> FilePath -> FilePath -> FilePath -> [String] -> IO ()
98 doInstall ghcpkg ghcpkgconf directory distDir myDestDir myPrefix myLibdir myDocdir args
99 = withCurrentDirectory directory $ do
100 defaultMainWithHooksArgs hooks (["copy", "--builddir", distDir]
101 ++ (if null myDestDir then []
102 else ["--destdir", myDestDir])
104 defaultMainWithHooksArgs hooks ("register" : "--builddir" : distDir : args)
107 copyHook = noGhcPrimHook (modHook (copyHook userHooks)),
108 regHook = modHook (regHook userHooks)
111 noGhcPrimHook f pd lbi us flags
113 | packageName pd == PackageName "ghc-prim" =
116 let ghcPrim = fromJust (simpleParse "GHC.Prim")
117 ems = filter (ghcPrim /=) (exposedModules lib)
118 lib' = lib { exposedModules = ems }
119 in pd { library = Just lib' }
121 error "Expected a library, but none found"
123 in f pd' lbi us flags
124 modHook f pd lbi us flags
125 = let idts = installDirTemplates lbi
126 idts' = idts { prefix = toPathTemplate myPrefix,
127 libdir = toPathTemplate myLibdir,
128 libsubdir = toPathTemplate "$pkgid",
129 docdir = toPathTemplate (myDocdir </> "$pkgid"),
130 htmldir = toPathTemplate "$docdir" }
131 progs = withPrograms lbi
132 prog = ConfiguredProgram {
133 programId = programName ghcPkgProgram,
134 programVersion = Nothing,
135 programArgs = ["--global-conf", ghcpkgconf]
136 ++ if not (null myDestDir)
139 programLocation = UserSpecified ghcpkg
141 progs' = updateProgram prog progs
143 installDirTemplates = idts',
144 withPrograms = progs'
146 in f pd lbi' us flags
148 generate :: [String] -> FilePath -> FilePath -> IO ()
149 generate config_args distdir directory
150 = withCurrentDirectory directory
151 $ do let verbosity = normal
152 gpdFile <- defaultPackageDesc verbosity
153 gpd <- readPackageDescription verbosity gpdFile
155 -- XXX We shouldn't just configure with the default flags
156 -- XXX And this, and thus the "getPersistBuildConfig distdir" below,
157 -- aren't going to work when the deps aren't built yet
158 withArgs (["configure", "--distdir", distdir] ++ config_args)
159 (case buildType (flattenPackageDescription gpd) of
160 Just Configure -> defaultMainWithHooks autoconfUserHooks
161 -- time has a "Custom" Setup.hs, but it's actually Configure
162 -- plus a "./Setup test" hook. However, Cabal is also
163 -- "Custom", but doesn't have a configure script.
165 do configureExists <- doesFileExist "configure"
167 then defaultMainWithHooks autoconfUserHooks
169 -- not quite right, but good enough for us:
172 lbi <- getPersistBuildConfig distdir
173 let pd0 = localPkgDescr lbi
176 if (buildType pd0 == Just Configure) || (buildType pd0 == Just Custom)
178 maybe_infoFile <- defaultHookedPackageDesc
179 case maybe_infoFile of
180 Nothing -> return emptyHookedBuildInfo
181 Just infoFile -> readHookedBuildInfo verbosity infoFile
183 return emptyHookedBuildInfo
185 let pd = updatePackageDescription hooked_bi pd0
187 -- generate Paths_<pkg>.hs and cabal-macros.h
188 writeAutogenFiles verbosity pd lbi
190 -- generate inplace-pkg-config
191 case (library pd, libraryConfig lbi) of
192 (Nothing, Nothing) -> return ()
193 (Just lib, Just clbi) -> do
194 cwd <- getCurrentDirectory
195 let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir
197 content = Installed.showInstalledPackageInfo installedPkgInfo ++ "\n"
198 writeFileAtomic (distdir </> "inplace-pkg-config") content
199 _ -> error "Inconsistent lib components; can't happen?"
202 libBiModules lib = (libBuildInfo lib, libModules lib)
203 exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe)
204 biModuless = (maybeToList $ fmap libBiModules $ library pd)
205 ++ (map exeBiModules $ executables pd)
206 buildableBiModuless = filter isBuildable biModuless
207 where isBuildable (bi', _) = buildable bi'
208 (bi, modules) = case buildableBiModuless of
209 [] -> error "No buildable component found"
210 [biModules] -> biModules
211 _ -> error ("XXX ghc-cabal can't handle " ++
212 "more than one buildinfo yet")
213 -- XXX Another Just...
214 Just ghcProg = lookupProgram ghcProgram (withPrograms lbi)
216 dep_pkgs = PackageIndex.topologicalOrder (packageHacks (installedPkgs lbi))
217 forDeps f = concatMap f dep_pkgs
219 -- copied from Distribution.Simple.PreProcess.ppHsc2Hs
220 packageHacks = case compilerFlavor (compiler lbi) of
221 GHC -> hackRtsPackage
223 -- We don't link in the actual Haskell libraries of our
224 -- dependencies, so the -u flags in the ldOptions of the rts
225 -- package mean linking fails on OS X (it's ld is a tad
226 -- stricter than gnu ld). Thus we remove the ldOptions for
227 -- GHC's rts package:
228 hackRtsPackage index =
229 case PackageIndex.lookupPackageName index (PackageName "rts") of
230 [rts] -> PackageIndex.insert rts { Installed.ldOptions = [] } index
231 _ -> error "No (or multiple) ghc rts package is registered!!"
233 let variablePrefix = directory ++ '_':distdir
234 let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
235 variablePrefix ++ "_MODULES = " ++ unwords (map display modules),
236 variablePrefix ++ "_HS_SRC_DIRS = " ++ unwords (hsSourceDirs bi),
237 variablePrefix ++ "_DEPS = " ++ unwords (map display (externalPackageDeps lbi)),
238 variablePrefix ++ "_DEP_NAMES = " ++ unwords (map (display . packageName) (externalPackageDeps lbi)),
239 variablePrefix ++ "_INCLUDE_DIRS = " ++ unwords (includeDirs bi),
240 variablePrefix ++ "_INCLUDES = " ++ unwords (includes bi),
241 variablePrefix ++ "_INSTALL_INCLUDES = " ++ unwords (installIncludes bi),
242 variablePrefix ++ "_EXTRA_LIBRARIES = " ++ unwords (extraLibs bi),
243 variablePrefix ++ "_EXTRA_LIBDIRS = " ++ unwords (extraLibDirs bi),
244 variablePrefix ++ "_C_SRCS = " ++ unwords (cSources bi),
245 variablePrefix ++ "_CMM_SRCS = $(addprefix cbits/,$(notdir $(wildcard " ++ directory ++ "/cbits/*.cmm)))",
246 -- XXX This includes things it shouldn't, like:
247 -- -odir dist-bootstrapping/build
248 variablePrefix ++ "_HC_OPTS = " ++ escape (unwords
251 ++ extensionsToFlags (compiler lbi) (extensions bi))),
252 variablePrefix ++ "_CC_OPTS = " ++ unwords (ccOptions bi),
253 variablePrefix ++ "_CPP_OPTS = " ++ unwords (cppOptions bi),
254 variablePrefix ++ "_LD_OPTS = " ++ unwords (ldOptions bi),
255 variablePrefix ++ "_DEP_INCLUDE_DIRS = " ++ unwords (forDeps Installed.includeDirs),
256 variablePrefix ++ "_DEP_CC_OPTS = " ++ unwords (forDeps Installed.ccOptions),
257 variablePrefix ++ "_DEP_LIB_DIRS = " ++ unwords (forDeps Installed.libraryDirs),
258 variablePrefix ++ "_DEP_EXTRA_LIBS = " ++ unwords (forDeps Installed.extraLibraries),
259 variablePrefix ++ "_DEP_LD_OPTS = " ++ unwords (forDeps Installed.ldOptions)]
260 writeFile (distdir ++ "/package-data.mk") $ unlines xs
262 escape = foldr (\c xs -> if c == '#' then '\\':'#':xs else c:xs) []