Squashed 'hadrian/' content from commit 438dc57
[ghc.git] / src / Hadrian / Oracles / ArgsHash.hs
1 {-# LANGUAGE TypeFamilies #-}
2 module Hadrian.Oracles.ArgsHash (
3 TrackArgument, trackAllArguments, trackArgsHash, argsHashOracle
4 ) where
5
6 import Control.Monad
7 import Development.Shake
8 import Development.Shake.Classes
9
10 import Hadrian.Expression hiding (inputs, outputs)
11 import Hadrian.Target
12
13 -- | 'TrackArgument' is used to specify the arguments that should be tracked by
14 -- the @ArgsHash@ oracle. The safest option is to track all arguments, but some
15 -- arguments, such as @-jN@, do not change the build results, hence there is no
16 -- need to initiate unnecessary rebuild if they are added to or removed from a
17 -- command line. If all arguments should be tracked, use 'trackAllArguments'.
18 type TrackArgument c b = Target c b -> String -> Bool
19
20 -- | Returns 'True' for all targets and arguments, hence can be used a safe
21 -- default for 'argsHashOracle'.
22 trackAllArguments :: TrackArgument c b
23 trackAllArguments _ _ = True
24
25 -- | Given a 'Target' this 'Action' determines the corresponding argument list
26 -- and computes its hash. The resulting value is tracked in a Shake oracle,
27 -- hence initiating rebuilds when the hash changes (a hash change indicates
28 -- changes in the build command for the given target).
29 -- Note: for efficiency we replace the list of input files with its hash to
30 -- avoid storing long lists of source files passed to some builders (e.g. ar)
31 -- in the Shake database. This optimisation is normally harmless, because
32 -- argument list constructors are assumed not to examine target sources, but
33 -- only append them to argument lists where appropriate.
34 trackArgsHash :: (ShakeValue c, ShakeValue b) => Target c b -> Action ()
35 trackArgsHash t = do
36 let hashedInputs = [ show $ hash (inputs t) ]
37 hashedTarget = target (context t) (builder t) hashedInputs (outputs t)
38 void (askOracle $ ArgsHash hashedTarget :: Action Int)
39
40 newtype ArgsHash c b = ArgsHash (Target c b)
41 deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
42 type instance RuleResult (ArgsHash c b) = Int
43
44 -- | This oracle stores per-target argument list hashes in the Shake database,
45 -- allowing the user to track them between builds using 'trackArgsHash' queries.
46 argsHashOracle :: (ShakeValue c, ShakeValue b) => TrackArgument c b -> Args c b -> Rules ()
47 argsHashOracle trackArgument args = void $
48 addOracle $ \(ArgsHash target) -> do
49 argList <- interpret target args
50 let trackedArgList = filter (trackArgument target) argList
51 return $ hash trackedArgList