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
9a6f6842
Commit
9a6f6842
authored
Aug 05, 2015
by
Andrey Mokhov
Browse files
Rename redError(_) to putError(_).
parent
327b06e5
Changes
4
Hide whitespace changes
Inline
Side-by-side
src/Builder.hs
View file @
9a6f6842
...
...
@@ -58,7 +58,7 @@ builderKey builder = case builder of
builderPath
::
Builder
->
Action
String
builderPath
builder
=
do
path
<-
askConfigWithDefault
(
builderKey
builder
)
$
red
Error
$
"
\n
Cannot find path to '"
++
(
builderKey
builder
)
put
Error
$
"
\n
Cannot find path to '"
++
(
builderKey
builder
)
++
"' in configuration files."
fixAbsolutePathOnWindows
$
if
null
path
then
""
else
path
-<.>
exe
...
...
src/Oracles/Base.hs
View file @
9a6f6842
...
...
@@ -22,7 +22,7 @@ askConfigWithDefault key defaultAction = do
Nothing
->
defaultAction
askConfig
::
String
->
Action
String
askConfig
key
=
askConfigWithDefault
key
.
red
Error
askConfig
key
=
askConfigWithDefault
key
.
put
Error
$
"Cannot find key '"
++
key
++
"' in configuration files."
-- Oracle for configuration files
...
...
@@ -31,7 +31,7 @@ configOracle = do
let
configFile
=
configPath
-/-
"system.config"
cfg
<-
newCache
$
\
()
->
do
unlessM
(
doesFileExist
$
configFile
<.>
"in"
)
$
red
Error_
$
"
\n
Configuration file '"
++
(
configFile
<.>
"in"
)
put
Error_
$
"
\n
Configuration file '"
++
(
configFile
<.>
"in"
)
++
"' is missing; unwilling to proceed."
need
[
configFile
]
putOracle
$
"Reading "
++
configFile
++
"..."
...
...
src/Oracles/Flag.hs
View file @
9a6f6842
...
...
@@ -28,9 +28,9 @@ flag f = do
SolarisBrokenShld
->
"solaris-broken-shld"
SplitObjectsBroken
->
"split-objects-broken"
GhcUnregisterised
->
"ghc-unregisterised"
value
<-
askConfigWithDefault
key
.
red
Error
value
<-
askConfigWithDefault
key
.
put
Error
$
"
\n
Flag '"
++
key
++
"' not set in configuration files."
unless
(
value
==
"YES"
||
value
==
"NO"
)
.
red
Error
unless
(
value
==
"YES"
||
value
==
"NO"
)
.
put
Error
$
"
\n
Flag '"
++
key
++
"' is set to '"
++
value
++
"' instead of 'YES' or 'NO'."
return
$
value
==
"YES"
...
...
src/Util.hs
View file @
9a6f6842
...
...
@@ -4,7 +4,7 @@ module Util (
replaceIf
,
replaceEq
,
replaceSeparators
,
unifyPath
,
(
-/-
),
chunksOfSize
,
putColoured
,
putOracle
,
putBuild
,
red
Error
,
red
Error_
,
putColoured
,
putOracle
,
putBuild
,
put
Error
,
put
Error_
,
bimap
,
minusOrd
,
intersectOrd
)
where
...
...
@@ -65,13 +65,13 @@ putBuild :: String -> Action ()
putBuild
=
putColoured
White
-- A more colourful version of error
red
Error
::
String
->
Action
a
red
Error
msg
=
do
put
Error
::
String
->
Action
a
put
Error
msg
=
do
putColoured
Red
msg
error
$
"GHC build system error: "
++
msg
red
Error_
::
String
->
Action
()
red
Error_
=
void
.
red
Error
put
Error_
::
String
->
Action
()
put
Error_
=
void
.
put
Error
-- Depending on Data.Bifunctor only for this function seems an overkill
bimap
::
(
a
->
b
)
->
(
c
->
d
)
->
(
a
,
c
)
->
(
b
,
d
)
...
...
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