Add Install Rules (#312)
[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.Install (installPackageDbDirectory)
9 import Settings.Path (inplacePackageDbDirectory)
10 import Oracles.Path (getTopDirectory)
11 import Oracles.Config.Setting (SettingList(..), settingList)
12
13 -- | Wrapper is an expression depending on the 'FilePath' to the
14 -- | library path and name of the wrapped binary.
15 data WrappedBinary = WrappedBinary {
16 binaryLibPath :: FilePath,
17 binaryName :: String
18 }
19
20 type Wrapper = WrappedBinary -> Expr String
21
22 ghcWrapper :: WrappedBinary -> Expr String
23 ghcWrapper WrappedBinary{..} = do
24 lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
25 return $ unlines
26 [ "#!/bin/bash"
27 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
28 ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
29
30 inplaceRunGhcWrapper :: WrappedBinary -> Expr String
31 inplaceRunGhcWrapper WrappedBinary{..} = do
32 lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
33 return $ unlines
34 [ "#!/bin/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 lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
42 return $ unlines
43 [ "#!/bin/bash"
44 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
45 ++ " -f" ++ (binaryLibPath -/- "bin/ghc") -- TODO: use ProgramName
46 ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ]
47
48 inplaceGhcPkgWrapper :: WrappedBinary -> Expr String
49 inplaceGhcPkgWrapper WrappedBinary{..} = do
50 lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
51 stage <- getStage
52 top <- getTopDirectory
53 -- Use the package configuration for the next stage in the wrapper.
54 -- The wrapper is generated in StageN, but used in StageN+1.
55 let packageDb = top -/- inplacePackageDbDirectory (succ stage)
56 return $ unlines
57 [ "#!/bin/bash"
58 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
59 ++ " --global-package-db " ++ packageDb ++ " ${1+\"$@\"}" ]
60
61 installGhcPkgWrapper :: WrappedBinary -> Expr String
62 installGhcPkgWrapper WrappedBinary{..} = do
63 lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
64 stage <- getStage
65 top <- getTopDirectory
66 -- Use the package configuration for the next stage in the wrapper.
67 -- The wrapper is generated in StageN, but used in StageN+1.
68 let packageDb = installPackageDbDirectory binaryLibPath top (succ stage)
69 return $ unlines
70 [ "#!/bin/bash"
71 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName)
72 ++ " --global-package-db " ++ packageDb ++ " ${1+\"$@\"}" ]
73
74 hp2psWrapper :: WrappedBinary -> Expr String
75 hp2psWrapper WrappedBinary{..} = do
76 lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
77 return $ unlines
78 [ "#!/bin/bash"
79 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ]
80
81 hpcWrapper :: WrappedBinary -> Expr String
82 hpcWrapper WrappedBinary{..} = do
83 lift $ need [sourcePath -/- "Rules/Wrappers.hs"]
84 return $ unlines
85 [ "#!/bin/bash"
86 , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ]
87
88 hsc2hsWrapper :: WrappedBinary -> Expr String
89 hsc2hsWrapper WrappedBinary{..} = do
90 top <- getTopDirectory
91 lift $ need [ sourcePath -/- "Rules/Wrappers.hs" ]
92 contents <- lift $ readFile' $ top -/- "utils/hsc2hs/hsc2hs.wrapper"
93 let executableName = binaryLibPath -/- "bin" -/- binaryName
94 confCcArgs <- lift $ settingList (ConfCcArgs Stage1)
95 confGccLinkerArgs <- lift $ settingList (ConfGccLinkerArgs Stage1)
96 let hsc2hsExtra = unwords (map ("-cflags=" ++) confCcArgs) ++ " " ++
97 unwords (map ("-lflags=" ++) confGccLinkerArgs)
98 return $ unlines
99 [ "#!/bin/bash"
100 , "executablename=\"" ++ executableName ++ "\""
101 , "HSC2HS_EXTRA=\"" ++ hsc2hsExtra ++ "\""
102 , contents ]
103
104 wrappersCommon :: [(Context, Wrapper)]
105 wrappersCommon = [ (vanillaContext Stage0 ghc , ghcWrapper)
106 , (vanillaContext Stage1 ghc , ghcWrapper)
107 , (vanillaContext Stage1 hp2ps , hp2psWrapper)
108 , (vanillaContext Stage1 hpc , hpcWrapper)
109 , (vanillaContext Stage1 hsc2hs, hsc2hsWrapper) ]
110
111 -- | List of wrappers for inplace artefacts
112 inplaceWrappers :: [(Context, Wrapper)]
113 inplaceWrappers = wrappersCommon ++
114 [ (vanillaContext Stage0 ghcPkg, inplaceGhcPkgWrapper)
115 , (vanillaContext Stage1 runGhc, inplaceRunGhcWrapper) ]
116
117 -- | List of wrappers for installation
118 installWrappers :: [(Context, Wrapper)]
119 installWrappers = wrappersCommon ++
120 [ (vanillaContext Stage0 ghcPkg, installGhcPkgWrapper)
121 , (vanillaContext Stage1 runGhc, installRunGhcWrapper) ]
122