f1b27b0724e3615922992561a8d27d6c4b5d0ab0
[ghc.git] / src / Hadrian / Builder.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Hadrian.Builder
4 -- Copyright : (c) Andrey Mokhov 2014-2017
5 -- License : MIT (see the file LICENSE)
6 -- Maintainer : andrey.mokhov@gmail.com
7 -- Stability : experimental
8 --
9 -- A typical build system invokes several build tools, or /builders/, such as
10 -- compilers, linkers, etc., some of which may be built by the build system
11 -- itself. This module defines the 'Builder' type class and a few associated
12 -- functions that can be used to invoke builders.
13 -----------------------------------------------------------------------------
14 module Hadrian.Builder (
15 Builder (..), BuildInfo (..), runBuilder, runBuilderWithCmdOptions,
16 build, buildWithResources, buildWithCmdOptions, getBuilderPath
17 ) where
18
19 import Data.List
20 import Development.Shake
21
22 import Hadrian.Expression hiding (inputs, outputs)
23 import Hadrian.Oracles.ArgsHash
24 import Hadrian.Target
25 import Hadrian.Utilities
26
27 -- | This data structure captures all information relevant to invoking a builder.
28 data BuildInfo = BuildInfo {
29 -- | Command line arguments.
30 buildArgs :: [String],
31 -- | Input files.
32 buildInputs :: [FilePath],
33 -- | Output files.
34 buildOutputs :: [FilePath],
35 -- | Options to be passed to Shake's 'cmd' function.
36 buildOptions :: [CmdOption],
37 -- | Resources to be aquired.
38 buildResources :: [(Resource, Int)] }
39
40 class ShakeValue b => Builder b where
41 -- | The path to a builder.
42 builderPath :: b -> Action FilePath
43
44 -- | Make sure a builder exists and rebuild it if out of date.
45 needBuilder :: b -> Action ()
46 needBuilder builder = do
47 path <- builderPath builder
48 need [path]
49
50 -- | Run a builder with a given 'BuildInfo'. Also see 'runBuilder'.
51 runBuilderWith :: b -> BuildInfo -> Action ()
52 runBuilderWith builder buildInfo = do
53 let args = buildArgs buildInfo
54 needBuilder builder
55 path <- builderPath builder
56 let msg = if null args then "" else " (" ++ intercalate ", " args ++ ")"
57 putBuild $ "| Run " ++ show builder ++ msg
58 quietly $ cmd (buildOptions buildInfo) [path] args
59
60 -- | Run a builder with a specified list of command line arguments, reading a
61 -- list of input files and writing a list of output files. A lightweight version
62 -- of 'runBuilderWith'.
63 runBuilder :: Builder b => b -> [String] -> [FilePath] -> [FilePath] -> Action ()
64 runBuilder = runBuilderWithCmdOptions []
65
66 -- | Like 'runBuilder' but passes given options to Shake's 'cmd'.
67 runBuilderWithCmdOptions :: Builder b => [CmdOption] -> b -> [String] -> [FilePath] -> [FilePath] -> Action ()
68 runBuilderWithCmdOptions opts builder args inputs outputs =
69 runBuilderWith builder $ BuildInfo { buildArgs = args
70 , buildInputs = inputs
71 , buildOutputs = outputs
72 , buildOptions = opts
73 , buildResources = [] }
74
75 -- | Build a 'Target' using the list of command line arguments computed from a
76 -- given 'Args' expression. Force a rebuild if the argument list has changed
77 -- since the last build.
78 build :: (Builder b, ShakeValue c) => Target c b -> Args c b -> Action ()
79 build = buildWith [] []
80
81 -- | Like 'build' but acquires necessary resources.
82 buildWithResources :: (Builder b, ShakeValue c) => [(Resource, Int)] -> Target c b -> Args c b -> Action ()
83 buildWithResources rs = buildWith rs []
84
85 -- | Like 'build' but passes given options to Shake's 'cmd'.
86 buildWithCmdOptions :: (Builder b, ShakeValue c) => [CmdOption] -> Target c b -> Args c b -> Action ()
87 buildWithCmdOptions = buildWith []
88
89 buildWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action ()
90 buildWith rs opts target args = do
91 needBuilder (builder target)
92 argList <- interpret target args
93 trackArgsHash target -- Rerun the rule if the hash of argList has changed.
94 putInfo target
95 verbose <- interpret target verboseCommand
96 let quietlyUnlessVerbose = if verbose then withVerbosity Loud else quietly
97 quietlyUnlessVerbose $ do
98 runBuilderWith (builder target) $ BuildInfo
99 { buildArgs = argList
100 , buildInputs = inputs target
101 , buildOutputs = outputs target
102 , buildOptions = opts
103 , buildResources = rs }
104
105 -- | Print out information about the command being executed.
106 putInfo :: Show b => Target c b -> Action ()
107 putInfo t = putProgressInfo =<< renderAction
108 ("Run " ++ show (builder t)) -- TODO: Bring back contextInfo.
109 (digest $ inputs t)
110 (digest $ outputs t)
111 where
112 digest [] = "none"
113 digest [x] = x
114 digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)"
115
116 -- | Get the path to the current builder.
117 getBuilderPath :: Builder b => b -> Expr c b FilePath
118 getBuilderPath = expr . builderPath