2730c550ab5d5db2596220284dfbac0b2e7d2fd9
[hadrian.git] / src / Rules / Actions.hs
1 module Rules.Actions (
2 build, buildWithResources, run, verboseRun
3 ) where
4
5 import Util
6 import Builder
7 import Expression
8 import qualified Target
9 import Settings.Args
10 import Settings.Util
11 import Oracles.ArgsHash
12 import Development.Shake
13
14 -- Build a given target using an appropriate builder and acquiring necessary
15 -- resources. Force a rebuilt if the argument list has changed since the last
16 -- built (that is, track changes in the build system).
17 buildWithResources :: [(Resource, Int)] -> FullTarget -> Action ()
18 buildWithResources rs target = do
19 need $ Target.dependencies target
20 argList <- interpret target args
21 -- The line below forces the rule to be rerun if the args hash has changed
22 argsHash <- askArgsHash target
23 run rs (Target.builder target) argList
24
25 -- Most targets are built without explicitly acquiring resources
26 build :: FullTarget -> Action ()
27 build = buildWithResources []
28
29 -- Run the builder with a given collection of arguments
30 verboseRun :: [(Resource, Int)] -> Builder -> [String] -> Action ()
31 verboseRun rs builder args = do
32 needBuilder builder
33 path <- builderPath builder
34 withResources rs $ cmd [path] args
35
36 -- Run the builder with a given collection of arguments printing out a
37 -- terse commentary with only 'interesting' info for the builder.
38 run :: [(Resource, Int)] -> Builder -> [String] -> Action ()
39 run rs builder args = do
40 putColoured White $ "/--------\n" ++
41 "| Running " ++ show builder ++ " with arguments:"
42 mapM_ (putColoured White . ("| " ++)) $ interestingInfo builder args
43 putColoured White $ "\\--------"
44 quietly $ verboseRun rs builder args
45
46 interestingInfo :: Builder -> [String] -> [String]
47 interestingInfo builder ss = case builder of
48 Ar -> prefixAndSuffix 2 1 ss
49 Ld -> prefixAndSuffix 4 0 ss
50 Gcc _ -> prefixAndSuffix 0 4 ss
51 GccM _ -> prefixAndSuffix 0 1 ss
52 Ghc _ -> prefixAndSuffix 0 4 ss
53 GhcM _ -> prefixAndSuffix 1 1 ss
54 GhcPkg _ -> prefixAndSuffix 3 0 ss
55 GhcCabal -> prefixAndSuffix 3 0 ss
56 _ -> ss
57 where
58 prefixAndSuffix n m ss =
59 if length ss <= n + m + 1
60 then ss
61 else take n ss
62 ++ ["... skipping "
63 ++ show (length ss - n - m)
64 ++ " arguments ..."]
65 ++ drop (length ss - m) ss