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.Text
16 import Distribution.Verbosity
17 import qualified Distribution.InstalledPackageInfo as Installed
18 ( InstalledPackageInfo_(..) )
19 import qualified Distribution.Simple.PackageIndex as PackageIndex
20 ( topologicalOrder, lookupPackageName, insert )
25 import System.Directory
26 import System.Environment
28 import System.FilePath
31 main = do args <- getArgs
33 "haddock" : distDir : dir : args' ->
34 runHaddock distDir dir args'
35 "install" : ghcpkg : ghcpkgconfig : directory : distDir
36 : myDestDir : myPrefix : myLibdir : myDocdir : args' ->
37 doInstall ghcpkg ghcpkgconfig directory distDir
38 myDestDir myPrefix myLibdir myDocdir args'
39 "configure" : args' -> case break (== "--") args' of
40 (config_args, "--" : distdir : directories) ->
41 mapM_ (generate config_args distdir) directories
45 syntax_error :: [String]
47 ["syntax: ghc-cabal configure <configure-args> -- <distdir> <directory>...",
48 " ghc-cabal install <ghc-pkg> <directory> <distdir> <destdir> <prefix> <args>...",
49 " ghc-cabal haddock <distdir> <directory> <args>..."]
51 die :: [String] -> IO ()
52 die errs = do mapM_ (hPutStrLn stderr) errs
53 exitWith (ExitFailure 1)
55 -- XXX Should use bracket
56 withCurrentDirectory :: FilePath -> IO a -> IO a
57 withCurrentDirectory directory io
58 = do curDirectory <- getCurrentDirectory
59 setCurrentDirectory directory
61 setCurrentDirectory curDirectory
64 -- We need to use the autoconfUserHooks, as the packages that use
65 -- configure can create a .buildinfo file, and we need any info that
67 userHooks :: UserHooks
68 userHooks = autoconfUserHooks
70 runHaddock :: FilePath -> FilePath -> [String] -> IO ()
71 runHaddock distdir directory args
72 = withCurrentDirectory directory
73 $ defaultMainWithHooksArgs hooks ("haddock" : "--builddir" : distdir : args)
76 haddockHook = modHook (haddockHook userHooks)
78 modHook f pd lbi us flags
79 | packageName pd == PackageName "ghc-prim"
80 = let pd' = case library pd of
82 let ghcPrim = fromJust (simpleParse "GHC.Prim")
83 ems = filter (ghcPrim /=)
85 lib' = lib { exposedModules = ems }
86 in pd { library = Just lib' }
88 error "Expected a library, but none found"
90 pc' = userSpecifyArgs "haddock"
91 ["dist-install/build/autogen/GHC/Prim.hs"] pc
92 lbi' = lbi { withPrograms = pc' }
93 in f pd' lbi' us flags
97 doInstall :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath
98 -> FilePath -> FilePath -> FilePath -> [String] -> IO ()
99 doInstall ghcpkg ghcpkgconf directory distDir myDestDir myPrefix myLibdir myDocdir args
100 = withCurrentDirectory directory $ do
101 defaultMainWithHooksArgs hooks (["copy", "--builddir", distDir]
102 ++ (if null myDestDir then []
103 else ["--destdir", myDestDir])
105 defaultMainWithHooksArgs hooks ("register" : "--builddir" : distDir : args)
108 copyHook = modHook (copyHook userHooks),
109 regHook = modHook (regHook userHooks)
112 modHook 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 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 = verbose
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 _other -> defaultMain)
162 -- not quite right, but good enough for us
164 lbi <- getPersistBuildConfig distdir
165 let pd0 = localPkgDescr lbi
168 if (buildType pd0 == Just Configure)
170 maybe_infoFile <- defaultHookedPackageDesc
171 case maybe_infoFile of
172 Nothing -> return emptyHookedBuildInfo
173 Just infoFile -> readHookedBuildInfo verbosity infoFile
175 return emptyHookedBuildInfo
177 let pd = updatePackageDescription hooked_bi pd0
179 -- generate Paths_<pkg>.hs and cabal-macros.h
180 writeAutogenFiles verbosity pd lbi
182 -- generate inplace-pkg-config
183 when (isJust $ library pd) $
184 writeInstalledConfig distdir pd lbi True Nothing
187 libBiModules lib = (libBuildInfo lib, libModules pd)
188 exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules pd)
189 biModuless = (maybeToList $ fmap libBiModules $ library pd)
190 ++ (map exeBiModules $ executables pd)
191 buildableBiModuless = filter isBuildable biModuless
192 where isBuildable (bi', _) = buildable bi'
193 (bi, modules) = case buildableBiModuless of
194 [] -> error "No buildable component found"
195 [biModules] -> biModules
196 _ -> error ("XXX ghc-cabal can't handle " ++
197 "more than one buildinfo yet")
198 -- XXX Another Just...
199 Just ghcProg = lookupProgram ghcProgram (withPrograms lbi)
201 dep_pkgs = PackageIndex.topologicalOrder (packageHacks (installedPkgs lbi))
202 forDeps f = concatMap f dep_pkgs
204 -- copied from Distribution.Simple.PreProcess.ppHsc2Hs
205 packageHacks = case compilerFlavor (compiler lbi) of
206 GHC -> hackRtsPackage
208 -- We don't link in the actual Haskell libraries of our
209 -- dependencies, so the -u flags in the ldOptions of the rts
210 -- package mean linking fails on OS X (it's ld is a tad
211 -- stricter than gnu ld). Thus we remove the ldOptions for
212 -- GHC's rts package:
213 hackRtsPackage index =
214 case PackageIndex.lookupPackageName index (PackageName "rts") of
215 [rts] -> PackageIndex.insert rts { Installed.ldOptions = [] } index
216 _ -> error "No (or multiple) ghc rts package is registered!!"
218 let variablePrefix = directory ++ '_':distdir
219 let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
220 variablePrefix ++ "_MODULES = " ++ unwords (map display modules),
221 variablePrefix ++ "_HS_SRC_DIRS = " ++ unwords (hsSourceDirs bi),
222 variablePrefix ++ "_DEPS = " ++ unwords (map display (packageDeps lbi)),
223 variablePrefix ++ "_DEP_NAMES = " ++ unwords (map (display . packageName) (packageDeps lbi)),
224 variablePrefix ++ "_INCLUDE_DIRS = " ++ unwords (includeDirs bi),
225 variablePrefix ++ "_INCLUDES = " ++ unwords (includes bi),
226 variablePrefix ++ "_INSTALL_INCLUDES = " ++ unwords (installIncludes bi),
227 variablePrefix ++ "_EXTRA_LIBRARIES = " ++ unwords (extraLibs bi),
228 variablePrefix ++ "_EXTRA_LIBDIRS = " ++ unwords (extraLibDirs bi),
229 variablePrefix ++ "_C_SRCS = " ++ unwords (cSources bi),
230 -- XXX This includes things it shouldn't, like:
231 -- -odir dist-bootstrapping/build
232 variablePrefix ++ "_HC_OPTS = " ++ escape (unwords
235 ++ extensionsToFlags (compiler lbi) (extensions bi))),
236 variablePrefix ++ "_CC_OPTS = " ++ unwords (ccOptions bi),
237 variablePrefix ++ "_CPP_OPTS = " ++ unwords (cppOptions bi),
238 variablePrefix ++ "_LD_OPTS = " ++ unwords (ldOptions bi),
239 variablePrefix ++ "_DEP_INCLUDE_DIRS = " ++ unwords (forDeps Installed.includeDirs),
240 variablePrefix ++ "_DEP_CC_OPTS = " ++ unwords (forDeps Installed.ccOptions),
241 variablePrefix ++ "_DEP_LIB_DIRS = " ++ unwords (forDeps Installed.libraryDirs),
242 variablePrefix ++ "_DEP_EXTRA_LIBS = " ++ unwords (forDeps Installed.extraLibraries),
243 variablePrefix ++ "_DEP_LD_OPTS = " ++ unwords (forDeps Installed.ldOptions)]
244 writeFile (distdir ++ "/package-data.mk") $ unlines xs
246 escape = foldr (\c xs -> if c == '#' then '\\':'#':xs else c:xs) []