Skip to content
GitLab
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
acf66a3c
Commit
acf66a3c
authored
Aug 08, 2017
by
Andrey Mokhov
Browse files
Simplify oracles
parent
d3ef19d2
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/Hadrian/Oracles/ArgsHash.hs
View file @
acf66a3c
...
...
@@ -35,16 +35,16 @@ trackArgsHash :: (ShakeValue c, ShakeValue b) => Target c b -> Action ()
trackArgsHash
t
=
do
let
hashedInputs
=
[
show
$
hash
(
inputs
t
)
]
hashedTarget
=
target
(
context
t
)
(
builder
t
)
hashedInputs
(
outputs
t
)
void
(
askOracle
$
ArgsHash
Key
hashedTarget
::
Action
Int
)
void
(
askOracle
$
ArgsHash
hashedTarget
::
Action
Int
)
newtype
ArgsHash
Key
c
b
=
ArgsHash
Key
(
Target
c
b
)
newtype
ArgsHash
c
b
=
ArgsHash
(
Target
c
b
)
deriving
(
Binary
,
Eq
,
Hashable
,
NFData
,
Show
,
Typeable
)
-- | 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
$
\
(
ArgsHash
Key
target
)
->
do
addOracle
$
\
(
ArgsHash
target
)
->
do
argList
<-
interpret
target
args
let
trackedArgList
=
filter
(
trackArgument
target
)
argList
return
$
hash
trackedArgList
src/Hadrian/Oracles/Config.hs
View file @
acf66a3c
...
...
@@ -10,7 +10,7 @@ import Development.Shake.Config
import
Hadrian.Utilities
newtype
Config
Key
=
Config
Key
String
newtype
Config
=
Config
String
deriving
(
Binary
,
Eq
,
Hashable
,
NFData
,
Show
,
Typeable
)
-- | Lookup a configuration setting raising an error if the key is not found.
...
...
@@ -21,7 +21,7 @@ unsafeAskConfig key = (fromMaybe $ error msg) <$> askConfig key
-- | Lookup a configuration setting.
askConfig
::
String
->
Action
(
Maybe
String
)
askConfig
=
askOracle
.
Config
Key
askConfig
=
askOracle
.
Config
-- | This oracle reads and parses a configuration file consisting of key-value
-- pairs @key = value@ and answers 'askConfig' queries tracking the results.
...
...
@@ -31,4 +31,4 @@ configOracle configFile = void $ do
need
[
configFile
]
putLoud
$
"Reading "
++
configFile
++
"..."
liftIO
$
readConfigFile
configFile
addOracle
$
\
(
Config
Key
key
)
->
Map
.
lookup
key
<$>
cfg
()
addOracle
$
\
(
Config
key
)
->
Map
.
lookup
key
<$>
cfg
()
src/Oracles/Dependencies.hs
View file @
acf66a3c
...
...
@@ -15,7 +15,7 @@ import Settings
import
Settings.Builders.GhcCabal
import
Settings.Path
newtype
ObjDepsKey
=
ObjDepsKe
y
(
FilePath
,
FilePath
)
newtype
Dependency
=
Dependenc
y
(
FilePath
,
FilePath
)
deriving
(
Binary
,
Eq
,
Hashable
,
NFData
,
Show
,
Typeable
)
-- | 'Action' @fileDependencies context file@ looks up dependencies of a @file@
...
...
@@ -26,15 +26,12 @@ newtype ObjDepsKey = ObjDepsKey (FilePath, FilePath)
fileDependencies
::
Context
->
FilePath
->
Action
(
FilePath
,
[
FilePath
])
fileDependencies
context
obj
=
do
let
path
=
buildPath
context
-/-
".dependencies"
deps
<-
askOracle
$
ObjDepsKe
y
(
path
,
obj
)
deps
<-
askOracle
$
Dependenc
y
(
path
,
obj
)
case
deps
of
Nothing
->
error
$
"No dependencies found for file "
++
obj
Just
[]
->
error
$
"No source file found for file "
++
obj
Just
(
source
:
files
)
->
return
(
source
,
files
)
newtype
PkgDepsKey
=
PkgDepsKey
String
deriving
(
Binary
,
Eq
,
Hashable
,
NFData
,
Show
,
Typeable
)
-- | Given a 'Context' this 'Action' looks up its package dependencies in
-- 'Settings.Paths.packageDependencies' using 'packageDependenciesOracle', and
-- wraps found dependencies in appropriate contexts. The only subtlety here is
...
...
@@ -45,7 +42,7 @@ contextDependencies :: Context -> Action [Context]
contextDependencies
context
@
Context
{
..
}
=
do
let
pkgContext
=
\
pkg
->
Context
(
min
stage
Stage1
)
pkg
way
unpack
=
fromMaybe
.
error
$
"No dependencies for "
++
show
context
deps
<-
unpack
<$>
askOracle
(
PkgDepsKey
$
pkgNameString
package
)
deps
<-
unpack
<$>
askOracle
(
Dependency
(
packageDependencies
,
pkgNameString
package
)
)
pkgs
<-
sort
<$>
interpretInContext
(
pkgContext
package
)
getPackages
return
.
map
pkgContext
$
intersectOrd
(
compare
.
pkgNameString
)
pkgs
deps
...
...
@@ -74,16 +71,11 @@ needLibrary cs = need =<< concatMapM libraryTargets cs
-- | Oracles for the package dependencies and 'path/dist/.dependencies' files.
dependenciesOracles
::
Rules
()
dependenciesOracles
=
do
deps
<-
newCache
readDependencies
void
$
addOracle
$
\
(
ObjDepsKey
(
file
,
obj
))
->
Map
.
lookup
obj
<$>
deps
file
pkgDeps
<-
newCache
$
\
_
->
readDependencies
packageDependencies
void
$
addOracle
$
\
(
PkgDepsKey
pkg
)
->
Map
.
lookup
pkg
<$>
pkgDeps
()
where
readDependencies
file
=
do
deps
<-
newCache
$
\
file
->
do
putLoud
$
"Reading dependencies from "
++
file
++
"..."
contents
<-
map
words
<$>
readFileLines
file
return
$
Map
.
fromList
[
(
key
,
values
)
|
(
key
:
values
)
<-
contents
]
void
$
addOracle
$
\
(
Dependency
(
file
,
key
))
->
Map
.
lookup
key
<$>
deps
file
-- | Topological sort of packages according to their dependencies.
-- HACK (izgzhen): See https://github.com/snowleopard/hadrian/issues/344 for details
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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