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
498939a9
Commit
498939a9
authored
Jan 04, 2016
by
Andrey Mokhov
Browse files
Factor our common build actions into src/Rules/Actions.hs
parent
fd3a1f89
Changes
5
Hide whitespace changes
Inline
Side-by-side
src/Base.hs
View file @
498939a9
...
...
@@ -175,7 +175,7 @@ putError msg = do
-- | Render the given set of lines in a ASCII box
renderBox
::
[
String
]
->
String
renderBox
ls
=
unlines
$
[
begin
]
++
map
(
bar
++
)
ls
++
[
end
]
unlines
(
[
begin
]
++
map
(
bar
++
)
ls
)
++
end
where
(
begin
,
bar
,
end
)
|
useUnicode
=
(
"╭──────────"
...
...
src/Rules/Actions.hs
View file @
498939a9
{-# LANGUAGE RecordWildCards #-}
module
Rules.Actions
(
build
,
buildWithResources
)
where
module
Rules.Actions
(
build
,
buildWithResources
,
copyFile
,
createDirectory
,
moveDirectory
,
fixFile
,
runConfigure
,
runMake
,
runBuilder
)
where
import
qualified
System.Directory
as
IO
import
Base
import
Expression
import
Oracles.ArgsHash
import
Oracles.Config.Setting
import
Settings
import
Settings.Args
import
Settings.Builders.Ar
...
...
@@ -25,7 +31,14 @@ buildWithResources rs target = do
withResources
rs
$
do
unless
verbose
$
putInfo
target
quietlyUnlessVerbose
$
case
builder
of
Ar
->
arCmd
path
argList
Ar
->
do
output
<-
interpret
target
getOutput
if
"//*.a"
?==
output
then
arCmd
path
argList
else
do
input
<-
interpret
target
getInput
top
<-
setting
GhcSourcePath
cmd
[
path
]
[
Cwd
output
]
"x"
(
top
-/-
input
)
HsCpp
->
captureStdout
target
path
argList
GenApply
->
captureStdout
target
path
argList
...
...
@@ -49,13 +62,62 @@ captureStdout target path argList = do
Stdout
output
<-
cmd
[
path
]
argList
writeFileChanged
file
output
copyFile
::
FilePath
->
FilePath
->
Action
()
copyFile
source
target
=
do
putBuild
$
renderBox
[
"Copy file"
,
" input: "
++
source
,
"=> output: "
++
target
]
copyFileChanged
source
target
createDirectory
::
FilePath
->
Action
()
createDirectory
dir
=
do
putBuild
$
"| Create directory "
++
dir
liftIO
$
IO
.
createDirectoryIfMissing
True
dir
-- Note, the source directory is untracked
moveDirectory
::
FilePath
->
FilePath
->
Action
()
moveDirectory
source
target
=
do
putBuild
$
renderBox
[
"Move directory"
,
" input: "
++
source
,
"=> output: "
++
target
]
liftIO
$
IO
.
renameDirectory
source
target
-- Transform a given file by applying a function to its contents
fixFile
::
FilePath
->
(
String
->
String
)
->
Action
()
fixFile
file
f
=
do
putBuild
$
"| Fix "
++
file
old
<-
liftIO
$
readFile
file
let
new
=
f
old
length
new
`
seq
`
liftIO
$
writeFile
file
new
runConfigure
::
FilePath
->
[
CmdOption
]
->
[
String
]
->
Action
()
runConfigure
dir
opts
args
=
do
need
[
dir
-/-
"configure"
]
putBuild
$
"| Run configure in "
++
dir
++
"..."
quietly
$
cmd
Shell
(
EchoStdout
False
)
[
Cwd
dir
]
"bash configure"
opts
args
runMake
::
FilePath
->
[
String
]
->
Action
()
runMake
dir
args
=
do
need
[
dir
-/-
"Makefile"
]
let
note
=
if
null
args
then
""
else
" ("
++
intercalate
","
args
++
")"
putBuild
$
"| Run make"
++
note
++
" in "
++
dir
++
"..."
quietly
$
cmd
Shell
(
EchoStdout
False
)
"make"
[
"-C"
,
dir
,
"MAKEFLAGS="
]
args
runBuilder
::
Builder
->
[
String
]
->
Action
()
runBuilder
builder
args
=
do
needBuilder
laxDependencies
builder
path
<-
builderPath
builder
let
note
=
if
null
args
then
""
else
" ("
++
intercalate
","
args
++
")"
putBuild
$
"| Run "
++
show
builder
++
note
quietly
$
cmd
[
path
]
args
-- Print out key information about the command being executed
putInfo
::
Target
.
Target
->
Action
()
putInfo
(
Target
.
Target
{
..
})
=
putBuild
$
renderBox
$
[
"Run
ning
"
++
show
builder
putInfo
(
Target
.
Target
{
..
})
=
putBuild
$
renderBox
[
"Run "
++
show
builder
++
" ("
++
stageInfo
++
"package = "
++
pkgNameString
package
++
wayInfo
++
")
:
"
++
wayInfo
++
")"
,
" input: "
++
digest
inputs
,
"=> output: "
++
digest
outputs
]
where
...
...
src/Rules/Copy.hs
View file @
498939a9
...
...
@@ -3,6 +3,7 @@ module Rules.Copy (installTargets, copyRules) where
import
Base
import
Expression
import
GHC
import
Rules.Actions
import
Rules.Generate
import
Rules.Libffi
import
Settings.TargetDirectory
...
...
@@ -20,16 +21,10 @@ copyRules = do
when
(
length
ffiHPaths
/=
1
)
$
putError
$
"copyRules: exactly one ffi.h header expected"
++
"(found: "
++
show
ffiHPaths
++
")."
let
ffiHPath
=
takeDirectory
$
head
ffiHPaths
copy
ffih
ffiHPath
copyFile
(
takeDirectory
(
head
ffiHPaths
)
-/-
takeFileName
ffih
)
ffih
"inplace/lib/template-hsc.h"
<~
pkgPath
hsc2hs
"inplace/lib/platformConstants"
<~
derivedConstantsPath
"inplace/lib/settings"
<~
"."
where
file
<~
dir
=
file
%>
\
_
->
copy
file
dir
copy
file
dir
=
do
let
source
=
dir
-/-
takeFileName
file
copyFileChanged
source
file
putBuild
$
"| Copy "
++
source
++
" -> "
++
file
file
<~
dir
=
file
%>
\
_
->
copyFile
(
dir
-/-
file
)
file
src/Rules/Data.hs
View file @
498939a9
...
...
@@ -118,10 +118,9 @@ buildPackageData rs target @ (PartialTarget stage pkg) = do
-- is replaced by libraries_deepseq_dist-install_VERSION = 1.4.0.0
-- Reason: Shake's built-in makefile parser doesn't recognise slashes
postProcessPackageData
::
FilePath
->
Action
()
postProcessPackageData
file
=
do
contents
<-
fmap
(
filter
(
'$'
`
notElem
`)
.
lines
)
.
liftIO
$
readFile
file
length
contents
`
seq
`
writeFileLines
file
$
map
processLine
contents
postProcessPackageData
file
=
fixFile
file
fixPackageData
where
fixPackageData
=
unlines
.
map
processLine
.
filter
(
'$'
`
notElem
`)
.
lines
processLine
line
=
replaceSeparators
'_'
prefix
++
suffix
where
processLine
line
=
replaceSeparators
'_'
prefix
++
suffix
where
(
prefix
,
suffix
)
=
break
(
==
'='
)
line
(
prefix
,
suffix
)
=
break
(
==
'='
)
line
src/Rules/Program.hs
View file @
498939a9
...
...
@@ -59,7 +59,7 @@ buildWrapper :: PartialTarget -> Wrapper -> FilePath -> FilePath -> Action ()
buildWrapper
target
@
(
PartialTarget
stage
pkg
)
wrapper
wrapperPath
binPath
=
do
contents
<-
interpretPartial
target
$
wrapper
binPath
writeFileChanged
wrapperPath
contents
()
<-
cmd
"chmod +x "
[
wrapperPath
]
unit
$
cmd
"chmod +x "
[
wrapperPath
]
putSuccess
$
"| Successfully created wrapper for '"
++
pkgNameString
pkg
++
"' ("
++
show
stage
++
")."
...
...
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