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
190f3fde
Commit
190f3fde
authored
Aug 22, 2015
by
Andrey Mokhov
Browse files
Merge Base.hs and Util.hs.
parent
f68d70f0
Changes
35
Hide whitespace changes
Inline
Side-by-side
src/Base.hs
View file @
190f3fde
module
Base
(
module
Control
.
Applicative
,
module
Control
.
Monad
.
Extra
,
module
Data
.
Char
,
module
Data
.
Function
,
module
Data
.
List
,
module
Data
.
Maybe
,
module
Data
.
Monoid
,
module
Development
.
Shake
,
module
Development
.
Shake
.
Classes
,
module
Development
.
Shake
.
Config
,
module
Development
.
Shake
.
FilePath
,
module
Development
.
Shake
.
Util
,
shakeFilesPath
,
configPath
,
bootPackageConstraints
,
packageDependencies
module
System
.
Console
.
ANSI
,
shakeFilesPath
,
configPath
,
bootPackageConstraints
,
packageDependencies
,
replaceEq
,
replaceSeparators
,
decodeModule
,
unifyPath
,
(
-/-
),
chunksOfSize
,
putColoured
,
putOracle
,
putBuild
,
putSuccess
,
putError
,
bimap
,
minusOrd
,
intersectOrd
,
removeFileIfExists
)
where
import
Development.Shake
hiding
(
unit
)
import
Control.Applicative
import
Control.Monad.Extra
import
Data.Char
import
Data.Function
import
Data.List
import
Data.Maybe
import
Data.Monoid
import
Development.Shake
hiding
(
unit
,
(
*>
))
import
Development.Shake.Classes
import
Development.Shake.Config
import
Development.Shake.FilePath
import
Development.Shake.Util
import
System.Console.ANSI
import
qualified
System.Directory
as
IO
import
System.IO
-- Build system files and paths
shakeFilesPath
::
FilePath
shakeFilesPath
=
"_build/"
...
...
@@ -24,3 +48,94 @@ bootPackageConstraints = shakeFilesPath ++ "boot-package-constraints"
packageDependencies
::
FilePath
packageDependencies
=
shakeFilesPath
++
"package-dependencies"
-- Utility functions
replaceIf
::
(
a
->
Bool
)
->
a
->
[
a
]
->
[
a
]
replaceIf
p
to
=
map
(
\
from
->
if
p
from
then
to
else
from
)
replaceEq
::
Eq
a
=>
a
->
a
->
[
a
]
->
[
a
]
replaceEq
from
=
replaceIf
(
==
from
)
replaceSeparators
::
Char
->
String
->
String
replaceSeparators
=
replaceIf
isPathSeparator
-- Given a module name extract the directory and file names, e.g.:
-- decodeModule "Data.Functor.Identity" = ("Data/Functor/", "Identity")
decodeModule
::
String
->
(
FilePath
,
String
)
decodeModule
=
splitFileName
.
replaceEq
'.'
'/'
-- Normalise a path and convert all path separators to /, even on Windows.
unifyPath
::
FilePath
->
FilePath
unifyPath
=
toStandard
.
normaliseEx
-- Combine paths using </> and apply unifyPath to the result
(
-/-
)
::
FilePath
->
FilePath
->
FilePath
a
-/-
b
=
unifyPath
$
a
</>
b
infixr
6
-/-
-- (chunksOfSize size strings) splits a given list of strings into chunks not
-- exceeding the given 'size'.
chunksOfSize
::
Int
->
[
String
]
->
[[
String
]]
chunksOfSize
_
[]
=
[]
chunksOfSize
size
strings
=
reverse
chunk
:
chunksOfSize
size
rest
where
(
chunk
,
rest
)
=
go
[]
0
strings
go
res
_
[]
=
(
res
,
[]
)
go
res
chunkSize
(
s
:
ss
)
=
if
newSize
>
size
then
(
res
,
s
:
ss
)
else
go
(
s
:
res
)
newSize
ss
where
newSize
=
chunkSize
+
length
s
-- A more colourful version of Shake's putNormal
putColoured
::
Color
->
String
->
Action
()
putColoured
colour
msg
=
do
liftIO
$
setSGR
[
SetColor
Foreground
Vivid
colour
]
putNormal
msg
liftIO
$
setSGR
[]
liftIO
$
hFlush
stdout
-- Make oracle output more distinguishable
putOracle
::
String
->
Action
()
putOracle
=
putColoured
Blue
-- Make build output more distinguishable
putBuild
::
String
->
Action
()
putBuild
=
putColoured
White
-- A more colourful version of success message
putSuccess
::
String
->
Action
()
putSuccess
=
putColoured
Green
-- A more colourful version of error message
putError
::
String
->
Action
a
putError
msg
=
do
putColoured
Red
msg
error
$
"GHC build system error: "
++
msg
-- Depending on Data.Bifunctor only for this function seems an overkill
bimap
::
(
a
->
b
)
->
(
c
->
d
)
->
(
a
,
c
)
->
(
b
,
d
)
bimap
f
g
(
x
,
y
)
=
(
f
x
,
g
y
)
-- Depending on Data.List.Ordered only for these two functions seems an overkill
minusOrd
::
Ord
a
=>
[
a
]
->
[
a
]
->
[
a
]
minusOrd
[]
_
=
[]
minusOrd
xs
[]
=
xs
minusOrd
(
x
:
xs
)
(
y
:
ys
)
=
case
compare
x
y
of
LT
->
x
:
minusOrd
xs
(
y
:
ys
)
EQ
->
minusOrd
xs
ys
GT
->
minusOrd
(
x
:
xs
)
ys
intersectOrd
::
(
a
->
b
->
Ordering
)
->
[
a
]
->
[
b
]
->
[
a
]
intersectOrd
cmp
=
loop
where
loop
[]
_
=
[]
loop
_
[]
=
[]
loop
(
x
:
xs
)
(
y
:
ys
)
=
case
cmp
x
y
of
LT
->
loop
xs
(
y
:
ys
)
EQ
->
x
:
loop
xs
ys
GT
->
loop
(
x
:
xs
)
ys
-- Convenient helper function for removing a file that doesn't necessarily exist
removeFileIfExists
::
FilePath
->
Action
()
removeFileIfExists
f
=
liftIO
.
whenM
(
IO
.
doesFileExist
f
)
$
IO
.
removeFile
f
src/Builder.hs
View file @
190f3fde
...
...
@@ -2,7 +2,6 @@
module
Builder
(
Builder
(
..
),
builderPath
,
specified
,
needBuilder
)
where
import
Base
import
Util
import
GHC.Generics
(
Generic
)
import
Oracles
import
Stage
...
...
src/Expression.hs
View file @
190f3fde
{-# LANGUAGE FlexibleInstances #-}
module
Expression
(
module
Base
,
module
Control
.
Monad
.
Reader
,
module
Builder
,
module
Package
,
module
Stage
,
module
Util
,
module
Way
,
Expr
,
DiffExpr
,
fromDiffExpr
,
Predicate
,
(
?
),
(
??
),
notP
,
applyPredicate
,
...
...
@@ -22,7 +22,6 @@ import Control.Monad.Reader
import
Package
import
Stage
import
Target
(
Target
(
..
),
PartialTarget
(
..
),
fromPartial
)
import
Util
import
Way
-- Expr a is a computation that produces a value of type Action a and can read
...
...
src/Oracles/ArgsHash.hs
View file @
190f3fde
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
module
Oracles.ArgsHash
(
checkArgsHash
,
argsHashOracle
)
where
import
Base
import
Target
import
Expression
import
Settings
...
...
src/Oracles/Config.hs
View file @
190f3fde
...
...
@@ -2,7 +2,6 @@
module
Oracles.Config
(
askConfig
,
askConfigWithDefault
,
configOracle
)
where
import
Base
import
Util
import
qualified
Data.HashMap.Strict
as
Map
newtype
ConfigKey
=
ConfigKey
String
...
...
src/Oracles/Config/Flag.hs
View file @
190f3fde
...
...
@@ -5,7 +5,6 @@ module Oracles.Config.Flag (
)
where
import
Base
import
Util
import
Oracles.Config
import
Oracles.Config.Setting
...
...
src/Oracles/Dependencies.hs
View file @
190f3fde
...
...
@@ -6,7 +6,6 @@ module Oracles.Dependencies (
)
where
import
Base
import
Util
import
qualified
Data.HashMap.Strict
as
Map
newtype
DependenciesKey
=
DependenciesKey
(
FilePath
,
FilePath
)
...
...
src/Oracles/PackageData.hs
View file @
190f3fde
...
...
@@ -6,7 +6,6 @@ module Oracles.PackageData (
)
where
import
Base
import
Util
import
qualified
Data.HashMap.Strict
as
Map
-- For each (PackageData path) the file 'path/package-data.mk' contains
...
...
src/Oracles/PackageDeps.hs
View file @
190f3fde
...
...
@@ -6,7 +6,6 @@ module Oracles.PackageDeps (
)
where
import
Base
import
Util
import
Package
import
qualified
Data.HashMap.Strict
as
Map
...
...
src/Oracles/WindowsRoot.hs
View file @
190f3fde
...
...
@@ -5,7 +5,6 @@ module Oracles.WindowsRoot (
)
where
import
Base
import
Util
newtype
WindowsRoot
=
WindowsRoot
()
deriving
(
Show
,
Typeable
,
Eq
,
Hashable
,
Binary
,
NFData
)
...
...
src/Package.hs
View file @
190f3fde
...
...
@@ -6,7 +6,6 @@ module Package (
import
Base
import
GHC.Generics
(
Generic
)
import
Util
-- It is helpful to distinguish package names from strings.
type
PackageName
=
String
...
...
src/Predicates.hs
View file @
190f3fde
...
...
@@ -4,7 +4,6 @@ module Predicates (
registerPackage
,
splitObjects
)
where
import
Base
import
Expression
import
GHC
import
Oracles
...
...
src/Rules.hs
View file @
190f3fde
module
Rules
(
generateTargets
,
packageRules
)
where
import
Base
import
Expression
import
Oracles.PackageData
import
Rules.Package
import
Rules.Resources
import
Settings.Packages
import
Settings.User
import
Settings.Util
import
Settings.Ways
import
Settings
import
Target
(
PartialTarget
(
..
))
-- generateTargets needs top-level build targets
...
...
src/Rules/Actions.hs
View file @
190f3fde
module
Rules.Actions
(
build
,
buildWithResources
)
where
import
Base
import
Util
import
Target
hiding
(
builder
)
import
qualified
Target
import
Builder
...
...
@@ -10,7 +8,6 @@ import Oracles
import
Oracles.ArgsHash
import
Settings
import
Settings.Args
import
Settings.Builders.Ar
-- Build a given target using an appropriate builder and acquiring necessary
-- resources. Force a rebuilt if the argument list has changed since the last
...
...
src/Rules/Cabal.hs
View file @
190f3fde
module
Rules.Cabal
(
cabalRules
)
where
import
Base
import
Stage
import
Package
hiding
(
library
)
import
Expression
...
...
src/Rules/Compile.hs
View file @
190f3fde
...
...
@@ -2,7 +2,6 @@ module Rules.Compile (compilePackage) where
import
Way
import
Base
import
Util
import
Builder
import
Target
(
PartialTarget
(
..
),
fullTarget
,
fullTargetWithWay
)
import
Oracles.Dependencies
...
...
src/Rules/Config.hs
View file @
190f3fde
module
Rules.Config
(
configRules
)
where
import
Base
import
Util
-- We add the following line to 'configure.ac' in order to produce configuration
-- file "system.config" from "system.config.in" by running 'configure' script.
...
...
src/Rules/Data.hs
View file @
190f3fde
module
Rules.Data
(
buildPackageData
)
where
import
Base
import
Util
import
Target
(
PartialTarget
(
..
),
fullTarget
)
import
Package
import
Builder
...
...
src/Rules/Dependencies.hs
View file @
190f3fde
module
Rules.Dependencies
(
buildPackageDependencies
)
where
import
Base
import
Util
import
Builder
import
Package
import
Expression
...
...
src/Rules/Documentation.hs
View file @
190f3fde
module
Rules.Documentation
(
buildPackageDocumentation
)
where
import
Way
import
Base
import
Stage
import
Builder
import
Package
...
...
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