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