Make build progress info colours customisable, drop putError and putOracle.
[hadrian.git] / src / Builder.hs
1 {-# LANGUAGE DeriveGeneric, LambdaCase #-}
2 module Builder (
3 CompilerMode (..), Builder (..),
4 builderPath, getBuilderPath, builderEnvironment, specified, needBuilder
5 ) where
6
7 import Control.Monad.Trans.Reader
8 import GHC.Generics (Generic)
9
10 import Base
11 import Context
12 import GHC
13 import Oracles.Config
14 import Oracles.LookupInPath
15 import Oracles.WindowsPath
16 import Stage
17
18 -- | A compiler can typically be used in one of three modes:
19 -- 1) Compiling sources into object files.
20 -- 2) Extracting source dependencies, e.g. by passing -M command line argument.
21 -- 3) Linking object files & static libraries into an executable.
22 data CompilerMode = Compile
23 | FindDependencies
24 | Link
25 deriving (Show, Eq, Generic)
26
27 -- TODO: Do we really need HsCpp builder? Can't we use Cc instead?
28 -- | A 'Builder' is an external command invoked in separate process using 'Shake.cmd'
29 --
30 -- @Ghc Stage0@ is the bootstrapping compiler
31 -- @Ghc StageN@, N > 0, is the one built on stage (N - 1)
32 -- @GhcPkg Stage0@ is the bootstrapping @GhcPkg@
33 -- @GhcPkg StageN@, N > 0, is the one built in Stage0 (TODO: need only Stage1?)
34 data Builder = Alex
35 | Ar
36 | DeriveConstants
37 | Cc CompilerMode Stage
38 | Configure FilePath
39 | GenApply
40 | GenPrimopCode
41 | Ghc CompilerMode Stage
42 | GhcCabal
43 | GhcCabalHsColour -- synonym for 'GhcCabal hscolour'
44 | GhcPkg Stage
45 | Haddock
46 | Happy
47 | Hpc
48 | HsColour
49 | HsCpp
50 | Hsc2Hs
51 | Ld
52 | Make FilePath
53 | Nm
54 | Objdump
55 | Patch
56 | Perl
57 | Ranlib
58 | Tar
59 | Unlit
60 deriving (Show, Eq, Generic)
61
62 -- | Some builders are built by this very build system, in which case
63 -- 'builderProvenance' returns the corresponding build 'Context' (which includes
64 -- 'Stage' and GHC 'Package').
65 builderProvenance :: Builder -> Maybe Context
66 builderProvenance = \case
67 DeriveConstants -> context Stage0 deriveConstants
68 GenApply -> context Stage0 genapply
69 GenPrimopCode -> context Stage0 genprimopcode
70 Ghc _ Stage0 -> Nothing
71 Ghc _ stage -> context (pred stage) ghc
72 GhcCabal -> context Stage0 ghcCabal
73 GhcCabalHsColour -> builderProvenance $ GhcCabal
74 GhcPkg stage -> if stage > Stage0 then context Stage0 ghcPkg else Nothing
75 Haddock -> context Stage2 haddock
76 Hpc -> context Stage1 hpcBin
77 Hsc2Hs -> context Stage0 hsc2hs
78 Unlit -> context Stage0 unlit
79 _ -> Nothing
80 where
81 context s p = Just $ vanillaContext s p
82
83 isInternal :: Builder -> Bool
84 isInternal = isJust . builderProvenance
85
86 -- TODO: Some builders are required only on certain platforms. For example,
87 -- Objdump is only required on OpenBSD and AIX, as mentioned in #211. Add
88 -- support for platform-specific optional builders as soon as we can reliably
89 -- test this feature.
90 isOptional :: Builder -> Bool
91 isOptional = \case
92 HsColour -> True
93 Objdump -> True
94 _ -> False
95
96 -- TODO: get rid of fromJust
97 -- | Determine the location of a 'Builder'.
98 builderPath :: Builder -> Action FilePath
99 builderPath builder = case builderProvenance builder of
100 Just context -> return . fromJust $ programPath context
101 Nothing -> case builder of
102 Alex -> fromKey "alex"
103 Ar -> fromKey "ar"
104 Cc _ Stage0 -> fromKey "system-cc"
105 Cc _ _ -> fromKey "cc"
106 -- We can't ask configure for the path to configure!
107 Configure _ -> return "bash configure"
108 Ghc _ Stage0 -> fromKey "system-ghc"
109 GhcPkg Stage0 -> fromKey "system-ghc-pkg"
110 Happy -> fromKey "happy"
111 HsColour -> fromKey "hscolour"
112 HsCpp -> fromKey "hs-cpp"
113 Ld -> fromKey "ld"
114 Make _ -> fromKey "make"
115 Nm -> fromKey "nm"
116 Objdump -> fromKey "objdump"
117 Patch -> fromKey "patch"
118 Perl -> fromKey "perl"
119 Ranlib -> fromKey "ranlib"
120 Tar -> fromKey "tar"
121 _ -> error $ "Cannot determine builderPath for " ++ show builder
122 where
123 fromKey key = do
124 path <- askConfigWithDefault key . error $ "\nCannot find path to '"
125 ++ key ++ "' in system.config file. Did you forget to run configure?"
126 if null path
127 then do
128 if isOptional builder
129 then return ""
130 else error $ "Builder '" ++ key ++ "' is not specified in"
131 ++ " system.config file. Cannot proceed without it."
132 else fixAbsolutePathOnWindows =<< lookupInPath path
133
134 getBuilderPath :: Builder -> ReaderT a Action FilePath
135 getBuilderPath = lift . builderPath
136
137 -- | Write a Builder's path into a given environment variable.
138 builderEnvironment :: String -> Builder -> Action CmdOption
139 builderEnvironment variable builder = do
140 needBuilder builder
141 path <- builderPath builder
142 return $ AddEnv variable path
143
144 specified :: Builder -> Action Bool
145 specified = fmap (not . null) . builderPath
146
147 -- | Make sure a Builder exists on the given path and rebuild it if out of date.
148 needBuilder :: Builder -> Action ()
149 needBuilder = \case
150 Configure dir -> need [dir -/- "configure"]
151 builder -> when (isInternal builder) $ do
152 path <- builderPath builder
153 need [path]
154
155 -- Instances for storing in the Shake database
156 instance Binary CompilerMode
157 instance Hashable CompilerMode
158 instance NFData CompilerMode
159
160 instance Binary Builder
161 instance Hashable Builder
162 instance NFData Builder