Use Cabal directly in place of ghc-cabal + make build root configurable (#531)
[hadrian.git] / src / Rules / Program.hs
1 module Rules.Program (buildProgram) where
2
3 import Hadrian.Haskell.Cabal
4 import Hadrian.Haskell.Cabal.PackageData as PD
5
6 import Base
7 import Context
8 import Expression hiding (stage, way)
9 import GHC
10 import Oracles.ModuleFiles
11 import Oracles.Flag (crossCompiling)
12 import Settings
13 import Settings.Packages.Rts
14 import Target
15 import Utilities
16
17 -- | TODO: Drop code duplication
18 buildProgram :: [(Resource, Int)] -> Rules ()
19 buildProgram rs = do
20 root <- buildRootRules
21 forM_ [Stage0 ..] $ \stage ->
22 root -/- stageString stage -/- "bin" -/- "*" %> \bin -> do
23
24 -- quite inefficient. But we can't access the programName from
25 -- Rules, as it's an Action, due to being backed by an Oracle.
26 activeProgramPackages <- filter isProgram <$> stagePackages stage
27 nameToCtxList <- forM activeProgramPackages $ \pkg -> do
28 let ctx = vanillaContext stage pkg
29 name <- programName ctx
30 return (name <.> exe, ctx)
31
32 case lookup (takeFileName bin) nameToCtxList of
33 Nothing -> fail "Unknown program"
34 Just (Context {..}) -> do
35 -- Rules for programs built in 'buildRoot'
36
37 -- Custom dependencies: this should be modeled better in the cabal file somehow.
38
39 when (package == hsc2hs) $ do
40 -- hsc2hs needs the template-hsc.h file
41 tmpl <- templateHscPath stage
42 need [tmpl]
43 when (package == ghc) $ do
44 -- ghc depends on settings, platformConstants, llvm-targets
45 -- ghc-usage.txt, ghci-usage.txt
46 need =<< ghcDeps stage
47
48 cross <- crossCompiling
49 -- for cross compiler, copy the stage0/bin/<pgm>
50 -- into stage1/bin/
51 case (cross, stage) of
52 (True, s) | s > Stage0 -> do
53 srcDir <- buildRoot <&> (-/- (stageString Stage0 -/- "bin"))
54 copyFile (srcDir -/- takeFileName bin) bin
55 _ -> buildBinary rs bin =<< programContext stage package
56 -- Rules for the GHC package, which is built 'inplace'
57
58 buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action ()
59 buildBinary rs bin context@Context {..} = do
60 binDeps <- if stage == Stage0 && package == ghcCabal
61 then hsSources context
62 else do
63 needLibrary =<< contextDependencies context
64 when (stage > Stage0) $ do
65 ways <- interpretInContext context (getLibraryWays <> getRtsWays)
66 needLibrary [ rtsContext { way = w } | w <- ways ]
67 cSrcs <- interpretInContext context (getPackageData PD.cSrcs)
68 cObjs <- mapM (objectPath context) cSrcs
69 hsObjs <- hsObjects context
70 return $ cObjs ++ hsObjs
71 need binDeps
72 buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
73 synopsis <- pkgSynopsis context
74 putSuccess $ renderProgram
75 (quote (pkgName package) ++ " (" ++ show stage ++ ").") bin synopsis