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
Packages
Cabal
Commits
db80c23e
Commit
db80c23e
authored
Aug 29, 2007
by
Duncan Coutts
Browse files
More register cleanups to do with ghc-pkg args
parent
348270ff
Changes
2
Hide whitespace changes
Inline
Side-by-side
Distribution/Simple/Compiler.hs
View file @
db80c23e
...
...
@@ -45,7 +45,7 @@ module Distribution.Simple.Compiler (
module
Distribution
.
Compiler
,
Compiler
(
..
),
showCompilerId
,
compilerVersion
,
compilerPath
,
compilerPkgToolPath
,
compilerPkgToolArgs
,
compilerPath
,
compilerPkgToolPath
,
-- * Support for language extensions
Flag
,
...
...
@@ -90,9 +90,6 @@ compilerPath = programPath . compilerProg
compilerPkgToolPath
::
Compiler
->
FilePath
compilerPkgToolPath
=
programPath
.
compilerPkgTool
compilerPkgToolArgs
::
Compiler
->
[
ProgArg
]
compilerPkgToolArgs
=
programArgs
.
compilerPkgTool
-- ------------------------------------------------------------
-- * Extensions
-- ------------------------------------------------------------
...
...
Distribution/Simple/Register.hs
View file @
db80c23e
...
...
@@ -66,9 +66,11 @@ import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), distPref,
InstallDirTemplates
(
..
),
absoluteInstallDirs
,
toPathTemplate
)
import
Distribution.Simple.Compiler
(
CompilerFlavor
(
..
),
Compiler
(
..
),
compilerPkgToolPath
,
compilerVersion
)
import
Distribution.Program
(
ConfiguredProgram
(
..
),
ProgramLocation
(
..
))
import
Distribution.Setup
(
RegisterFlags
(
..
),
CopyDest
(
..
),
userOverride
)
compilerVersion
)
import
Distribution.Simple.Program
(
ConfiguredProgram
,
programPath
,
programArgs
,
rawSystemProgram
,
lookupProgram
,
ghcPkgProgram
)
import
Distribution.Simple.Setup
(
RegisterFlags
(
..
),
CopyDest
(
..
),
userOverride
)
import
Distribution.PackageDescription
(
setupMessage
,
PackageDescription
(
..
),
BuildInfo
(
..
),
Library
(
..
),
haddockName
)
import
Distribution.Package
(
PackageIdentifier
(
..
),
showPackageId
)
...
...
@@ -79,7 +81,7 @@ import Distribution.InstalledPackageInfo
emptyInstalledPackageInfo
)
import
qualified
Distribution.InstalledPackageInfo
as
IPI
import
Distribution.Simple.Utils
(
createDirectoryIfMissingVerbose
,
rawSystemExit
,
copyFileVerbose
,
die
)
copyFileVerbose
,
die
)
import
Distribution.Simple.GHC.PackageConfig
(
mkGHCPackageConfig
,
showGHCPackageConfig
)
import
qualified
Distribution.Simple.GHC.PackageConfig
as
GHC
(
localPackageConfig
,
canWriteLocalPackageConfig
,
maybeCreateLocalPackageConfig
)
...
...
@@ -133,7 +135,6 @@ register pkg_descr lbi regFlags
verbosity
=
regVerbose
regFlags
user
=
regUser
regFlags
`
userOverride
`
userConf
lbi
inplace
=
regInPlace
regFlags
hc
=
compiler
lbi
message
|
genPkgConf
=
"Writing package registration file: "
++
genPkgConfigFile
++
" for"
|
genScript
=
"Writing registration script: "
...
...
@@ -141,7 +142,7 @@ register pkg_descr lbi regFlags
|
otherwise
=
"Registering"
setupMessage
(
regVerbose
regFlags
)
message
pkg_descr
case
compilerFlavor
hc
of
case
compilerFlavor
(
compiler
lbi
)
of
GHC
->
do
config_flags
<-
if
user
...
...
@@ -176,16 +177,14 @@ register pkg_descr lbi regFlags
in
"--update-package"
:
conf
let
allFlags
=
config_flags
++
register_flags
let
Just
pkgTool
=
lookupProgram
ghcPkgProgram
(
withPrograms
lbi
)
case
()
of
_
|
genPkgConf
->
return
()
|
genScript
->
do
cfg
<-
showInstalledConfig
pkg_descr
lbi
inplace
rawSystemPipe
regScriptLocation
verbosity
cfg
(
compilerPkgToolPath
hc
)
(
compilerPkgToolArgs
hc
++
allFlags
)
_
->
rawSystemProgramConf
verbosity
ghcPkgProgram
(
withPrograms
lbi
)
allFlags
rawSystemPipe
pkgTool
regScriptLocation
cfg
allFlags
_
->
rawSystemProgram
verbosity
pkgTool
allFlags
Hugs
->
do
when
inplace
$
die
"--inplace is not supported with Hugs"
...
...
@@ -322,9 +321,8 @@ unregister pkg_descr lbi regFlags = do
genScript
=
regGenScript
regFlags
verbosity
=
regVerbose
regFlags
user
=
regUser
regFlags
`
userOverride
`
userConf
lbi
hc
=
compiler
lbi
installDirs
=
absoluteInstallDirs
pkg_descr
lbi
NoCopyDest
case
compilerFlavor
hc
of
case
compilerFlavor
(
compiler
lbi
)
of
GHC
->
do
config_flags
<-
if
user
...
...
@@ -339,12 +337,11 @@ unregister pkg_descr lbi regFlags = do
let
removeCmd
=
if
ghc_63_plus
then
[
"unregister"
,
showPackageId
(
package
pkg_descr
)]
else
[
"--remove-package="
++
(
pkgName
$
package
pkg_descr
)]
-- XXX This should be rewritten so we use rawSystemProgramConf
-- when not making a script
let
pkgTool
=
compilerPkgToolPath
hc
pkgToolArgs
=
compilerPkgToolArgs
hc
allArgs
=
pkgToolArgs
++
removeCmd
++
config_flags
rawSystemEmit
unregScriptLocation
genScript
verbosity
pkgTool
allArgs
let
Just
pkgTool
=
lookupProgram
ghcPkgProgram
(
withPrograms
lbi
)
allArgs
=
removeCmd
++
config_flags
if
genScript
then
rawSystemEmit
pkgTool
unregScriptLocation
allArgs
else
rawSystemProgram
verbosity
pkgTool
allArgs
Hugs
->
do
try
$
removeDirectoryRecursive
(
libdir
installDirs
)
return
()
...
...
@@ -354,17 +351,13 @@ unregister pkg_descr lbi regFlags = do
_
->
die
(
"only unregistering with GHC and Hugs is implemented"
)
-- |Like rawSystemExit, but optionally emits to a script instead of
-- exiting. FIX: chmod +x?
rawSystemEmit
::
FilePath
-- ^Script name
->
Bool
-- ^if true, emit, if false, run
->
Verbosity
-- ^Verbosity
->
FilePath
-- ^Program to run
-- |Like rawSystemProgram, but emits to a script instead of exiting.
-- FIX: chmod +x?
rawSystemEmit
::
ConfiguredProgram
-- ^Program to run
->
FilePath
-- ^Script name
->
[
String
]
-- ^Args
->
IO
()
rawSystemEmit
_
False
verbosity
path
args
=
rawSystemExit
verbosity
path
args
rawSystemEmit
scriptName
True
_
path
args
rawSystemEmit
prog
scriptName
extraArgs
=
case
os
of
Windows
_
->
writeFile
scriptName
(
"@"
++
path
++
concatMap
(
' '
:
)
args
)
...
...
@@ -373,15 +366,16 @@ rawSystemEmit scriptName True _ path args
++
"
\n
"
)
p
<-
getPermissions
scriptName
setPermissions
scriptName
p
{
executable
=
True
}
where
args
=
programArgs
prog
++
extraArgs
path
=
programPath
prog
-- |Like rawSystemEmit, except it has string for pipeFrom. FIX: chmod +x
rawSystemPipe
::
FilePath
-- ^Script location
->
Verbosity
-- ^Verbosity
rawSystemPipe
::
ConfiguredProgram
->
FilePath
-- ^Script location
->
String
-- ^where to pipe from
->
FilePath
-- ^Program to run
->
[
String
]
-- ^Args
->
IO
()
rawSystemPipe
scriptName
_
pipeFrom
path
a
rgs
rawSystemPipe
prog
scriptName
pipeFrom
extraA
rgs
=
case
os
of
Windows
_
->
writeFile
scriptName
(
"@"
++
path
++
concatMap
(
' '
:
)
args
)
...
...
@@ -395,6 +389,8 @@ rawSystemPipe scriptName _ pipeFrom path args
where
escapeForShell
[]
=
[]
escapeForShell
(
'
\'
'
:
cs
)
=
"'
\\
''"
++
escapeForShell
cs
escapeForShell
(
c
:
cs
)
=
c
:
escapeForShell
cs
args
=
programArgs
prog
++
extraArgs
path
=
programPath
prog
-- ------------------------------------------------------------
-- * Testing
...
...
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