Add Install Rules (#312)
[hadrian.git] / src / Rules / Program.hs
1 module Rules.Program (buildProgram) where
2
3 import Data.Char
4
5 import Base
6 import Context
7 import Expression
8 import GHC
9 import Oracles.Config.Setting
10 import Oracles.Dependencies
11 import Oracles.ModuleFiles
12 import Oracles.PackageData
13 import Oracles.Path (topDirectory)
14 import Rules.Wrappers (WrappedBinary(..), Wrapper, inplaceWrappers)
15 import Settings
16 import Settings.Path (buildPath, inplaceLibBinPath, rtsContext, objectPath,
17 inplaceLibPath, inplaceBinPath)
18 import Target
19 import UserSettings
20 import Util
21
22 buildProgram :: [(Resource, Int)] -> Context -> Rules ()
23 buildProgram rs context@Context {..} = when (isProgram package) $ do
24 let installStage = do
25 latest <- latestBuildStage package -- fromJust below is safe
26 return $ if package == ghc then stage else fromJust latest
27
28 buildPath context -/- programName context <.> exe %>
29 buildBinaryAndWrapper rs context
30
31 -- Rules for programs built in install directories
32 when (stage == Stage0 || package == ghc) $ do
33 -- Some binaries in inplace/bin are wrapped
34 inplaceBinPath -/- programName context <.> exe %> \bin -> do
35 binStage <- installStage
36 buildBinaryAndWrapper rs (context { stage = binStage }) bin
37 -- We build only unwrapped binaries in inplace/lib/bin
38 inplaceLibBinPath -/- programName context <.> exe %> \bin -> do
39 binStage <- installStage
40 buildBinary rs (context { stage = binStage }) bin
41
42 buildBinaryAndWrapper :: [(Resource, Int)] -> Context -> FilePath -> Action ()
43 buildBinaryAndWrapper rs context bin = do
44 windows <- windowsHost
45 if windows
46 then buildBinary rs context bin -- We don't build wrappers on Windows
47 else case lookup context inplaceWrappers of
48 Nothing -> buildBinary rs context bin -- No wrapper found
49 Just wrapper -> do
50 top <- topDirectory
51 let libdir = top -/- inplaceLibPath
52 let wrappedBin = inplaceLibBinPath -/- takeFileName bin
53 need [wrappedBin]
54 buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName bin))
55
56 buildWrapper :: Context -> Wrapper -> FilePath -> WrappedBinary -> Action ()
57 buildWrapper context@Context {..} wrapper wrapperPath wrapped = do
58 contents <- interpretInContext context $ wrapper wrapped
59 writeFileChanged wrapperPath contents
60 makeExecutable wrapperPath
61 putSuccess $ "| Successfully created wrapper for " ++
62 quote (pkgNameString package) ++ " (" ++ show stage ++ ")."
63
64 -- TODO: Get rid of the Paths_hsc2hs.o hack.
65 buildBinary :: [(Resource, Int)] -> Context -> FilePath -> Action ()
66 buildBinary rs context@Context {..} bin = do
67 binDeps <- if stage == Stage0 && package == ghcCabal
68 then hsSources context
69 else do
70 needContext =<< contextDependencies context
71 when (stage > Stage0) $ do
72 ways <- interpretInContext context (getLibraryWays <> getRtsWays)
73 needContext [ rtsContext { way = w } | w <- ways ]
74 let path = buildPath context
75 cObjs <- map (objectPath context) <$> pkgDataList (CSrcs path)
76 hsObjs <- hsObjects context
77 return $ cObjs ++ hsObjs
78 ++ [ path -/- "Paths_hsc2hs.o" | package == hsc2hs ]
79 ++ [ path -/- "Paths_haddock.o" | package == haddock ]
80 need binDeps
81 buildWithResources rs $ Target context (Ghc LinkHs stage) binDeps [bin]
82 synopsis <- interpretInContext context $ getPkgData Synopsis
83 putSuccess $ renderProgram
84 (quote (pkgNameString package) ++ " (" ++ show stage ++ ").")
85 bin
86 (dropWhileEnd isPunctuation synopsis)