1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
-----------------------------------------------------------------------------
-- |
-- Module : Hadrian.Builder
-- Copyright : (c) Andrey Mokhov 2014-2017
-- License : MIT (see the file LICENSE)
-- Maintainer : andrey.mokhov@gmail.com
-- Stability : experimental
--
-- A typical build system invokes several build tools, or /builders/, such as
-- compilers, linkers, etc., some of which may be built by the build system
-- itself. This module defines the 'Builder' type class and a few associated
-- functions that can be used to invoke builders.
-----------------------------------------------------------------------------
module Hadrian.Builder (
Builder (..), BuildInfo (..), needBuilder, runBuilder,
runBuilderWithCmdOptions, build, buildWithResources, buildWithCmdOptions,
getBuilderPath, builderEnvironment, askWithResources
) where
import Data.List
import Development.Shake
import Development.Shake.FilePath
import Hadrian.Expression hiding (inputs, outputs)
import Hadrian.Oracles.ArgsHash
import Hadrian.Target
import Hadrian.Utilities
import Base
-- | This data structure captures all information relevant to invoking a builder.
data BuildInfo = BuildInfo {
-- | Command line arguments.
buildArgs :: [String],
-- | Input files.
buildInputs :: [FilePath],
-- | Output files.
buildOutputs :: [FilePath],
-- | Options to be passed to Shake's 'cmd' function.
buildOptions :: [CmdOption],
-- | Resources to be acquired.
buildResources :: [(Resource, Int)] }
class ShakeValue b => Builder b where
-- | The path to a builder.
builderPath :: b -> Action FilePath
-- | Ask the builder for information.
-- E.g. ask @ghc-pkg@ for package dependencies
-- capture the @stdout@ result and return it.
askBuilderWith :: b -> BuildInfo -> Action String
-- | Runtime dependencies of a builder. For example, on Windows GHC requires
-- the utility @touchy.exe@ to be available on a specific path.
runtimeDependencies :: b -> Action [FilePath]
runtimeDependencies _ = return []
-- | Run a builder with a given 'BuildInfo'. Also see 'runBuilder'.
runBuilderWith :: b -> BuildInfo -> Action ()
runBuilderWith builder buildInfo = do
let args = buildArgs buildInfo
needBuilder builder
path <- builderPath builder
let msg = if null args then "" else " (" ++ intercalate ", " args ++ ")"
putBuild $ "| Run " ++ show builder ++ msg
quietly $ cmd (buildOptions buildInfo) [path] args
-- | Make sure a builder and its runtime dependencies are up-to-date.
needBuilder :: Builder b => b -> Action ()
needBuilder builder = do
path <- builderPath builder
deps <- runtimeDependencies builder
-- so `path` might be just `gcc`, in which case we won't issue a "need" on
-- it. If someone really wants the full qualified path, he ought to pass
-- CC=$(which gcc) to the configure script. If CC=gcc was passed, we should
-- respect that choice and not resolve that via $PATH into a fully qualified
-- path. We can only `need` fully qualified path's though, hence we won't
-- `need` bare tool names.
when (path /= takeFileName path) $
need [path]
need deps
-- | Run a builder with a specified list of command line arguments, reading a
-- list of input files and writing a list of output files. A lightweight version
-- of 'runBuilderWith'.
runBuilder :: Builder b => b -> [String] -> [FilePath] -> [FilePath] -> Action ()
runBuilder = runBuilderWithCmdOptions []
-- | Like 'runBuilder' but passes given options to Shake's 'cmd'.
runBuilderWithCmdOptions :: Builder b => [CmdOption] -> b -> [String] -> [FilePath] -> [FilePath] -> Action ()
runBuilderWithCmdOptions opts builder args inputs outputs =
runBuilderWith builder $ BuildInfo { buildArgs = args
, buildInputs = inputs
, buildOutputs = outputs
, buildOptions = opts
, buildResources = [] }
-- | Build a 'Target' using the list of command line arguments computed from a
-- given 'Args' expression. Force a rebuild if the argument list has changed
-- since the last build.
build :: (Builder b, ShakeValue c) => Target c b -> Args c b -> Action ()
build = buildWith [] []
-- | Like 'build' but acquires necessary resources.
buildWithResources :: (Builder b, ShakeValue c) => [(Resource, Int)] -> Target c b -> Args c b -> Action ()
buildWithResources rs = buildWith rs []
askWithResources :: (Builder b, ShakeValue c) => [(Resource, Int)] -> Target c b -> Args c b -> Action String
askWithResources rs = askWith rs []
-- | Like 'build' but passes given options to Shake's 'cmd'.
buildWithCmdOptions :: (Builder b, ShakeValue c) => [CmdOption] -> Target c b -> Args c b -> Action ()
buildWithCmdOptions = buildWith []
doWith :: (Builder b, ShakeValue c)
=> (b -> BuildInfo -> Action a)
-> (Target c b -> Action ())
-> [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action a
doWith f info rs opts target args = do
needBuilder (builder target)
argList <- interpret target args
trackArgsHash target -- Rerun the rule if the hash of argList has changed.
info target
verbose <- getVerbosity
let quietlyUnlessVerbose = if verbose >= Diagnostic then withVerbosity Diagnostic else quietly
quietlyUnlessVerbose $ f (builder target) $
BuildInfo { buildArgs = argList
, buildInputs = inputs target
, buildOutputs = outputs target
, buildOptions = opts
, buildResources = rs }
buildWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action ()
buildWith = doWith runBuilderWith runInfo
askWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action String
askWith = doWith askBuilderWith askInfo
-- | Print out information about the command being executed.
runInfo :: Show b => Target c b -> Action ()
runInfo t = putProgressInfo =<< renderAction
("Run " ++ show (builder t)) -- TODO: Bring back contextInfo.
(digest $ inputs t)
(digest $ outputs t)
where
digest [] = "none"
digest [x] = x
digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)"
askInfo :: Show b => Target c b -> Action ()
askInfo t = putProgressInfo =<< renderActionNoOutput
("Run " ++ show (builder t)) -- TODO: Bring back contextInfo.
(digest $ inputs t)
where
digest [] = "none"
digest [x] = x
digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)"
-- | Get the path to the current builder.
getBuilderPath :: Builder b => b -> Expr c b FilePath
getBuilderPath = expr . builderPath
-- | Write a builder path into a given environment variable.
builderEnvironment :: Builder b => String -> b -> Action CmdOption
builderEnvironment variable builder = do
needBuilder builder
path <- builderPath builder
return $ AddEnv variable path
|
