Add user-defined flavour example for turning off dynamic linking (#535)
[hadrian.git] / src / Rules / Wrappers.hs
1 module Rules.Wrappers (
2 WrappedBinary(..), Wrapper, inplaceWrappers, installWrappers
3 ) where
4
5 import Hadrian.Oracles.Path
6
7 import Base
8 import Expression
9 import Oracles.Setting
10 import Settings
11
12 -- | Wrapper is an expression depending on (i) the 'FilePath' to the library and
13 -- (ii) the name of the wrapped binary.
14 data WrappedBinary = WrappedBinary
15 { binaryLibPath :: FilePath
16 , binaryName :: String }
17
18 type Wrapper = WrappedBinary -> Expr String
19
20 ghcWrapper :: WrappedBinary -> Expr String
21 ghcWrapper WrappedBinary{..} = do
22 expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
23 bash <- expr bashPath
24 return $ unlines
25 [ "#!"++bash
26 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
27 ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
28
29 inplaceRunGhcWrapper :: WrappedBinary -> Expr String
30 inplaceRunGhcWrapper WrappedBinary{..} = do
31 expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
32 bash <- expr bashPath
33 return $ unlines
34 [ "#!"++bash
35 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
36 ++ " -f" ++ (binaryLibPath -/- "bin/ghc-stage2") -- TODO: use ProgramName
37 ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
38
39 installRunGhcWrapper :: WrappedBinary -> Expr String
40 installRunGhcWrapper WrappedBinary{..} = do
41 expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
42 bash <- expr bashPath
43 return $ unlines
44 [ "#!"++bash
45 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
46 ++ " -f" ++ (binaryLibPath -/- "bin/ghc") -- TODO: use ProgramName
47 ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
48
49 inplaceGhcPkgWrapper :: WrappedBinary -> Expr String
50 inplaceGhcPkgWrapper WrappedBinary{..} = do
51 expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
52 top <- expr topDirectory
53 -- The wrapper is generated in StageN, but used in StageN+1. Therefore, we
54 -- always use the inplace package database, located at 'inplacePackageDbPath',
55 -- which is used in Stage1 and later.
56 bash <- expr bashPath
57 return $ unlines
58 [ "#!" ++ bash
59 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++
60 " --global-package-db " ++ top -/- inplacePackageDbPath ++ " ${1+\"$@\"}" ]
61
62 installGhcPkgWrapper :: WrappedBinary -> Expr String
63 installGhcPkgWrapper WrappedBinary{..} = do
64 expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
65 stage <- getStage
66 top <- expr topDirectory
67 -- Use the package configuration for the next stage in the wrapper.
68 -- The wrapper is generated in StageN, but used in StageN+1.
69 packageDb <- expr $ installPackageDbPath binaryLibPath top (succ stage)
70 bash <- expr bashPath
71 return $ unlines
72 [ "#!"++bash
73 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
74 ++ " --global-package-db " ++ packageDb ++ " ${1+\"$@\"}" ]
75
76 hp2psWrapper :: WrappedBinary -> Expr String
77 hp2psWrapper WrappedBinary{..} = do
78 expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
79 bash <- expr bashPath
80 return $ unlines
81 [ "#!"++bash
82 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ]
83
84 hpcWrapper :: WrappedBinary -> Expr String
85 hpcWrapper WrappedBinary{..} = do
86 expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
87 bash <- expr bashPath
88 return $ unlines
89 [ "#!"++bash
90 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ]
91
92 hsc2hsWrapper :: WrappedBinary -> Expr String
93 hsc2hsWrapper WrappedBinary{..} = do
94 top <- expr topDirectory
95 expr $ need [ sourcePath -/- "Rules/Wrappers.hs" ]
96 contents <- expr $ readFile' $ top -/- "utils/hsc2hs/hsc2hs.wrapper"
97 let executableName = binaryLibPath -/- "bin" -/- binaryName
98 confCcArgs <- expr $ settingList (ConfCcArgs Stage1)
99 confGccLinkerArgs <- expr $ settingList (ConfGccLinkerArgs Stage1)
100 let hsc2hsExtra = unwords (map ("-cflags=" ++) confCcArgs) ++ " " ++
101 unwords (map ("-lflags=" ++) confGccLinkerArgs)
102 bash <- expr bashPath
103 return $ unlines
104 [ "#!"++bash
105 , "executablename=\"" ++ executableName ++ "\""
106 , "HSC2HS_EXTRA=\"" ++ hsc2hsExtra ++ "\""
107 , contents ]
108
109 haddockWrapper :: WrappedBinary -> Expr String
110 haddockWrapper WrappedBinary{..} = do
111 expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
112 return $ unlines
113 [ "#!/bin/bash"
114 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
115 ++ " -B" ++ binaryLibPath ++ " -l" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
116
117 iservBinWrapper :: WrappedBinary -> Expr String
118 iservBinWrapper WrappedBinary{..} = do
119 expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
120 stage <- getStage
121 stageLibraries <- expr $ filter isLibrary <$> stagePackages stage
122 -- TODO: Figure our the reason of this hardcoded exclusion
123 let pkgs = stageLibraries \\ [ cabal, process, haskeline
124 , terminfo, ghcCompact, hpc, compiler ]
125 contexts <- expr $ concatForM pkgs $ \p -> do
126 maybeStage <- installStage p
127 return [ vanillaContext s p | s <- maybeToList maybeStage ]
128 buildPaths <- expr $ mapM buildPath contexts
129 return $ unlines
130 [ "#!/bin/bash"
131 , "export DYLD_LIBRARY_PATH=\"" ++ intercalate ":" buildPaths ++
132 "${DYLD_LIBRARY_PATH:+:$DYLD_LIBRARY_PATH}\""
133 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ]
134
135 wrappersCommon :: [(Context, Wrapper)]
136 wrappersCommon = [ (vanillaContext Stage0 ghc , ghcWrapper)
137 , (vanillaContext Stage1 ghc , ghcWrapper)
138 , (vanillaContext Stage1 hp2ps , hp2psWrapper)
139 , (vanillaContext Stage1 hpc , hpcWrapper)
140 , (vanillaContext Stage1 hsc2hs, hsc2hsWrapper)
141 , (vanillaContext Stage2 haddock, haddockWrapper)
142 , (vanillaContext Stage1 iservBin, iservBinWrapper) ]
143
144 -- | List of wrappers for inplace artefacts
145 inplaceWrappers :: [(Context, Wrapper)]
146 inplaceWrappers = wrappersCommon ++
147 [ (vanillaContext Stage0 ghcPkg, inplaceGhcPkgWrapper)
148 , (vanillaContext Stage1 runGhc, inplaceRunGhcWrapper) ]
149
150 -- | List of wrappers for installation
151 installWrappers :: [(Context, Wrapper)]
152 installWrappers = wrappersCommon ++
153 [ (vanillaContext Stage0 ghcPkg, installGhcPkgWrapper)
154 , (vanillaContext Stage1 runGhc, installRunGhcWrapper) ]
155
156 -- | In the final installation path specified by @DEST@, there is another
157 -- @package.conf.d@ different from 'inplacePackageDbPath' defined in "Base".
158 installPackageDbPath :: FilePath -> FilePath -> Stage -> Action FilePath
159 installPackageDbPath _ top Stage0 = do
160 path <- buildRoot
161 return $ top -/- path -/- "stage0/bootstrapping.conf"
162 installPackageDbPath libdir _ _ = return $ libdir -/- "package.conf.d"