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
92ef7772
Commit
92ef7772
authored
Jul 14, 2015
by
Andrey Mokhov
Browse files
Refactoring: Target is now defined in Target.hs, old Targets.hs is dropped.
parent
5db0017b
Changes
9
Hide whitespace changes
Inline
Side-by-side
src/Expression.hs
View file @
92ef7772
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude, FlexibleInstances #-}
module
Expression
(
module
Control
.
Monad
.
Reader
,
module
Target
,
module
Data
.
Monoid
,
module
Control
.
Monad
.
Reader
,
Expr
,
DiffExpr
,
fromDiffExpr
,
Predicate
,
Settings
,
Ways
,
Packages
,
Target
(
..
),
stageTarget
,
stagePackageTarget
,
Predicate
,
Settings
,
Ways
,
Packages
,
append
,
appendM
,
remove
,
appendSub
,
appendSubD
,
filterSub
,
removeSub
,
interpret
,
interpretExpr
,
applyPredicate
,
(
?
),
(
??
),
stage
,
package
,
builder
,
file
,
way
,
...
...
@@ -15,58 +13,12 @@ module Expression (
import
Base
hiding
(
arg
,
args
,
Args
,
TargetDir
)
import
Ways
import
Target
import
Oracles
import
Package
import
Data.Monoid
import
Development.Shake.Classes
import
GHC.Generics
import
Control.Monad.Reader
-- Target captures parameters relevant to the current build target: Stage and
-- Package being built, Builder that is to be invoked, file(s) that are to
-- be built and the Way they are to be built.
data
Target
=
Target
{
getStage
::
Stage
,
getPackage
::
Package
,
getBuilder
::
Builder
,
getFile
::
FilePath
,
-- TODO: handle multple files?
getWay
::
Way
}
deriving
(
Eq
,
Generic
)
-- Shows a target as "package:file@stage (builder, way)"
instance
Show
Target
where
show
target
=
show
(
getPackage
target
)
++
":"
++
show
(
getFile
target
)
++
"@"
++
show
(
getStage
target
)
++
" ("
++
show
(
getBuilder
target
)
++
", "
++
show
(
getWay
target
)
++
")"
instance
Binary
Target
instance
NFData
Target
instance
Hashable
Target
stageTarget
::
Stage
->
Target
stageTarget
stage
=
Target
{
getStage
=
stage
,
getPackage
=
error
"stageTarget: Package not set"
,
getBuilder
=
error
"stageTarget: Builder not set"
,
getFile
=
error
"stageTarget: File not set"
,
getWay
=
error
"stageTarget: Way not set"
}
stagePackageTarget
::
Stage
->
Package
->
Target
stagePackageTarget
stage
package
=
Target
{
getStage
=
stage
,
getPackage
=
package
,
getBuilder
=
error
"stagePackageTarget: Builder not set"
,
getFile
=
error
"stagePackageTarget: File not set"
,
getWay
=
error
"stagePackageTarget: Way not set"
}
-- Expr a is a computation that produces a value of type Action a and can read
-- parameters of the current build Target.
type
Expr
a
=
ReaderT
Target
Action
a
...
...
src/Settings.hs
View file @
92ef7772
...
...
@@ -5,7 +5,7 @@ module Settings (
import
Base
hiding
(
arg
,
args
)
import
Settings.GhcPkg
import
Settings.GhcCabal
import
User
Settings
import
Settings
.User
import
Expression
hiding
(
when
,
liftIO
)
settings
::
Settings
...
...
src/
Targets
.hs
→
src/
Settings/Default
.hs
View file @
92ef7772
module
Targets
(
defaultTargetDirectory
,
module
Settings.Default
(
defaultTargetDirectory
,
defaultKnownPackages
,
array
,
base
,
binPackageDb
,
binary
,
bytestring
,
cabal
,
compiler
,
containers
,
deepseq
,
directory
,
filepath
,
ghcPrim
,
haskeline
,
hoopl
,
hpc
,
integerGmp
,
integerGmp2
,
integerSimple
,
parallel
,
pretty
,
primitive
,
process
,
stm
,
templateHaskell
,
terminfo
,
time
,
transformers
,
unix
,
win32
,
xhtml
deepseq
,
directory
,
filepath
,
ghcPrim
,
haskeline
,
hoopl
,
hpc
,
integerGmp
,
integerGmp2
,
integerSimple
,
parallel
,
pretty
,
primitive
,
process
,
stm
,
templateHaskell
,
terminfo
,
time
,
transformers
,
unix
,
win32
,
xhtml
)
where
import
Base
hiding
(
arg
,
args
)
import
Base
import
Package
-- Build results will be placed into a target directory with the following
...
...
@@ -21,6 +21,19 @@ defaultTargetDirectory stage package
|
stage
==
Stage0
=
"dist-boot"
|
otherwise
=
"dist-install"
-- These are all packages we know about. Build rules will be generated for
-- all of them. However, not all of these packages will be built. For example,
-- package 'win32' is built only on Windows.
-- Settings/Packages.hs defines default conditions for building each package,
-- which can be overridden in UserSettings.hs.
defaultKnownPackages
::
[
Package
]
defaultKnownPackages
=
[
array
,
base
,
binPackageDb
,
binary
,
bytestring
,
cabal
,
compiler
,
containers
,
deepseq
,
directory
,
filepath
,
ghcPrim
,
haskeline
,
hoopl
,
hpc
,
integerGmp
,
integerGmp2
,
integerSimple
,
parallel
,
pretty
,
primitive
,
process
,
stm
,
templateHaskell
,
terminfo
,
time
,
transformers
,
unix
,
win32
,
xhtml
]
-- Package definitions
array
=
library
"array"
base
=
library
"base"
...
...
src/Settings/GhcCabal.hs
View file @
92ef7772
...
...
@@ -8,14 +8,13 @@ import Oracles.Builder
import
Ways
import
Util
import
Package
import
Targets
import
Switches
import
Expression
hiding
(
liftIO
)
import
Settings.User
import
Settings.Ways
import
Settings.Util
import
Settings.Packages
import
Settings.TargetDirectory
import
UserSettings
cabalSettings
::
Settings
cabalSettings
=
builder
GhcCabal
?
do
...
...
src/Settings/Packages.hs
View file @
92ef7772
...
...
@@ -4,10 +4,9 @@ module Settings.Packages (
import
Base
import
Package
import
Targets
import
Switches
import
Expression
import
User
Settings
import
Settings
.User
-- Combining default list of packages with user modifications
packages
::
Packages
...
...
@@ -33,17 +32,5 @@ packagesStage1 = mconcat
,
notWindowsHost
?
append
[
unix
]
,
buildHaddock
?
append
[
xhtml
]
]
-- These are all packages we know about. Build rules will be generated for
-- all of them. However, not all of these packages will be built. For example,
-- package 'win32' is built only on Windows.
-- Settings/Packages.hs defines default conditions for building each package,
-- which can be overridden in UserSettings.hs.
knownPackages
::
[
Package
]
knownPackages
=
defaultKnownPackages
++
userKnownPackages
defaultKnownPackages
::
[
Package
]
defaultKnownPackages
=
[
array
,
base
,
binPackageDb
,
binary
,
bytestring
,
cabal
,
compiler
,
containers
,
deepseq
,
directory
,
filepath
,
ghcPrim
,
haskeline
,
hoopl
,
hpc
,
integerLibrary
,
parallel
,
pretty
,
primitive
,
process
,
stm
,
templateHaskell
,
terminfo
,
time
,
transformers
,
unix
,
win32
,
xhtml
]
src/Settings/TargetDirectory.hs
View file @
92ef7772
...
...
@@ -4,7 +4,7 @@ module Settings.TargetDirectory (
import
Base
import
Package
import
User
Settings
import
Settings
.User
-- User can override the default target directory settings given below
targetDirectory
::
Stage
->
Package
->
FilePath
...
...
src/
User
Settings.hs
→
src/Settings
/User
.hs
View file @
92ef7772
module
UserSettings
(
module
Settings.User
(
module
Settings
.
Default
,
userSettings
,
userPackages
,
userWays
,
userTargetDirectory
,
userKnownPackages
,
integerLibrary
,
buildHaddock
,
validating
...
...
@@ -6,7 +7,7 @@ module UserSettings (
import
Base
hiding
(
arg
,
args
,
Args
)
import
Package
import
Targets
import
Settings.Default
import
Expression
-- No user-specific settings by default
...
...
@@ -26,7 +27,7 @@ userKnownPackages = []
userWays
::
Ways
userWays
=
mempty
-- Control where build results go
-- Control where build results go
(see Settings.Default for an example)
userTargetDirectory
::
Stage
->
Package
->
FilePath
userTargetDirectory
=
defaultTargetDirectory
...
...
src/Settings/Ways.hs
View file @
92ef7772
...
...
@@ -6,7 +6,7 @@ import Base
import
Ways
hiding
(
defaultWays
)
import
Switches
import
Expression
import
User
Settings
import
Settings
.User
-- Combining default ways with user modifications
ways
::
Ways
...
...
src/Target.hs
0 → 100644
View file @
92ef7772
{-# LANGUAGE DeriveGeneric #-}
module
Target
(
Target
(
..
),
stageTarget
,
stagePackageTarget
)
where
import
Base
import
Ways
import
Oracles
import
Package
import
GHC.Generics
import
Development.Shake.Classes
-- Target captures parameters relevant to the current build target: Stage and
-- Package being built, Builder that is to be invoked, file(s) that are to
-- be built and the Way they are to be built.
data
Target
=
Target
{
getStage
::
Stage
,
getPackage
::
Package
,
getBuilder
::
Builder
,
getFile
::
FilePath
,
-- TODO: handle multple files?
getWay
::
Way
}
deriving
(
Eq
,
Generic
)
-- Shows a target as "package:file@stage (builder, way)"
instance
Show
Target
where
show
target
=
show
(
getPackage
target
)
++
":"
++
show
(
getFile
target
)
++
"@"
++
show
(
getStage
target
)
++
" ("
++
show
(
getBuilder
target
)
++
", "
++
show
(
getWay
target
)
++
")"
stageTarget
::
Stage
->
Target
stageTarget
stage
=
Target
{
getStage
=
stage
,
getPackage
=
error
"stageTarget: Package not set"
,
getBuilder
=
error
"stageTarget: Builder not set"
,
getFile
=
error
"stageTarget: File not set"
,
getWay
=
error
"stageTarget: Way not set"
}
stagePackageTarget
::
Stage
->
Package
->
Target
stagePackageTarget
stage
package
=
Target
{
getStage
=
stage
,
getPackage
=
package
,
getBuilder
=
error
"stagePackageTarget: Builder not set"
,
getFile
=
error
"stagePackageTarget: File not set"
,
getWay
=
error
"stagePackageTarget: Way not set"
}
-- Instances for storing Target in the Shake database
instance
Binary
Target
instance
NFData
Target
instance
Hashable
Target
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