Minor clean up, taking hlint suggestions
[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 builderEnvironment
18 ) where
19
20 import Data.List
21 import Development.Shake
22
23 import Hadrian.Expression hiding (inputs, outputs)
24 import Hadrian.Oracles.ArgsHash
25 import Hadrian.Target
26 import Hadrian.Utilities
27
28 -- | This data structure captures all information relevant to invoking a builder.
29 data BuildInfo = BuildInfo {
30 -- | Command line arguments.
31 buildArgs :: [String],
32 -- | Input files.
33 buildInputs :: [FilePath],
34 -- | Output files.
35 buildOutputs :: [FilePath],
36 -- | Options to be passed to Shake's 'cmd' function.
37 buildOptions :: [CmdOption],
38 -- | Resources to be aquired.
39 buildResources :: [(Resource, Int)] }
40
41 class ShakeValue b => Builder b where
42 -- | The path to a builder.
43 builderPath :: b -> Action FilePath
44
45 -- | Make sure a builder exists and rebuild it if out of date.
46 needBuilder :: b -> Action ()
47 needBuilder builder = do
48 path <- builderPath builder
49 need [path]
50
51 -- | Run a builder with a given 'BuildInfo'. Also see 'runBuilder'.
52 runBuilderWith :: b -> BuildInfo -> Action ()
53 runBuilderWith builder buildInfo = do
54 let args = buildArgs buildInfo
55 needBuilder builder
56 path <- builderPath builder
57 let msg = if null args then "" else " (" ++ intercalate ", " args ++ ")"
58 putBuild $ "| Run " ++ show builder ++ msg
59 quietly $ cmd (buildOptions buildInfo) [path] args
60
61 -- | Run a builder with a specified list of command line arguments, reading a
62 -- list of input files and writing a list of output files. A lightweight version
63 -- of 'runBuilderWith'.
64 runBuilder :: Builder b => b -> [String] -> [FilePath] -> [FilePath] -> Action ()
65 runBuilder = runBuilderWithCmdOptions []
66
67 -- | Like 'runBuilder' but passes given options to Shake's 'cmd'.
68 runBuilderWithCmdOptions :: Builder b => [CmdOption] -> b -> [String] -> [FilePath] -> [FilePath] -> Action ()
69 runBuilderWithCmdOptions opts builder args inputs outputs =
70 runBuilderWith builder $ BuildInfo { buildArgs = args
71 , buildInputs = inputs
72 , buildOutputs = outputs
73 , buildOptions = opts
74 , buildResources = [] }
75
76 -- | Build a 'Target' using the list of command line arguments computed from a
77 -- given 'Args' expression. Force a rebuild if the argument list has changed
78 -- since the last build.
79 build :: (Builder b, ShakeValue c) => Target c b -> Args c b -> Action ()
80 build = buildWith [] []
81
82 -- | Like 'build' but acquires necessary resources.
83 buildWithResources :: (Builder b, ShakeValue c) => [(Resource, Int)] -> Target c b -> Args c b -> Action ()
84 buildWithResources rs = buildWith rs []
85
86 -- | Like 'build' but passes given options to Shake's 'cmd'.
87 buildWithCmdOptions :: (Builder b, ShakeValue c) => [CmdOption] -> Target c b -> Args c b -> Action ()
88 buildWithCmdOptions = buildWith []
89
90 buildWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action ()
91 buildWith rs opts target args = do
92 needBuilder (builder target)
93 argList <- interpret target args
94 trackArgsHash target -- Rerun the rule if the hash of argList has changed.
95 putInfo target
96 verbose <- interpret target verboseCommand
97 let quietlyUnlessVerbose = if verbose then withVerbosity Loud else quietly
98 quietlyUnlessVerbose $ runBuilderWith (builder target) $
99 BuildInfo { 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
119
120 -- | Write a builder path into a given environment variable.
121 builderEnvironment :: Builder b => String -> b -> Action CmdOption
122 builderEnvironment variable builder = do
123 needBuilder builder
124 path <- builderPath builder
125 return $ AddEnv variable path