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