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
e874fed8
Commit
e874fed8
authored
Jan 21, 2016
by
Andrey Mokhov
Browse files
Add initial support for --configure command line flag.
parent
87c6fae6
Changes
5
Hide whitespace changes
Inline
Side-by-side
src/CmdLineFlag.hs
View file @
e874fed8
module
CmdLineFlag
(
putCmdLineFlags
,
flags
,
cmdProgressInfo
,
ProgressInfo
(
..
),
cmdSplitObjects
putCmdLineFlags
,
flags
,
cmdProgressInfo
,
ProgressInfo
(
..
),
cmdSplitObjects
,
Configure
(
..
),
cmdConfigure
)
where
import
Base
import
Data.Char
(
toLower
)
import
Data.List.Extra
import
System.Console.GetOpt
import
Data.IORef
...
...
@@ -11,24 +11,27 @@ import System.IO.Unsafe (unsafePerformIO)
-- Command line flags
data
ProgressInfo
=
None
|
Brief
|
Normal
|
Unicorn
deriving
(
Eq
,
Show
)
data
Configure
=
SkipConfigure
|
RunConfigure
String
deriving
(
Eq
,
Show
)
-- | 'CmdLineFlag.Untracked' is a collection of flags that can be passed via the
-- command line. These flags are not tracked, that is they do not force any
-- build rules to be rurun.
data
Untracked
=
Untracked
{
progressInfo
::
ProgressInfo
,
splitObjects
::
Bool
}
,
splitObjects
::
Bool
,
configure
::
Configure
}
deriving
(
Eq
,
Show
)
-- | Default values for 'CmdLineFlag.Untracked'.
defaultUntracked
::
Untracked
defaultUntracked
=
Untracked
{
progressInfo
=
Normal
,
splitObjects
=
False
}
,
splitObjects
=
False
,
configure
=
SkipConfigure
}
readProgressInfo
::
Maybe
String
->
Either
String
(
Untracked
->
Untracked
)
readProgressInfo
ms
=
maybe
(
Left
"no parse"
)
(
Right
.
mkClosure
)
(
go
=<<
fmap
(
map
toLower
)
ms
)
maybe
(
Left
"
Can
no
t
parse
progressInfo
"
)
(
Right
.
set
)
(
go
=<<
lower
<$>
ms
)
where
go
::
String
->
Maybe
ProgressInfo
go
"none"
=
Just
None
...
...
@@ -36,19 +39,31 @@ readProgressInfo ms =
go
"normal"
=
Just
Normal
go
"unicorn"
=
Just
Unicorn
go
_
=
Nothing
-- Left "no parse"
mkClosure
::
ProgressInfo
->
Untracked
->
Untracked
mkClosure
flag
flags
=
flags
{
progressInfo
=
flag
}
set
::
ProgressInfo
->
Untracked
->
Untracked
set
flag
flags
=
flags
{
progressInfo
=
flag
}
readConfigure
::
Maybe
String
->
Either
String
(
Untracked
->
Untracked
)
readConfigure
ms
=
maybe
(
Left
"Cannot parse configure"
)
(
Right
.
set
)
(
go
$
lower
<$>
ms
)
where
go
::
Maybe
String
->
Maybe
Configure
go
(
Just
args
)
=
Just
$
RunConfigure
args
go
Nothing
=
Just
$
RunConfigure
""
set
::
Configure
->
Untracked
->
Untracked
set
flag
flags
=
flags
{
configure
=
flag
}
readSplitObjects
::
Either
String
(
Untracked
->
Untracked
)
readSplitObjects
=
Right
$
\
flags
->
flags
{
splitObjects
=
True
}
flags
::
[
OptDescr
(
Either
String
(
Untracked
->
Untracked
))]
flags
=
[
Option
[]
[
"progress-info"
]
(
OptArg
readProgressInfo
""
)
"Progress
I
nfo
S
tyle (None, Brief, Normal, or Unicorn)"
flags
=
[
Option
[]
[
"progress-info"
]
(
OptArg
readProgressInfo
"
STYLE
"
)
"Progress
i
nfo
s
tyle (None, Brief, Normal, or Unicorn)
.
"
,
Option
[]
[
"split-objects"
]
(
NoArg
readSplitObjects
)
"Generate split objects (requires a full clean rebuild)."
]
"Generate split objects (requires a full clean rebuild)."
,
Option
[]
[
"configure"
]
(
OptArg
readConfigure
"ARGS"
)
"Run boot and configure scripts (passing ARGS to the latter)."
]
-- TODO:
Get rid of
unsafePerformIO by using shakeExtra
.
-- TODO:
Avoid
unsafePerformIO by using shakeExtra
(awaiting Shake's release)
{-# NOINLINE cmdLineFlags #-}
cmdLineFlags
::
IORef
Untracked
cmdLineFlags
=
unsafePerformIO
$
newIORef
defaultUntracked
...
...
@@ -56,11 +71,16 @@ cmdLineFlags = unsafePerformIO $ newIORef defaultUntracked
putCmdLineFlags
::
[
Untracked
->
Untracked
]
->
IO
()
putCmdLineFlags
flags
=
modifyIORef
cmdLineFlags
(
\
f
->
foldl
(
flip
id
)
f
flags
)
getCmdLineFlags
::
Action
Untracked
getCmdLineFlags
=
liftIO
$
readIORef
cmdLineFlags
-- TODO: Avoid unsafePerformIO by using shakeExtra (awaiting Shake's release)
{-# NOINLINE getCmdLineFlags #-}
getCmdLineFlags
::
Untracked
getCmdLineFlags
=
unsafePerformIO
$
readIORef
cmdLineFlags
cmdProgressInfo
::
ProgressInfo
cmdProgressInfo
=
progressInfo
getCmdLineFlags
cmd
ProgressInfo
::
Action
ProgressInfo
cmd
ProgressInfo
=
progressInfo
<$>
getCmdLineFlags
cmd
SplitObjects
::
Bool
cmd
SplitObjects
=
splitObjects
getCmdLineFlags
cmd
SplitObjects
::
Action
Bool
cmd
SplitObjects
=
splitObjects
<$>
getCmdLineFlags
cmd
Configure
::
Configure
cmd
Configure
=
configure
getCmdLineFlags
src/Rules/Actions.hs
View file @
e874fed8
...
...
@@ -67,7 +67,7 @@ captureStdout target path argList = do
copyFile
::
FilePath
->
FilePath
->
Action
()
copyFile
source
target
=
do
putProgressInfo
=<<
renderAction
"Copy file"
source
target
putProgressInfo
$
renderAction
"Copy file"
source
target
copyFileChanged
source
target
createDirectory
::
FilePath
->
Action
()
...
...
@@ -83,7 +83,7 @@ removeDirectory dir = do
-- Note, the source directory is untracked
moveDirectory
::
FilePath
->
FilePath
->
Action
()
moveDirectory
source
target
=
do
putProgressInfo
=<<
renderAction
"Move directory"
source
target
putProgressInfo
$
renderAction
"Move directory"
source
target
liftIO
$
IO
.
renameDirectory
source
target
-- Transform a given file by applying a function to its contents
...
...
@@ -97,8 +97,13 @@ fixFile file f = do
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
if
dir
==
"."
then
do
putBuild
$
"| Run configure..."
quietly
$
cmd
Shell
(
EchoStdout
False
)
"bash configure"
opts'
args
else
do
putBuild
$
"| Run configure in "
++
dir
++
"..."
quietly
$
cmd
Shell
(
EchoStdout
False
)
[
Cwd
dir
]
"bash configure"
opts'
args
where
-- Always configure with bash.
-- This also injects /bin/bash into `libtool`, instead of /bin/sh
...
...
@@ -145,7 +150,7 @@ makeExecutable file = do
-- Print out key information about the command being executed
putInfo
::
Target
.
Target
->
Action
()
putInfo
Target
.
Target
{
..
}
=
putProgressInfo
=<<
renderAction
putInfo
Target
.
Target
{
..
}
=
putProgressInfo
$
renderAction
(
"Run "
++
show
builder
++
" ("
++
stageInfo
++
"package = "
++
pkgNameString
package
++
wayInfo
++
")"
)
(
digest
inputs
)
...
...
@@ -157,25 +162,21 @@ putInfo Target.Target {..} = putProgressInfo =<< renderAction
digest
[
x
]
=
x
digest
(
x
:
xs
)
=
x
++
" (and "
++
show
(
length
xs
)
++
" more)"
-- |
Switch for
@putBuild@
filtered through @progressInfo@
-- |
Version of
@putBuild@
controlled by @progressInfo@ command line flag.
putProgressInfo
::
String
->
Action
()
putProgressInfo
msg
=
do
skip
<-
(
None
==
)
<$>
cmdProgressInfo
unless
skip
$
putBuild
msg
putProgressInfo
msg
=
when
(
cmdProgressInfo
/=
None
)
$
putBuild
msg
-- | Render an action.
renderAction
::
String
->
String
->
String
->
Action
String
renderAction
what
input
output
=
do
style
<-
cmdProgressInfo
return
$
case
style
of
Normal
->
renderBox
[
what
renderAction
::
String
->
String
->
String
->
String
renderAction
what
input
output
=
case
cmdProgressInfo
of
Normal
->
renderBox
[
what
,
" input: "
++
input
,
" => output: "
++
output
]
Brief
->
"| "
++
what
++
": "
++
input
++
" => "
++
output
Unicorn
->
renderUnicorn
[
what
,
" input: "
++
input
,
" => output: "
++
output
]
Brief
->
"| "
++
what
++
": "
++
input
++
" => "
++
output
Unicorn
->
renderUnicorn
[
what
,
" input: "
++
input
,
" => output: "
++
output
]
None
->
""
None
->
""
-- | Render the successful build of a program
renderProgram
::
String
->
String
->
String
->
String
...
...
src/Rules/Cabal.hs
View file @
e874fed8
...
...
@@ -8,7 +8,6 @@ import Distribution.PackageDescription.Parse
import
Distribution.Verbosity
import
Expression
import
GHC
import
Rules.Actions
import
Settings
cabalRules
::
Rules
()
...
...
src/Rules/Config.hs
View file @
e874fed8
module
Rules.Config
(
configRules
)
where
import
Base
import
Settings.User
import
CmdLineFlag
import
Rules.Actions
-- TODO: Consider removing this file.
configRules
::
Rules
()
configRules
=
when
buildSystemConfigFile
$
do
configPath
-/-
"system.config"
%>
\
_
->
do
need
[
configPath
-/-
"system.config.in"
,
"configure"
]
putBuild
"Running configure..."
cmd
"bash configure"
-- TODO: get rid of 'bash'
configRules
=
case
cmdConfigure
of
SkipConfigure
->
mempty
RunConfigure
args
->
do
configPath
-/-
"system.config"
%>
\
_
->
do
need
[
configPath
-/-
"system.config.in"
]
runConfigure
"."
[]
[
args
]
"configure"
%>
\
_
->
do
putBuild
"Running
autoconf
..."
cmd
"bash autoconf"
-- TODO: get rid of 'bash'
"configure"
%>
\
_
->
do
putBuild
"
|
Running
boot
..."
unit
$
cmd
"perl boot"
src/Settings/User.hs
View file @
e874fed8
...
...
@@ -2,8 +2,8 @@ module Settings.User (
buildRootPath
,
trackBuildSystem
,
compileInterfaceFilesSeparately
,
userArgs
,
userPackages
,
userLibraryWays
,
userRtsWays
,
userKnownPackages
,
integerLibrary
,
buildHaddock
,
validating
,
ghciWithDebugger
,
ghcProfiled
,
ghcDebugged
,
dynamicGhcPrograms
,
laxDependencies
,
buildSystemConfigFile
,
verboseCommands
,
turnWarningsIntoErrors
,
splitObjects
ghcDebugged
,
dynamicGhcPrograms
,
laxDependencies
,
verboseCommands
,
turnWarningsIntoErrors
,
splitObjects
)
where
import
Base
...
...
@@ -61,7 +61,7 @@ validating = False
-- | Control when split objects are generated. Note, due to the GHC bug #11315
-- it is necessary to do a full clean rebuild when changing this option.
splitObjects
::
Predicate
splitObjects
=
(
lift
$
cmdSplitObjects
)
&&^
defaultSplitObjects
splitObjects
=
(
return
cmdSplitObjects
)
&&^
defaultSplitObjects
dynamicGhcPrograms
::
Bool
dynamicGhcPrograms
=
False
...
...
@@ -86,9 +86,6 @@ laxDependencies = False
buildHaddock
::
Predicate
buildHaddock
=
return
False
-- FIXME: should be return True, see #98
buildSystemConfigFile
::
Bool
buildSystemConfigFile
=
False
-- | Set to True to print full command lines during the build process. Note,
-- this is a Predicate, hence you can enable verbose output for a chosen package
-- only, e.g.: verboseCommands = package ghcPrim
...
...
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