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
03f90e74
Commit
03f90e74
authored
Jul 19, 2015
by
Andrey Mokhov
Browse files
Remove Base.hs, move Stage definition to Stage.hs.
parent
272f1005
Changes
32
Show whitespace changes
Inline
Side-by-side
src/Base.hs
deleted
100644 → 0
View file @
272f1005
{-# LANGUAGE DeriveGeneric, FlexibleInstances #-}
module
Base
(
module
Development
.
Shake
,
module
Development
.
Shake
.
FilePath
,
module
Control
.
Applicative
,
module
Data
.
Function
,
module
Data
.
Monoid
,
--module Data.List,
Stage
(
..
),
Arg
,
ArgList
,
ShowArg
(
..
),
ShowArgs
(
..
),
productArgs
,
concatArgs
)
where
import
Development.Shake
hiding
((
*>
))
import
Development.Shake.FilePath
import
Control.Applicative
import
Data.Function
import
Data.Monoid
import
GHC.Generics
import
Development.Shake.Classes
data
Stage
=
Stage0
|
Stage1
|
Stage2
|
Stage3
deriving
(
Eq
,
Enum
,
Generic
)
instance
Show
Stage
where
show
=
show
.
fromEnum
-- The returned string or list of strings is a part of an argument list
-- to be passed to a Builder
type
Arg
=
Action
String
type
ArgList
=
Action
[
String
]
instance
Monoid
a
=>
Monoid
(
Action
a
)
where
mempty
=
return
mempty
mappend
p
q
=
mappend
<$>
p
<*>
q
class
ShowArg
a
where
showArg
::
a
->
Arg
instance
ShowArg
String
where
showArg
=
return
instance
ShowArg
a
=>
ShowArg
(
Action
a
)
where
showArg
=
(
showArg
=<<
)
class
ShowArgs
a
where
showArgs
::
a
->
ArgList
instance
ShowArgs
[
String
]
where
showArgs
=
return
instance
ShowArgs
a
=>
ShowArgs
(
Action
a
)
where
showArgs
=
(
showArgs
=<<
)
-- Generate a cross product collection of two argument collections
-- Example: productArgs ["-a", "-b"] "c" = args ["-a", "c", "-b", "c"]
productArgs
::
(
ShowArgs
a
,
ShowArgs
b
)
=>
a
->
b
->
ArgList
productArgs
as
bs
=
do
as'
<-
showArgs
as
bs'
<-
showArgs
bs
return
$
concat
$
sequence
[
as'
,
bs'
]
-- Similar to productArgs but concat resulting arguments pairwise
-- Example: concatArgs ["-a", "-b"] "c" = args ["-ac", "-bc"]
concatArgs
::
(
ShowArgs
a
,
ShowArgs
b
)
=>
a
->
b
->
ArgList
concatArgs
as
bs
=
do
as'
<-
showArgs
as
bs'
<-
showArgs
bs
return
$
map
concat
$
sequence
[
as'
,
bs'
]
-- Instances for storing in the Shake database
instance
Binary
Stage
instance
Hashable
Stage
src/Builder.hs
View file @
03f90e74
...
...
@@ -4,14 +4,16 @@ module Builder (
Builder
(
..
),
builderKey
,
builderPath
,
needBuilder
)
where
import
Base
import
Util
import
Stage
import
Data.List
import
Oracles.Base
import
Oracles.Flag
import
Oracles.Setting
import
GHC.Generics
import
Development.Shake
import
Development.Shake.Classes
import
Development.Shake.FilePath
-- A Builder is an external command invoked in separate process using Shake.cmd
--
...
...
src/Config.hs
View file @
03f90e74
...
...
@@ -2,8 +2,9 @@ module Config (
autoconfRules
,
configureRules
,
cfgPath
)
where
import
Base
import
Util
import
Development.Shake
import
Development.Shake.FilePath
cfgPath
::
FilePath
cfgPath
=
"shake"
</>
"cfg"
...
...
src/Expression.hs
View file @
03f90e74
...
...
@@ -12,14 +12,15 @@ module Expression (
)
where
import
Way
import
Bas
e
import
Stag
e
import
Builder
import
Package
import
Target
import
Data.List
import
Oracles.Base
import
Data.List
import
Data.Monoid
import
Control.Monad.Reader
hiding
(
liftIO
)
import
Development.Shake
-- Expr a is a computation that produces a value of type Action a and can read
-- parameters of the current build Target.
...
...
src/Main.hs
View file @
03f90e74
import
Base
import
Rules
import
Config
import
Development.Shake
main
=
shakeArgs
shakeOptions
{
shakeFiles
=
"_build/"
}
$
do
oracleRules
-- see module Rules.Oracles
...
...
src/Oracles.hs
View file @
03f90e74
...
...
@@ -3,17 +3,20 @@ module Oracles (
configOracle
,
packageDataOracle
,
dependencyOracle
)
where
import
Development.Shake.Config
import
Development.Shake.Util
import
qualified
Data.HashMap.Strict
as
M
import
Base
import
Util
import
Config
import
Control.Monad.Extra
import
Oracles.Base
import
Oracles.PackageData
import
Oracles.DependencyList
import
Data.List
import
Data.Function
import
qualified
Data.HashMap.Strict
as
M
import
Control.Applicative
import
Control.Monad.Extra
import
Development.Shake
import
Development.Shake.Util
import
Development.Shake.Config
import
Development.Shake.FilePath
-- Oracle for configuration files
configOracle
::
Rules
()
...
...
src/Oracles/ArgsHash.hs
View file @
03f90e74
...
...
@@ -4,9 +4,10 @@ module Oracles.ArgsHash (
ArgsHashKey
(
..
),
askArgsHash
,
argsHashOracle
)
where
import
Base
import
Expression
import
Settings.Args
import
Control.Applicative
import
Development.Shake
import
Development.Shake.Classes
newtype
ArgsHashKey
=
ArgsHashKey
FullTarget
...
...
src/Oracles/Base.hs
View file @
03f90e74
...
...
@@ -5,8 +5,8 @@ module Oracles.Base (
askConfigWithDefault
,
askConfig
)
where
import
Base
import
Util
import
Development.Shake
import
Development.Shake.Classes
newtype
ConfigKey
=
ConfigKey
String
...
...
src/Oracles/DependencyList.hs
View file @
03f90e74
...
...
@@ -2,19 +2,20 @@
module
Oracles.DependencyList
(
DependencyList
(
..
),
DependencyListKey
(
..
)
DependencyListKey
(
..
),
dependencyList
)
where
import
Development.Shake.Classes
import
Base
import
Data.Maybe
import
Development.Shake
import
Development.Shake.Classes
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
dependencyList
::
DependencyList
->
Action
[
FilePath
]
dependencyList
(
DependencyList
file
obj
)
=
do
res
<-
askOracle
$
DependencyListKey
(
file
,
obj
)
return
$
fromMaybe
[]
res
src/Oracles/Flag.hs
View file @
03f90e74
...
...
@@ -3,9 +3,9 @@ module Oracles.Flag (
test
)
where
import
Base
import
Util
import
Oracles.Base
import
Development.Shake
data
Flag
=
LaxDeps
|
DynamicGhcPrograms
...
...
src/Oracles/PackageData.hs
View file @
03f90e74
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
module
Oracles.PackageData
(
PackageData
(
..
),
MultiPackageData
(
..
),
PackageDataKey
(
..
),
askPackageData
PackageData
(
..
),
PackageDataMulti
(
..
),
PackageDataKey
(
..
),
pkgData
,
pkgDataMulti
)
where
import
Development.Shake.Classes
import
Base
import
Util
import
Data.List
import
Data.Maybe
import
Development.Shake
import
Development.Shake.Classes
import
Development.Shake.FilePath
-- For each (PackageData path) the file 'path/package-data.mk' contains
-- a line of the form 'path_VERSION = 1.2.3.4'.
--
(showArg
$ PackageData path
)
is an action that consults the file and
--
pkgData
$ PackageData path is an action that consults the file and
-- returns "1.2.3.4".
--
--
Multi
PackageData is used for multiple string options separated by spaces,
-- PackageData
Multi
is used for multiple string options separated by spaces,
-- such as 'path_MODULES = Data.Array Data.Array.Base ...'.
--
(showArgs
Modules
)
therefore returns ["Data.Array", "Data.Array.Base", ...]
.
--
pkgMultiData
Modules therefore returns ["Data.Array", "Data.Array.Base", ...]
data
PackageData
=
Version
FilePath
|
PackageKey
FilePath
|
Synopsis
FilePath
data
Multi
PackageData
=
Modules
FilePath
data
PackageData
Multi
=
Modules
FilePath
|
SrcDirs
FilePath
|
IncludeDirs
FilePath
|
Deps
FilePath
...
...
@@ -47,9 +49,8 @@ askPackageData path key = do
return
$
fromMaybe
(
error
$
"No key '"
++
key
++
"' in "
++
pkgData
++
"."
)
value
-- TODO: remove
instance
ShowArg
PackageData
where
showArg
packageData
=
do
pkgData
::
PackageData
->
Action
String
pkgData
packageData
=
do
let
(
key
,
path
)
=
case
packageData
of
Version
path
->
(
"VERSION"
,
path
)
PackageKey
path
->
(
"PACKAGE_KEY"
,
path
)
...
...
@@ -58,11 +59,10 @@ instance ShowArg PackageData where
pkgData
=
path
</>
"package-data.mk"
res
<-
askOracle
$
PackageDataKey
(
pkgData
,
fullKey
)
return
$
fromMaybe
(
error
$
"No key '"
++
key
++
"' in "
++
unifyPath
pkgData
++
"."
)
res
(
error
$
"No key '"
++
key
++
"' in "
++
unifyPath
pkgData
++
"."
)
res
instance
ShowArgs
MultiPackageData
where
showArgs
packageData
=
do
pkgData
Multi
::
PackageData
Multi
->
Action
[
String
]
pkgDataMulti
packageData
=
do
let
(
key
,
path
,
defaultValue
)
=
case
packageData
of
Modules
path
->
(
"MODULES"
,
path
,
""
)
SrcDirs
path
->
(
"HS_SRC_DIRS"
,
path
,
"."
)
...
...
@@ -74,8 +74,7 @@ instance ShowArgs MultiPackageData where
HsArgs
path
->
(
"HC_OPTS"
,
path
,
""
)
CcArgs
path
->
(
"CC_OPTS"
,
path
,
""
)
CSrcs
path
->
(
"C_SRCS"
,
path
,
""
)
DepIncludeDirs
path
->
(
"DEP_INCLUDE_DIRS_SINGLE_QUOTED"
,
path
,
""
)
DepIncludeDirs
path
->
(
"DEP_INCLUDE_DIRS_SINGLE_QUOTED"
,
path
,
""
)
fullKey
=
replaceSeparators
'_'
$
path
++
"_"
++
key
pkgData
=
path
</>
"package-data.mk"
unquote
=
dropWhile
(
==
'
\'
'
)
.
dropWhileEnd
(
==
'
\'
'
)
...
...
src/Oracles/Setting.hs
View file @
03f90e74
module
Oracles.Setting
(
Setting
(
..
),
Multi
Setting
(
..
),
setting
,
multiS
etting
,
Setting
(
..
),
Setting
Multi
(
..
),
setting
,
s
etting
Multi
,
windowsHost
)
where
import
Bas
e
import
Stag
e
import
Oracles.Base
import
Development.Shake
-- Each Setting comes from the system.config file, e.g. 'target-os = mingw32'.
-- setting TargetOs looks up the config file and returns "mingw32".
--
--
Multi
Setting is used for multiple string values separated by spaces, such
-- Setting
Multi
is used for multiple string values separated by spaces, such
-- as 'src-hc-args = -H32m -O'.
--
multiS
etting SrcHcArgs therefore returns a list of strings ["-H32", "-O"].
--
s
etting
Multi
SrcHcArgs therefore returns a list of strings ["-H32", "-O"].
data
Setting
=
TargetOs
|
TargetArch
|
TargetPlatformFull
...
...
@@ -21,7 +22,7 @@ data Setting = TargetOs
|
ProjectVersion
|
GhcSourcePath
data
Multi
Setting
=
SrcHcArgs
data
Setting
Multi
=
SrcHcArgs
|
ConfCcArgs
Stage
|
ConfGccLinkerArgs
Stage
|
ConfLdLinkerArgs
Stage
...
...
@@ -41,8 +42,8 @@ setting s = askConfig $ case s of
ProjectVersion
->
"project-version"
GhcSourcePath
->
"ghc-source-path"
multiS
etting
::
MultiSetting
->
Action
[
String
]
multiS
etting
s
=
fmap
words
$
askConfig
$
case
s
of
s
ettingMulti
::
Setting
Multi
->
Action
[
String
]
s
etting
Multi
s
=
fmap
words
$
askConfig
$
case
s
of
SrcHcArgs
->
"src-hc-args"
ConfCcArgs
stage
->
"conf-cc-args"
++
showStage
stage
ConfCppArgs
stage
->
"conf-cpp-args"
++
showStage
stage
...
...
src/Package.hs
View file @
03f90e74
...
...
@@ -2,10 +2,11 @@
module
Package
(
Package
(
..
),
library
,
topLevel
,
setCabal
)
where
import
Base
import
Util
import
Data.Function
import
GHC.Generics
import
Development.Shake.Classes
import
Development.Shake.FilePath
-- pkgPath is the path to the source code relative to the root
data
Package
=
Package
...
...
src/Rules.hs
View file @
03f90e74
...
...
@@ -3,13 +3,14 @@ module Rules (
module
Rules
.
Package
,
)
where
import
Base
import
Control.Monad
import
Stage
import
Expression
import
Rules.Package
import
Rules.Oracles
import
Settings.Packages
import
Settings.TargetDirectory
import
Development.Shake
import
Development.Shake.FilePath
-- generateTargets needs package-data.mk files of all target packages
-- TODO: make interpretDiff total
...
...
src/Rules/Actions.hs
View file @
03f90e74
...
...
@@ -2,12 +2,12 @@ module Rules.Actions (
build
,
buildWhen
,
run
,
verboseRun
,
)
where
import
Base
import
Util
import
Builder
import
Expression
import
Settings.Args
import
Oracles.ArgsHash
import
Development.Shake
-- Build a given target using an appropriate builder. Force a rebuilt if the
-- argument list has changed since the last built (that is, track changes in
...
...
src/Rules/Data.hs
View file @
03f90e74
...
...
@@ -4,17 +4,19 @@ module Rules.Data (
cabalArgs
,
ghcPkgArgs
,
buildPackageData
)
where
import
Base
import
Util
import
Package
import
Builder
import
Switches
import
Expression
import
Control.Monad.Extra
import
Settings.GhcPkg
import
Settings.GhcCabal
import
Settings.TargetDirectory
import
Rules.Actions
import
Util
import
Control.Applicative
import
Control.Monad.Extra
import
Development.Shake
import
Development.Shake.FilePath
-- Build package-data.mk by using GhcCabal to process pkgCabal file
buildPackageData
::
StagePackageTarget
->
Rules
()
...
...
src/Rules/Oracles.hs
View file @
03f90e74
...
...
@@ -2,9 +2,10 @@ module Rules.Oracles (
oracleRules
)
where
import
Base
import
Oracles
import
Oracles.ArgsHash
import
Data.Monoid
import
Development.Shake
oracleRules
::
Rules
()
oracleRules
=
...
...
src/Rules/Package.hs
View file @
03f90e74
...
...
@@ -2,9 +2,9 @@ module Rules.Package (
buildPackage
)
where
import
Base
import
Rules.Data
import
Expression
import
Development.Shake
buildPackage
::
StagePackageTarget
->
Rules
()
buildPackage
=
buildPackageData
src/Settings/Args.hs
View file @
03f90e74
...
...
@@ -2,10 +2,9 @@ module Settings.Args (
args
)
where
import
Ba
se
import
Settings.U
se
r
import
Settings.GhcPkg
import
Settings.GhcCabal
import
Settings.User
import
Expression
args
::
Args
...
...
src/Settings/Default.hs
View file @
03f90e74
...
...
@@ -7,7 +7,7 @@ module Settings.Default (
templateHaskell
,
terminfo
,
time
,
transformers
,
unix
,
win32
,
xhtml
)
where
import
Bas
e
import
Stag
e
import
Package
-- Build results will be placed into a target directory with the following
...
...
Prev
1
2
Next
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