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
|
-----------------------------------------------------------------------------
-- |
-- 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 Hadrian.Expression hiding (inputs, outputs)
import Hadrian.Oracles.ArgsHash
import Hadrian.Target
import Hadrian.Utilities
-- | 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 aquired.
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 avilable 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
need (path : 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 <- interpret target verboseCommand
let quietlyUnlessVerbose = if verbose then withVerbosity Loud 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
|
