Add ghc-iserv wrapper (#367)
[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
38 inplaceLibBinPath -/- programName context <.> exe %> \bin -> do
39 binStage <- installStage
40 if package /= iservBin then
41 -- We *normally* build only unwrapped binaries in inplace/lib/bin,
42 buildBinary rs (context { stage = binStage }) bin
43 else
44 -- build both binary and wrapper in inplace/lib/bin
45 -- for ghc-iserv on *nix platform now
46 buildBinaryAndWrapperLib rs (context { stage = binStage }) bin
47
48 inplaceLibBinPath -/- programName context <.> "bin" %> \bin -> do
49 binStage <- installStage
50 buildBinary rs (context { stage = binStage }) bin
51
52 buildBinaryAndWrapperLib :: [(Resource, Int)] -> Context -> FilePath -> Action ()
53 buildBinaryAndWrapperLib rs context bin = do
54 windows <- windowsHost
55 if windows
56 then buildBinary rs context bin -- We don't build wrappers on Windows
57 else case lookup context inplaceWrappers of
58 Nothing -> buildBinary rs context bin -- No wrapper found
59 Just wrapper -> do
60 top <- topDirectory
61 let libdir = top -/- inplaceLibPath
62 let wrappedBin = inplaceLibBinPath -/- programName context <.> "bin"
63 need [wrappedBin]
64 buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName wrappedBin))
65
66 buildBinaryAndWrapper :: [(Resource, Int)] -> Context -> FilePath -> Action ()
67 buildBinaryAndWrapper rs context bin = do
68 windows <- windowsHost
69 if windows
70 then buildBinary rs context bin -- We don't build wrappers on Windows
71 else case lookup context inplaceWrappers of
72 Nothing -> buildBinary rs context bin -- No wrapper found
73 Just wrapper -> do
74 top <- topDirectory
75 let libdir = top -/- inplaceLibPath
76 let wrappedBin = inplaceLibBinPath -/- takeFileName bin
77 need [wrappedBin]
78 buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName bin))
79
80 buildWrapper :: Context -> Wrapper -> FilePath -> WrappedBinary -> Action ()
81 buildWrapper context@Context {..} wrapper wrapperPath wrapped = do
82 contents <- interpretInContext context $ wrapper wrapped
83 writeFileChanged wrapperPath contents
84 makeExecutable wrapperPath
85 putSuccess $ "| Successfully created wrapper for " ++
86 quote (pkgNameString package) ++ " (" ++ show stage ++ ")."
87
88 -- TODO: Get rid of the Paths_hsc2hs.o hack.
89 buildBinary :: [(Resource, Int)] -> Context -> FilePath -> Action ()
90 buildBinary rs context@Context {..} bin = do
91 binDeps <- if stage == Stage0 && package == ghcCabal
92 then hsSources context
93 else do
94 needContext =<< contextDependencies context
95 when (stage > Stage0) $ do
96 ways <- interpretInContext context (getLibraryWays <> getRtsWays)
97 needContext [ rtsContext { way = w } | w <- ways ]
98 let path = buildPath context
99 cObjs <- map (objectPath context) <$> pkgDataList (CSrcs path)
100 hsObjs <- hsObjects context
101 return $ cObjs ++ hsObjs
102 ++ [ path -/- "Paths_hsc2hs.o" | package == hsc2hs ]
103 ++ [ path -/- "Paths_haddock.o" | package == haddock ]
104 need binDeps
105 buildWithResources rs $ Target context (Ghc LinkHs stage) binDeps [bin]
106 synopsis <- interpretInContext context $ getPkgData Synopsis
107 putSuccess $ renderProgram
108 (quote (pkgNameString package) ++ " (" ++ show stage ++ ").")
109 bin
110 (dropWhileEnd isPunctuation synopsis)