2 module Main (main) where
4 import Distribution.Compat.Exception
5 import qualified Distribution.ModuleName as ModuleName
6 import Distribution.PackageDescription
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, withTempFile)
14 import Distribution.Simple.Build (writeAutogenFiles)
15 import Distribution.Simple.Register (writeInstalledConfig)
16 import Distribution.Simple.PackageIndex
17 import Distribution.System
18 import Distribution.Text
19 import Distribution.Verbosity
20 import qualified Distribution.InstalledPackageInfo as Installed
21 ( InstalledPackageInfo_(..) )
22 import qualified Distribution.Simple.PackageIndex as PackageIndex
23 ( topologicalOrder, lookupPackageName, insert )
25 import Control.Exception
29 import System.Directory
30 import System.Environment
32 import System.FilePath
35 main = do args <- getArgs
37 "haddock" : distDir : dir : args' ->
38 runHaddock distDir dir args'
39 "install" : ghcpkg : ghcpkgconfig : directory : distDir
40 : myDestDir : myPrefix : myLibdir : myDocdir : args' ->
41 doInstall ghcpkg ghcpkgconfig directory distDir
42 myDestDir myPrefix myLibdir myDocdir args'
43 "configure" : args' -> case break (== "--") args' of
44 (config_args, "--" : distdir : directories) ->
45 mapM_ (generate config_args distdir) directories
49 syntax_error :: [String]
51 ["syntax: ghc-cabal configure <configure-args> -- <distdir> <directory>...",
52 " ghc-cabal install <ghc-pkg> <directory> <distdir> <destdir> <prefix> <args>...",
53 " ghc-cabal haddock <distdir> <directory> <args>..."]
55 die :: [String] -> IO ()
56 die errs = do mapM_ (hPutStrLn stderr) errs
57 exitWith (ExitFailure 1)
59 -- XXX Should use bracket
60 withCurrentDirectory :: FilePath -> IO a -> IO a
61 withCurrentDirectory directory io
62 = do curDirectory <- getCurrentDirectory
63 setCurrentDirectory directory
65 setCurrentDirectory curDirectory
68 -- We need to use the autoconfUserHooks, as the packages that use
69 -- configure can create a .buildinfo file, and we need any info that
71 userHooks :: UserHooks
72 userHooks = autoconfUserHooks
74 runHaddock :: FilePath -> FilePath -> [String] -> IO ()
75 runHaddock distdir directory args
76 = withCurrentDirectory directory
77 $ defaultMainWithHooksArgs hooks ("haddock" : "--builddir" : distdir : args)
80 haddockHook = modHook (haddockHook userHooks)
82 modHook f pd lbi us flags
83 | packageName pd == PackageName "ghc-prim"
84 = let pd' = case library pd of
86 let ghcPrim = fromJust (simpleParse "GHC.Prim")
87 ems = filter (ghcPrim /=)
89 lib' = lib { exposedModules = ems }
90 in pd { library = Just lib' }
92 error "Expected a library, but none found"
94 pc' = userSpecifyArgs "haddock"
95 ["dist-install/build/autogen/GHC/Prim.hs"] pc
96 lbi' = lbi { withPrograms = pc' }
97 in f pd' lbi' us flags
101 doInstall :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath
102 -> FilePath -> FilePath -> FilePath -> [String] -> IO ()
103 doInstall ghcpkg ghcpkgconf directory distDir myDestDir myPrefix myLibdir myDocdir args
104 = withCurrentDirectory directory $ do
105 defaultMainWithHooksArgs hooks (["copy", "--builddir", distDir]
106 ++ (if null myDestDir then []
107 else ["--destdir", myDestDir])
109 defaultMainWithHooksArgs hooks ("register" : "--builddir" : distDir : args)
112 copyHook = noGhcPrimHook (modHook (copyHook userHooks)),
113 regHook = modHook (regHook userHooks)
116 noGhcPrimHook f pd lbi us flags
118 | packageName pd == PackageName "ghc-prim" =
121 let ghcPrim = fromJust (simpleParse "GHC.Prim")
122 ems = filter (ghcPrim /=) (exposedModules lib)
123 lib' = lib { exposedModules = ems }
124 in pd { library = Just lib' }
126 error "Expected a library, but none found"
128 in f pd' lbi us flags
129 modHook f pd lbi us flags
130 = let idts = installDirTemplates lbi
131 idts' = idts { prefix = toPathTemplate myPrefix,
132 libdir = toPathTemplate myLibdir,
133 libsubdir = toPathTemplate "$pkgid",
134 docdir = toPathTemplate (myDocdir </> "$pkgid"),
135 htmldir = toPathTemplate "$docdir" }
136 progs = withPrograms lbi
137 prog = ConfiguredProgram {
138 programId = programName ghcPkgProgram,
139 programVersion = Nothing,
140 programArgs = ["--global-conf", ghcpkgconf]
141 ++ if not (null myDestDir)
144 programLocation = UserSpecified ghcpkg
146 progs' = updateProgram prog progs
148 installDirTemplates = idts',
149 withPrograms = progs'
151 in f pd lbi' us flags
153 generate :: [String] -> FilePath -> FilePath -> IO ()
154 generate config_args distdir directory
155 = withCurrentDirectory directory
156 $ do let verbosity = normal
157 gpdFile <- defaultPackageDesc verbosity
158 gpd <- readPackageDescription verbosity gpdFile
160 -- XXX We shouldn't just configure with the default flags
161 -- XXX And this, and thus the "getPersistBuildConfig distdir" below,
162 -- aren't going to work when the deps aren't built yet
163 withArgs (["configure", "--distdir", distdir] ++ config_args)
164 (case buildType (flattenPackageDescription gpd) of
165 Just Configure -> defaultMainWithHooks autoconfUserHooks
166 _other -> defaultMain)
167 -- not quite right, but good enough for us
169 lbi <- getPersistBuildConfig distdir
170 let pd0 = localPkgDescr lbi
172 -- Sigh, haskeline proper uses stuff in Setup.hs to handle whether
173 -- or not -liconv is used. We don't use Setup.hs, so we replicate
174 -- what it does here. We should do this better somehow.
175 when ((display (pkgName (package pd0)) == "haskeline") &&
176 (buildOS /= Windows)) $
178 Nothing -> fail "Can't happen: No haskeline library"
180 d <- getCurrentDirectory
182 maybeSetLibiconv verbosity (libBuildInfo lib) lbi
185 if (buildType pd0 == Just Configure) || (buildType pd0 == Just Custom)
187 maybe_infoFile <- defaultHookedPackageDesc
188 case maybe_infoFile of
189 Nothing -> return emptyHookedBuildInfo
190 Just infoFile -> readHookedBuildInfo verbosity infoFile
192 return emptyHookedBuildInfo
194 let pd = updatePackageDescription hooked_bi pd0
196 -- generate Paths_<pkg>.hs and cabal-macros.h
197 writeAutogenFiles verbosity pd lbi
199 -- generate inplace-pkg-config
200 when (isJust $ library pd) $
201 writeInstalledConfig distdir pd lbi True
202 (distdir </> "inplace-pkg-config")
205 libBiModules lib = (libBuildInfo lib, libModules lib)
206 exeBiModules exe = (buildInfo exe, ModuleName.main : exeModules exe)
207 biModuless = (maybeToList $ fmap libBiModules $ library pd)
208 ++ (map exeBiModules $ executables pd)
209 buildableBiModuless = filter isBuildable biModuless
210 where isBuildable (bi', _) = buildable bi'
211 (bi, modules) = case buildableBiModuless of
212 [] -> error "No buildable component found"
213 [biModules] -> biModules
214 _ -> error ("XXX ghc-cabal can't handle " ++
215 "more than one buildinfo yet")
216 -- XXX Another Just...
217 Just ghcProg = lookupProgram ghcProgram (withPrograms lbi)
219 dep_pkgs = PackageIndex.topologicalOrder (packageHacks (installedPkgs lbi))
220 forDeps f = concatMap f dep_pkgs
222 -- copied from Distribution.Simple.PreProcess.ppHsc2Hs
223 packageHacks = case compilerFlavor (compiler lbi) of
224 GHC -> hackRtsPackage
226 -- We don't link in the actual Haskell libraries of our
227 -- dependencies, so the -u flags in the ldOptions of the rts
228 -- package mean linking fails on OS X (it's ld is a tad
229 -- stricter than gnu ld). Thus we remove the ldOptions for
230 -- GHC's rts package:
231 hackRtsPackage index =
232 case PackageIndex.lookupPackageName index (PackageName "rts") of
233 [rts] -> PackageIndex.insert rts { Installed.ldOptions = [] } index
234 _ -> error "No (or multiple) ghc rts package is registered!!"
236 let variablePrefix = directory ++ '_':distdir
237 let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
238 variablePrefix ++ "_MODULES = " ++ unwords (map display modules),
239 variablePrefix ++ "_HS_SRC_DIRS = " ++ unwords (hsSourceDirs bi),
240 variablePrefix ++ "_DEPS = " ++ unwords (map display (externalPackageDeps lbi)),
241 variablePrefix ++ "_DEP_NAMES = " ++ unwords (map (display . packageName) (externalPackageDeps lbi)),
242 variablePrefix ++ "_INCLUDE_DIRS = " ++ unwords (includeDirs bi),
243 variablePrefix ++ "_INCLUDES = " ++ unwords (includes bi),
244 variablePrefix ++ "_INSTALL_INCLUDES = " ++ unwords (installIncludes bi),
245 variablePrefix ++ "_EXTRA_LIBRARIES = " ++ unwords (extraLibs bi),
246 variablePrefix ++ "_EXTRA_LIBDIRS = " ++ unwords (extraLibDirs bi),
247 variablePrefix ++ "_C_SRCS = " ++ unwords (cSources bi),
248 -- XXX This includes things it shouldn't, like:
249 -- -odir dist-bootstrapping/build
250 variablePrefix ++ "_HC_OPTS = " ++ escape (unwords
253 ++ extensionsToFlags (compiler lbi) (extensions bi))),
254 variablePrefix ++ "_CC_OPTS = " ++ unwords (ccOptions bi),
255 variablePrefix ++ "_CPP_OPTS = " ++ unwords (cppOptions bi),
256 variablePrefix ++ "_LD_OPTS = " ++ unwords (ldOptions bi),
257 variablePrefix ++ "_DEP_INCLUDE_DIRS = " ++ unwords (forDeps Installed.includeDirs),
258 variablePrefix ++ "_DEP_CC_OPTS = " ++ unwords (forDeps Installed.ccOptions),
259 variablePrefix ++ "_DEP_LIB_DIRS = " ++ unwords (forDeps Installed.libraryDirs),
260 variablePrefix ++ "_DEP_EXTRA_LIBS = " ++ unwords (forDeps Installed.extraLibraries),
261 variablePrefix ++ "_DEP_LD_OPTS = " ++ unwords (forDeps Installed.ldOptions)]
262 writeFile (distdir ++ "/package-data.mk") $ unlines xs
264 escape = foldr (\c xs -> if c == '#' then '\\':'#':xs else c:xs) []
266 ----------------------------------------------------------------------
267 -- haskeline-specific hacks
269 -- Sigh, haskeline proper uses stuff in Setup.hs to handle whether
270 -- or not -liconv is used. We don't use Setup.hs, so we replicate
271 -- what it does here. We should do this better somehow.
273 -- Test whether compiling a c program that links against libiconv needs -liconv.
274 maybeSetLibiconv :: Verbosity -> BuildInfo -> LocalBuildInfo -> IO ()
275 maybeSetLibiconv verb bi lbi = do
276 let biWithIconv = addIconv bi
277 worksWithout <- tryCompile iconv_prog bi lbi verb
279 then writeBuildInfo ""
281 worksWith <- tryCompile iconv_prog biWithIconv lbi verb
284 writeBuildInfo "iconv"
285 else fail "Unable to link against the iconv library."
287 -- Cabal (at least 1.6.0.1) won't parse an empty buildinfo file.
288 writeBuildInfo libs = writeFile "haskeline.buildinfo"
289 $ unlines ["extra-libraries: " ++ libs]
291 tryCompile :: String -> BuildInfo -> LocalBuildInfo -> Verbosity -> IO Bool
292 tryCompile program bi lbi verb = flip catchIO processException $ flip catchExit processExit $ do
293 tempDir <- getTemporaryDirectory
294 withTempFile tempDir ".c" $ \fname h -> do
297 -- TODO take verbosity from the args.
298 rawSystemProgramStdoutConf verb gccProgram (withPrograms lbi) (fname : args)
301 processException :: IOException -> IO Bool
302 processException _ = return False
303 processExit = return . (==ExitSuccess)
304 -- Mimicing Distribution.Simple.Configure
305 deps = topologicalOrder (installedPkgs lbi)
310 -- --extra-include-dirs and --extra-lib-dirs are included
311 -- in the below fields.
312 -- Also sometimes a dependency like rts points to a nonstandard
313 -- include/lib directory where iconv can be found.
314 , map ("-I" ++) (includeDirs bi ++ concatMap Installed.includeDirs deps)
315 , map ("-L" ++) (extraLibDirs bi ++ concatMap Installed.libraryDirs deps)
316 , map ("-l" ++) (extraLibs bi)
319 addIconv :: BuildInfo -> BuildInfo
320 addIconv bi = bi {extraLibs = "iconv" : extraLibs bi}
323 iconv_prog = unlines $
324 [ "#include <iconv.h>"
326 , " iconv_t t = iconv_open(\"UTF-8\", \"UTF-8\");"