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
a644c321
Commit
a644c321
authored
Jan 17, 2015
by
Andrey Mokhov
Browse files
Add DependencyList oracle.
parent
a5a2fed8
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/Oracles.hs
View file @
a644c321
...
...
@@ -4,11 +4,14 @@ module Oracles (
module
Oracles
.
Option
,
module
Oracles
.
Builder
,
module
Oracles
.
PackageData
,
module
Oracles
.
DependencyList
,
oracleRules
)
where
import
Development.Shake.Config
import
Development.Shake.Util
import
qualified
Data.HashMap.Strict
as
M
import
Data.Bifunctor
import
Base
import
Util
import
Config
...
...
@@ -17,49 +20,67 @@ import Oracles.Flag
import
Oracles.Option
import
Oracles.Builder
import
Oracles.PackageData
import
Oracles.DependencyList
defaultConfig
,
userConfig
::
FilePath
defaultConfig
=
cfgPath
</>
"default.config"
userConfig
=
cfgPath
</>
"user.config"
-- Oracle for configuration files
.
-- Oracle for configuration files
configOracle
::
Rules
()
configOracle
=
do
cfg
<-
newCache
$
\
()
->
do
unless
(
doesFileExist
$
defaultConfig
<.>
"in"
)
$
do
error
$
"
\n
Default configuration file '"
++
(
defaultConfig
<.>
"in"
)
++
"' is missing; unwilling to proceed."
return
()
unless
(
doesFileExist
$
defaultConfig
<.>
"in"
)
$
redError_
$
"
\n
Default configuration file '"
++
(
defaultConfig
<.>
"in"
)
++
"' is missing; unwilling to proceed."
need
[
defaultConfig
]
put
Normal
$
"Parsing "
++
toStandard
defaultConfig
++
"..."
put
Oracle
$
"Parsing "
++
toStandard
defaultConfig
++
"..."
cfgDefault
<-
liftIO
$
readConfigFile
defaultConfig
existsUser
<-
doesFileExist
userConfig
cfgUser
<-
if
existsUser
then
do
put
Normal
$
"Parsing "
put
Oracle
$
"Parsing "
++
toStandard
userConfig
++
"..."
liftIO
$
readConfigFile
userConfig
else
do
putColoured
Dull
Red
$
putColoured
Red
$
"
\n
User defined configuration file '"
++
userConfig
++
"' is missing; "
++
"proceeding with default configuration.
\n
"
return
M
.
empty
putColoured
Vivid
Green
$
"Finished processing configuration files."
putColoured
Green
$
"Finished processing configuration files."
return
$
cfgUser
`
M
.
union
`
cfgDefault
addOracle
$
\
(
ConfigKey
key
)
->
M
.
lookup
key
<$>
cfg
()
return
()
-- Oracle for 'package-data.mk' files
.
-- Oracle for 'package-data.mk' files
packageDataOracle
::
Rules
()
packageDataOracle
=
do
pkgData
<-
newCache
$
\
file
->
do
need
[
file
]
put
Normal
$
"Parsing "
++
toStandard
file
++
"..."
put
Oracle
$
"Parsing "
++
toStandard
file
++
"..."
liftIO
$
readConfigFile
file
addOracle
$
\
(
PackageDataKey
(
file
,
key
))
->
M
.
lookup
key
<$>
pkgData
file
return
()
-- Oracle for 'path/dist/*.deps' files
dependencyOracle
::
Rules
()
dependencyOracle
=
do
deps
<-
newCache
$
\
depFile
->
do
need
[
depFile
]
putOracle
$
"Parsing "
++
toStandard
depFile
++
"..."
contents
<-
parseMakefile
<$>
(
liftIO
$
readFile
depFile
)
return
$
M
.
fromList
$
map
(
bimap
head
concat
.
unzip
)
$
groupBy
((
==
)
`
on
`
fst
)
$
sortBy
(
compare
`
on
`
fst
)
contents
addOracle
$
\
(
DependencyListKey
(
file
,
obj
))
->
M
.
lookup
obj
<$>
deps
file
return
()
oracleRules
::
Rules
()
oracleRules
=
configOracle
<>
packageDataOracle
oracleRules
=
configOracle
<>
packageDataOracle
<>
dependencyOracle
-- Make oracle's output more distinguishable
putOracle
::
String
->
Action
()
putOracle
=
putColoured
Blue
src/Oracles/DependencyList.hs
0 → 100644
View file @
a644c321
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
module
Oracles.DependencyList
(
DependencyList
(
..
),
DependencyListKey
(
..
)
)
where
import
Development.Shake.Classes
import
Base
import
Data.Maybe
data
DependencyList
=
DependencyList
FilePath
FilePath
newtype
DependencyListKey
=
DependencyListKey
(
FilePath
,
FilePath
)
deriving
(
Show
,
Typeable
,
Eq
,
Hashable
,
Binary
,
NFData
)
instance
ShowArgs
DependencyList
where
showArgs
(
DependencyList
file
obj
)
=
do
res
<-
askOracle
$
DependencyListKey
(
file
,
obj
)
return
$
fromMaybe
[]
res
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