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)
13 import Distribution.Simple.Build (writeAutogenFiles)
14 import Distribution.Simple.Register (writeInstalledConfig)
15 import Distribution.Simple.PackageIndex
16 import Distribution.Text
17 import Distribution.Verbosity
18 import qualified Distribution.InstalledPackageInfo as Installed
19 ( InstalledPackageInfo_(..) )
20 import qualified Distribution.Simple.PackageIndex as PackageIndex
21 ( topologicalOrder, lookupPackageName, insert )
26 import System.Directory
27 import System.Environment
29 import System.FilePath
32 main = do args <- getArgs
34 "haddock" : distDir : dir : args' ->
35 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 runHaddock :: FilePath -> FilePath -> [String] -> IO ()
72 runHaddock distdir directory args
73 = withCurrentDirectory directory
74 $ defaultMainWithHooksArgs hooks ("haddock" : "--builddir" : distdir : args)
77 haddockHook = modHook (haddockHook userHooks)
79 modHook f pd lbi us flags
80 | packageName pd == PackageName "ghc-prim"
81 = let pd' = case library pd of
83 let ghcPrim = fromJust (simpleParse "GHC.Prim")
84 ems = filter (ghcPrim /=)
86 lib' = lib { exposedModules = ems }
87 in pd { library = Just lib' }
89 error "Expected a library, but none found"
91 pc' = userSpecifyArgs "haddock"
92 ["dist-install/build/autogen/GHC/Prim.hs"] pc
93 lbi' = lbi { withPrograms = pc' }
94 in f pd' lbi' us flags
98 doInstall :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath
99 -> FilePath -> FilePath -> FilePath -> [String] -> IO ()
100 doInstall ghcpkg ghcpkgconf directory distDir myDestDir myPrefix myLibdir myDocdir args
101 = withCurrentDirectory directory $ do
102 defaultMainWithHooksArgs hooks (["copy", "--builddir", distDir]
103 ++ (if null myDestDir then []
104 else ["--destdir", myDestDir])
106 defaultMainWithHooksArgs hooks ("register" : "--builddir" : distDir : args)
109 copyHook = noGhcPrimHook (modHook (copyHook userHooks)),
110 regHook = modHook (regHook userHooks)
113 noGhcPrimHook f pd lbi us flags
115 | packageName pd == PackageName "ghc-prim" =
118 let ghcPrim = fromJust (simpleParse "GHC.Prim")
119 ems = filter (ghcPrim /=) (exposedModules lib)
120 lib' = lib { exposedModules = ems }
121 in pd { library = Just lib' }
123 error "Expected a library, but none found"
125 in f pd' lbi us flags
126 modHook f pd lbi us flags
127 = let idts = installDirTemplates lbi
128 idts' = idts { prefix = toPathTemplate myPrefix,
129 libdir = toPathTemplate myLibdir,
130 libsubdir = toPathTemplate "$pkgid",
131 docdir = toPathTemplate (myDocdir </> "$pkgid"),
132 htmldir = toPathTemplate "$docdir" }
133 progs = withPrograms lbi
134 prog = ConfiguredProgram {
135 programId = programName ghcPkgProgram,
136 programVersion = Nothing,
137 programArgs = ["--global-conf", ghcpkgconf]
138 ++ if not (null myDestDir)
141 programLocation = UserSpecified ghcpkg
143 progs' = updateProgram prog progs
145 installDirTemplates = idts',
146 withPrograms = progs'
148 in f pd lbi' us flags
150 generate :: [String] -> FilePath -> FilePath -> IO ()
151 generate config_args distdir directory
152 = withCurrentDirectory directory
153 $ do let verbosity = normal
154 gpdFile <- defaultPackageDesc verbosity
155 gpd <- readPackageDescription verbosity gpdFile
157 -- XXX We shouldn't just configure with the default flags
158 -- XXX And this, and thus the "getPersistBuildConfig distdir" below,
159 -- aren't going to work when the deps aren't built yet
160 withArgs (["configure", "--distdir", distdir] ++ config_args)
161 (case buildType (flattenPackageDescription gpd) of
162 Just Configure -> defaultMainWithHooks autoconfUserHooks
163 _other -> defaultMain)
164 -- not quite right, but good enough for us
166 lbi <- getPersistBuildConfig distdir
167 let pd0 = localPkgDescr lbi
170 if (buildType pd0 == Just Configure) || (buildType pd0 == Just Custom)
172 maybe_infoFile <- defaultHookedPackageDesc
173 case maybe_infoFile of
174 Nothing -> return emptyHookedBuildInfo
175 Just infoFile -> readHookedBuildInfo verbosity infoFile
177 return emptyHookedBuildInfo
179 let pd = updatePackageDescription hooked_bi pd0
181 -- generate Paths_<pkg>.hs and cabal-macros.h
182 writeAutogenFiles verbosity pd lbi
184 -- generate inplace-pkg-config
185 when (isJust $ library pd) $
186 writeInstalledConfig distdir pd lbi True
187 (distdir </> "inplace-pkg-config")
190 libBiModules lib = (libBuildInfo lib, libModules lib)
191 exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe)
192 biModuless = (maybeToList $ fmap libBiModules $ library pd)
193 ++ (map exeBiModules $ executables pd)
194 buildableBiModuless = filter isBuildable biModuless
195 where isBuildable (bi', _) = buildable bi'
196 (bi, modules) = case buildableBiModuless of
197 [] -> error "No buildable component found"
198 [biModules] -> biModules
199 _ -> error ("XXX ghc-cabal can't handle " ++
200 "more than one buildinfo yet")
201 -- XXX Another Just...
202 Just ghcProg = lookupProgram ghcProgram (withPrograms lbi)
204 dep_pkgs = PackageIndex.topologicalOrder (packageHacks (installedPkgs lbi))
205 forDeps f = concatMap f dep_pkgs
207 -- copied from Distribution.Simple.PreProcess.ppHsc2Hs
208 packageHacks = case compilerFlavor (compiler lbi) of
209 GHC -> hackRtsPackage
211 -- We don't link in the actual Haskell libraries of our
212 -- dependencies, so the -u flags in the ldOptions of the rts
213 -- package mean linking fails on OS X (it's ld is a tad
214 -- stricter than gnu ld). Thus we remove the ldOptions for
215 -- GHC's rts package:
216 hackRtsPackage index =
217 case PackageIndex.lookupPackageName index (PackageName "rts") of
218 [rts] -> PackageIndex.insert rts { Installed.ldOptions = [] } index
219 _ -> error "No (or multiple) ghc rts package is registered!!"
221 let variablePrefix = directory ++ '_':distdir
222 let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
223 variablePrefix ++ "_MODULES = " ++ unwords (map display modules),
224 variablePrefix ++ "_HS_SRC_DIRS = " ++ unwords (hsSourceDirs bi),
225 variablePrefix ++ "_DEPS = " ++ unwords (map display (externalPackageDeps lbi)),
226 variablePrefix ++ "_DEP_NAMES = " ++ unwords (map (display . packageName) (externalPackageDeps lbi)),
227 variablePrefix ++ "_INCLUDE_DIRS = " ++ unwords (includeDirs bi),
228 variablePrefix ++ "_INCLUDES = " ++ unwords (includes bi),
229 variablePrefix ++ "_INSTALL_INCLUDES = " ++ unwords (installIncludes bi),
230 variablePrefix ++ "_EXTRA_LIBRARIES = " ++ unwords (extraLibs bi),
231 variablePrefix ++ "_EXTRA_LIBDIRS = " ++ unwords (extraLibDirs bi),
232 variablePrefix ++ "_C_SRCS = " ++ unwords (cSources bi),
233 variablePrefix ++ "_CMM_SRCS = $(addprefix cbits/,$(notdir $(wildcard " ++ directory ++ "/cbits/*.cmm)))",
234 -- XXX This includes things it shouldn't, like:
235 -- -odir dist-bootstrapping/build
236 variablePrefix ++ "_HC_OPTS = " ++ escape (unwords
239 ++ extensionsToFlags (compiler lbi) (extensions bi))),
240 variablePrefix ++ "_CC_OPTS = " ++ unwords (ccOptions bi),
241 variablePrefix ++ "_CPP_OPTS = " ++ unwords (cppOptions bi),
242 variablePrefix ++ "_LD_OPTS = " ++ unwords (ldOptions bi),
243 variablePrefix ++ "_DEP_INCLUDE_DIRS = " ++ unwords (forDeps Installed.includeDirs),
244 variablePrefix ++ "_DEP_CC_OPTS = " ++ unwords (forDeps Installed.ccOptions),
245 variablePrefix ++ "_DEP_LIB_DIRS = " ++ unwords (forDeps Installed.libraryDirs),
246 variablePrefix ++ "_DEP_EXTRA_LIBS = " ++ unwords (forDeps Installed.extraLibraries),
247 variablePrefix ++ "_DEP_LD_OPTS = " ++ unwords (forDeps Installed.ldOptions)]
248 writeFile (distdir ++ "/package-data.mk") $ unlines xs
250 escape = foldr (\c xs -> if c == '#' then '\\':'#':xs else c:xs) []