Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
5e1d004c
Commit
5e1d004c
authored
Aug 06, 2017
by
Andrey Mokhov
Browse files
Minor revision
parent
a432cffc
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/Hadrian/Oracles/ArgsHash.hs
View file @
5e1d004c
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module
Hadrian.Oracles.ArgsHash
(
TrackArgument
,
trackAllArguments
,
che
ckArgsHash
,
argsHashOracle
TrackArgument
,
trackAllArguments
,
tra
ckArgsHash
,
argsHashOracle
)
where
import
Control.Monad
...
...
@@ -34,13 +34,14 @@ newtype ArgsHashKey c b = ArgsHashKey (Target c b)
-- in the Shake database. This optimisation is normally harmless, because
-- argument list constructors are assumed not to examine target sources, but
-- only append them to argument lists where appropriate.
che
ckArgsHash
::
(
ShakeValue
c
,
ShakeValue
b
)
=>
Target
c
b
->
Action
()
che
ckArgsHash
t
=
do
tra
ckArgsHash
::
(
ShakeValue
c
,
ShakeValue
b
)
=>
Target
c
b
->
Action
()
tra
ckArgsHash
t
=
do
let
hashedInputs
=
[
show
$
hash
(
inputs
t
)
]
hashedTarget
=
target
(
context
t
)
(
builder
t
)
hashedInputs
(
outputs
t
)
void
(
askOracle
$
ArgsHashKey
hashedTarget
::
Action
Int
)
-- | Oracle for storing per-target argument list hashes.
-- | This oracle stores per-target argument list hashes in the Shake database,
-- allowing the user to track them between builds using 'trackArgsHash' queries.
argsHashOracle
::
(
ShakeValue
c
,
ShakeValue
b
)
=>
TrackArgument
c
b
->
Args
c
b
->
Rules
()
argsHashOracle
trackArgument
args
=
void
$
addOracle
$
\
(
ArgsHashKey
target
)
->
do
...
...
src/Util.hs
View file @
5e1d004c
...
...
@@ -51,7 +51,7 @@ customBuild rs opts target = do
argList
<-
interpret
target
getArgs
verbose
<-
interpret
target
verboseCommands
let
quietlyUnlessVerbose
=
if
verbose
then
withVerbosity
Loud
else
quietly
che
ckArgsHash
target
-- Rerun the rule if the hash of argList has changed.
tra
ckArgsHash
target
-- Rerun the rule if the hash of argList has changed.
withResources
rs
$
do
putInfo
target
quietlyUnlessVerbose
$
case
targetBuilder
of
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment