30ae742e2b206b89b7db9e5756e7f61f18519630
[hadrian.git] / src / Rules / Actions.hs
1 module Rules.Actions (build, buildWithResources) where
2
3 import Expression
4 import Oracles.ArgsHash
5 import Settings
6 import Settings.Args
7 import Settings.Builders.Ar
8 import qualified Target
9
10 -- Build a given target using an appropriate builder and acquiring necessary
11 -- resources. Force a rebuilt if the argument list has changed since the last
12 -- built (that is, track changes in the build system).
13 buildWithResources :: [(Resource, Int)] -> Target -> Action ()
14 buildWithResources rs target = do
15 let builder = Target.builder target
16 needBuilder laxDependencies builder
17 path <- builderPath builder
18 argList <- interpret target getArgs
19 verbose <- interpret target verboseCommands
20 let quietlyUnlessVerbose = if verbose then withVerbosity Loud else quietly
21 -- The line below forces the rule to be rerun if the args hash has changed
22 checkArgsHash target
23 withResources rs $ do
24 unless verbose $ do
25 putBuild $ renderBox $ [ "Running " ++ show builder ++ " with arguments:" ]
26 ++ map (" "++) (interestingInfo builder argList)
27 quietlyUnlessVerbose $ case builder of
28 Ar -> arCmd path argList
29
30 HsCpp -> do
31 let file = head $ Target.outputs target -- TODO: ugly
32 Stdout output <- cmd [path] argList
33 writeFileChanged file output
34
35 GenPrimopCode -> do
36 let src = head $ Target.inputs target -- TODO: ugly
37 file = head $ Target.outputs target
38 input <- readFile' src
39 Stdout output <- cmd (Stdin input) [path] argList
40 writeFileChanged file output
41
42 _ -> cmd [path] argList
43
44 -- Most targets are built without explicitly acquiring resources
45 build :: Target -> Action ()
46 build = buildWithResources []
47
48 interestingInfo :: Builder -> [String] -> [String]
49 interestingInfo builder ss = case builder of
50 Alex -> prefixAndSuffix 0 3 ss
51 Ar -> prefixAndSuffix 2 1 ss
52 DeriveConstants -> prefixAndSuffix 3 0 ss
53 Gcc _ -> prefixAndSuffix 0 4 ss
54 GccM _ -> prefixAndSuffix 0 1 ss
55 Ghc _ -> prefixAndSuffix 0 4 ss
56 GhcCabal -> prefixAndSuffix 3 0 ss
57 GhcM _ -> prefixAndSuffix 1 1 ss
58 GhcPkg _ -> prefixAndSuffix 3 0 ss
59 Haddock -> prefixAndSuffix 1 0 ss
60 Happy -> prefixAndSuffix 0 3 ss
61 Hsc2Hs -> prefixAndSuffix 0 3 ss
62 HsCpp -> prefixAndSuffix 0 1 ss
63 Ld -> prefixAndSuffix 4 0 ss
64 _ -> ss
65 where
66 prefixAndSuffix n m list =
67 let len = length list in
68 if len <= n + m + 1
69 then list
70 else take n list
71 ++ ["... skipping " ++ show (len - n - m) ++ " arguments ..."]
72 ++ drop (len - m) list