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
ea8735aa
Commit
ea8735aa
authored
Dec 18, 2014
by
tibbe
Browse files
Merge branch 'master' of
https://github.com/christiaanb/cabal
Conflicts: Cabal/Distribution/Simple/GHC.hs cabal-install/Distribution/Client/Run.hs
parents
ceba559b
3f361de6
Changes
17
Hide whitespace changes
Inline
Side-by-side
Cabal/Distribution/InstalledPackageInfo.hs
View file @
ea8735aa
...
...
@@ -61,7 +61,8 @@ import Distribution.Text
import
Text.PrettyPrint
as
Disp
import
qualified
Distribution.Compat.ReadP
as
Parse
import
Data.Binary
(
Binary
)
import
Data.Binary
(
Binary
)
import
Data.Maybe
(
fromMaybe
)
import
GHC.Generics
(
Generic
)
-- -----------------------------------------------------------------------------
...
...
@@ -104,7 +105,8 @@ data InstalledPackageInfo_ m
frameworkDirs
::
[
FilePath
],
frameworks
::
[
String
],
haddockInterfaces
::
[
FilePath
],
haddockHTMLs
::
[
FilePath
]
haddockHTMLs
::
[
FilePath
],
pkgRoot
::
Maybe
FilePath
}
deriving
(
Generic
,
Read
,
Show
)
...
...
@@ -155,7 +157,8 @@ emptyInstalledPackageInfo
frameworkDirs
=
[]
,
frameworks
=
[]
,
haddockInterfaces
=
[]
,
haddockHTMLs
=
[]
haddockHTMLs
=
[]
,
pkgRoot
=
Nothing
}
noVersion
::
Version
...
...
@@ -375,6 +378,9 @@ installedFieldDescrs = [
,
listField
"haddock-html"
showFilePath
parseFilePathQ
haddockHTMLs
(
\
xs
pkg
->
pkg
{
haddockHTMLs
=
xs
})
,
simpleField
"pkgroot"
(
const
Disp
.
empty
)
parseFilePathQ
(
fromMaybe
""
.
pkgRoot
)
(
\
xs
pkg
->
pkg
{
pkgRoot
=
Just
xs
})
]
deprecatedFieldDescrs
::
[
FieldDescr
InstalledPackageInfo
]
...
...
Cabal/Distribution/Simple/Build/PathsModule.hs
View file @
ea8735aa
...
...
@@ -32,6 +32,8 @@ import Distribution.Simple.LocalBuildInfo
import
Distribution.Simple.Setup
(
CopyDest
(
NoCopyDest
)
)
import
Distribution.Simple.BuildPaths
(
autogenModuleName
)
import
Distribution.Simple.Utils
(
shortRelativePath
)
import
Distribution.Text
(
display
)
import
Distribution.Version
...
...
@@ -62,6 +64,11 @@ generate pkg_descr lbi =
"import Foreign
\n
"
++
"import Foreign.C
\n
"
reloc_imports
|
reloc
=
"import System.Environment (getExecutablePath)
\n
"
|
otherwise
=
""
header
=
pragmas
++
"module "
++
display
paths_modulename
++
" (
\n
"
++
...
...
@@ -74,16 +81,36 @@ generate pkg_descr lbi =
"import qualified Control.Exception as Exception
\n
"
++
"import Data.Version (Version(..))
\n
"
++
"import System.Environment (getEnv)
\n
"
++
reloc_imports
++
"import Prelude
\n
"
++
"
\n
"
++
"catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
\n
"
++
"catchIO = Exception.catch
\n
"
++
"
\n
"
++
"
\n
version :: Version"
++
"version :: Version"
++
"
\n
version = Version "
++
show
branch
++
" "
++
show
tags
where
Version
branch
tags
=
packageVersion
pkg_descr
body
|
reloc
=
"
\n\n
bindirrel :: FilePath
\n
"
++
"bindirrel = "
++
show
flat_bindirreloc
++
"
\n
"
++
"
\n
getBinDir, getLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath
\n
"
++
"getBinDir = "
++
mkGetEnvOrReloc
"bindir"
flat_bindirreloc
++
"
\n
"
++
"getLibDir = "
++
mkGetEnvOrReloc
"libdir"
flat_libdirreloc
++
"
\n
"
++
"getDataDir = "
++
mkGetEnvOrReloc
"datadir"
flat_datadirreloc
++
"
\n
"
++
"getLibexecDir = "
++
mkGetEnvOrReloc
"libexecdir"
flat_libexecdirreloc
++
"
\n
"
++
"getSysconfDir = "
++
mkGetEnvOrReloc
"sysconfdir"
flat_sysconfdirreloc
++
"
\n
"
++
"
\n
"
++
"getDataFileName :: FilePath -> IO FilePath
\n
"
++
"getDataFileName name = do
\n
"
++
" dir <- getDataDir
\n
"
++
" return (dir `joinFileName` name)
\n
"
++
"
\n
"
++
get_prefix_reloc_stuff
++
"
\n
"
++
filename_stuff
|
absolute
=
"
\n
bindir, libdir, datadir, libexecdir, sysconfdir :: FilePath
\n
"
++
"
\n
bindir = "
++
show
flat_bindir
++
...
...
@@ -146,9 +173,20 @@ generate pkg_descr lbi =
sysconfdir
=
flat_sysconfdirrel
}
=
prefixRelativeInstallDirs
(
packageId
pkg_descr
)
lbi
flat_bindirreloc
=
shortRelativePath
flat_prefix
flat_bindir
flat_libdirreloc
=
shortRelativePath
flat_prefix
flat_libdir
flat_datadirreloc
=
shortRelativePath
flat_prefix
flat_datadir
flat_libexecdirreloc
=
shortRelativePath
flat_prefix
flat_libexecdir
flat_sysconfdirreloc
=
shortRelativePath
flat_prefix
flat_sysconfdir
mkGetDir
_
(
Just
dirrel
)
=
"getPrefixDirRel "
++
show
dirrel
mkGetDir
dir
Nothing
=
"return "
++
show
dir
mkGetEnvOrReloc
var
dirrel
=
"catchIO (getEnv
\"
"
++
var'
++
"
\"
)"
++
" (
\\
_ -> getPrefixDirReloc
\"
"
++
dirrel
++
"
\"
)"
where
var'
=
pkgPathEnvVar
pkg_descr
var
mkGetEnvOr
var
expr
=
"catchIO (getEnv
\"
"
++
var'
++
"
\"
)"
++
" (
\\
_ -> "
++
expr
++
")"
where
var'
=
pkgPathEnvVar
pkg_descr
var
...
...
@@ -159,6 +197,8 @@ generate pkg_descr lbi =
||
isNothing
flat_bindirrel
-- if the bin dir is an absolute path
||
not
(
supportsRelocatableProgs
(
compilerFlavor
(
compiler
lbi
)))
reloc
=
relocatable
lbi
supportsRelocatableProgs
GHC
=
case
buildOS
of
Windows
->
True
_
->
False
...
...
@@ -192,6 +232,14 @@ pkgPathEnvVar pkg_descr var =
fixchar
'-'
=
'_'
fixchar
c
=
c
get_prefix_reloc_stuff
::
String
get_prefix_reloc_stuff
=
"getPrefixDirReloc :: FilePath -> IO FilePath
\n
"
++
"getPrefixDirReloc dirRel = do
\n
"
++
" exePath <- getExecutablePath
\n
"
++
" let (bindir,_) = splitFileName exePath
\n
"
++
" return ((bindir `minusFileName` bindirrel) `joinFileName` dirRel)
\n
"
get_prefix_win32
::
Arch
->
String
get_prefix_win32
arch
=
"getPrefixDirRel :: FilePath -> IO FilePath
\n
"
++
...
...
Cabal/Distribution/Simple/Configure.hs
View file @
ea8735aa
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
-----------------------------------------------------------------------------
-- |
...
...
@@ -104,7 +105,7 @@ import Distribution.Simple.Utils
,
writeFileAtomic
,
withTempFile
)
import
Distribution.System
(
OS
(
..
),
buildOS
,
Platform
,
buildPlatform
)
(
OS
(
..
),
buildOS
,
Platform
(
..
)
,
buildPlatform
)
import
Distribution.Version
(
Version
(
..
),
anyVersion
,
orLaterVersion
,
withinRange
,
isAnyVersion
)
import
Distribution.Verbosity
...
...
@@ -128,9 +129,9 @@ import Data.ByteString.Lazy (ByteString)
import
qualified
Data.ByteString
as
BS
import
qualified
Data.ByteString.Lazy.Char8
as
BLC8
import
Data.List
(
(
\\
),
nub
,
partition
,
isPrefixOf
,
inits
)
(
(
\\
),
nub
,
partition
,
isPrefixOf
,
inits
,
stripPrefix
)
import
Data.Maybe
(
isNothing
,
catMaybes
,
fromMaybe
)
(
isNothing
,
catMaybes
,
fromMaybe
,
isJust
)
import
Data.Either
(
partitionEithers
)
import
qualified
Data.Set
as
Set
...
...
@@ -610,6 +611,11 @@ configure (pkg_descr0, pbi) cfg
GHCJS
.
isDynamic
comp
_
->
False
reloc
<-
if
not
(
fromFlag
$
configRelocatable
cfg
)
then
return
False
else
return
True
let
lbi
=
LocalBuildInfo
{
configFlags
=
cfg
,
extraConfigArgs
=
[]
,
-- Currently configure does not
...
...
@@ -640,9 +646,12 @@ configure (pkg_descr0, pbi) cfg
stripLibs
=
fromFlag
$
configStripLibs
cfg
,
withPackageDB
=
packageDbs
,
progPrefix
=
fromFlag
$
configProgPrefix
cfg
,
progSuffix
=
fromFlag
$
configProgSuffix
cfg
progSuffix
=
fromFlag
$
configProgSuffix
cfg
,
relocatable
=
reloc
}
when
reloc
(
checkRelocatable
verbosity
pkg_descr
lbi
)
let
dirs
=
absoluteInstallDirs
pkg_descr
lbi
NoCopyDest
relative
=
prefixRelativeInstallDirs
(
packageId
pkg_descr
)
lbi
...
...
@@ -1565,3 +1574,69 @@ checkPackageProblems verbosity gpkg pkg = do
if
null
errors
then
mapM_
(
warn
verbosity
)
warnings
else
die
(
intercalate
"
\n\n
"
errors
)
-- | Preform checks if a relocatable build is allowed
checkRelocatable
::
Verbosity
->
PackageDescription
->
LocalBuildInfo
->
IO
()
checkRelocatable
verbosity
pkg
lbi
=
sequence_
[
checkOS
,
checkCompiler
,
packagePrefixRelative
,
depsPrefixRelative
]
where
-- Check if the OS support relocatable builds.
--
-- If you add new OS' to this list, and your OS supports dynamic libraries
-- and RPATH, make sure you add your OS to RPATH-support list of:
-- Distribution.Simple.GHC.getRPaths
checkOS
=
unless
(
os
`
elem
`
[
OSX
,
Linux
])
$
die
$
"Operating system: "
++
display
os
++
", does not support relocatable builds"
where
(
Platform
_
os
)
=
hostPlatform
lbi
-- Check if the Compiler support relocatable builds
checkCompiler
=
unless
(
compilerFlavor
comp
`
elem
`
[
GHC
])
$
die
$
"Compiler: "
++
show
comp
++
", does not support relocatable builds"
where
comp
=
compiler
lbi
-- Check if all the install dirs are relative to same prefix
packagePrefixRelative
=
unless
(
relativeInstallDirs
installDirs
)
$
die
$
"Installation directories are not prefix_relative:
\n
"
++
show
installDirs
where
installDirs
=
absoluteInstallDirs
pkg
lbi
NoCopyDest
p
=
prefix
installDirs
relativeInstallDirs
(
InstallDirs
{
..
})
=
all
isJust
(
fmap
(
stripPrefix
p
)
[
bindir
,
libdir
,
dynlibdir
,
libexecdir
,
includedir
,
datadir
,
docdir
,
mandir
,
htmldir
,
haddockdir
,
sysconfdir
]
)
-- Check if the library dirs of the dependencies that are in the package
-- database to which the package is installed are relative to the
-- prefix of the package
depsPrefixRelative
=
do
pkgr
<-
GHC
.
pkgRoot
verbosity
lbi
(
last
(
withPackageDB
lbi
))
mapM_
(
doCheck
pkgr
)
ipkgs
where
doCheck
pkgr
ipkg
|
maybe
False
(
==
pkgr
)
(
Installed
.
pkgRoot
ipkg
)
=
mapM_
(
\
l
->
when
(
isNothing
$
stripPrefix
p
l
)
(
die
(
msg
l
)))
(
Installed
.
libraryDirs
ipkg
)
|
otherwise
=
return
()
installDirs
=
absoluteInstallDirs
pkg
lbi
NoCopyDest
p
=
prefix
installDirs
ipkgs
=
PackageIndex
.
allPackages
(
installedPkgs
lbi
)
msg
l
=
"Library directory of a dependency: "
++
show
l
++
"
\n
is not relative to the installation prefix:
\n
"
++
show
p
Cabal/Distribution/Simple/GHC.hs
View file @
ea8735aa
...
...
@@ -44,6 +44,7 @@ module Distribution.Simple.GHC (
getLibDir
,
isDynamic
,
getGlobalPackageDB
,
pkgRoot
)
where
import
qualified
Distribution.Simple.GHC.IPI641
as
IPI641
...
...
@@ -62,7 +63,7 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import
qualified
Distribution.Simple.PackageIndex
as
PackageIndex
import
Distribution.Simple.LocalBuildInfo
(
LocalBuildInfo
(
..
),
ComponentLocalBuildInfo
(
..
)
,
absoluteInstallDirs
)
,
LibraryName
(
..
),
absoluteInstallDirs
,
depLibraryPaths
)
import
qualified
Distribution.Simple.Hpc
as
Hpc
import
Distribution.Simple.InstallDirs
hiding
(
absoluteInstallDirs
)
import
Distribution.Simple.BuildPaths
...
...
@@ -97,8 +98,8 @@ import Distribution.Verbosity
import
Distribution.Text
(
display
)
import
Distribution.Utils.NubList
(
overNubListR
,
toNubListR
)
import
Language.Haskell.Extension
(
Extension
(
..
)
(
NubListR
,
overNubListR
,
toNubListR
)
import
Language.Haskell.Extension
(
Language
(
..
),
Extension
(
..
)
,
KnownExtension
(
..
))
import
Control.Monad
(
unless
,
when
)
...
...
@@ -107,10 +108,15 @@ import Data.List
import
qualified
Data.Map
as
M
(
fromList
)
import
Data.Maybe
(
catMaybes
)
import
Data.Monoid
(
Monoid
(
..
)
)
import
System.Directory
(
doesFileExist
)
import
Data.Version
(
showVersion
)
import
System.Directory
(
getDirectoryContents
,
doesFileExist
,
getTemporaryDirectory
,
getAppUserDataDirectory
,
createDirectoryIfMissing
)
import
System.FilePath
(
(
</>
),
(
<.>
),
takeExtension
,
takeDirectory
,
replaceExtension
,
splitExtension
)
splitExtension
,
isRelative
)
import
qualified
System.Info
import
System.IO
(
hClose
,
hPutStrLn
)
import
System.Environment
(
getEnv
)
import
Distribution.Compat.Exception
(
catchIO
)
...
...
@@ -588,6 +594,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
else
return
[]
unless
(
null
hObjs
&&
null
cObjs
&&
null
stubObjs
)
$
do
rpaths
<-
getRPaths
lbi
clbi
let
staticObjectFiles
=
hObjs
...
...
@@ -627,9 +634,12 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
ghcOptPackages
=
toNubListR
$
Internal
.
mkGhcOptPackages
clbi
,
ghcOptLinkLibs
=
toNubListR
$
extraLibs
libBi
,
ghcOptLinkLibPath
=
toNubListR
$
extraLibDirs
libBi
ghcOptLinkLibPath
=
toNubListR
$
extraLibDirs
libBi
,
ghcOptRPaths
=
rpaths
}
info
verbosity
(
show
(
ghcOptPackages
ghcSharedLinkArgs
))
whenVanillaLib
False
$
do
Ar
.
createArLibArchive
verbosity
lbi
vanillaLibFilePath
staticObjectFiles
...
...
@@ -701,6 +711,8 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
-- build executables
srcMainFile
<-
findFile
(
exeDir
:
hsSourceDirs
exeBi
)
modPath
rpaths
<-
getRPaths
lbi
clbi
let
isGhcDynamic
=
isDynamic
comp
dynamicTooSupported
=
supportsDynamicToo
comp
isHaskellMain
=
elem
(
takeExtension
srcMainFile
)
[
".hs"
,
".lhs"
]
...
...
@@ -742,7 +754,8 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
ghcOptLinkLibPath
=
toNubListR
$
extraLibDirs
exeBi
,
ghcOptLinkFrameworks
=
toNubListR
$
PD
.
frameworks
exeBi
,
ghcOptInputFiles
=
toNubListR
[
exeDir
</>
x
|
x
<-
cObjs
]
[
exeDir
</>
x
|
x
<-
cObjs
],
ghcOptRPaths
=
rpaths
}
replOpts
=
baseOpts
{
ghcOptExtra
=
overNubListR
...
...
@@ -826,6 +839,48 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
info
verbosity
"Linking..."
runGhcProg
linkOpts
{
ghcOptOutputFile
=
toFlag
(
targetDir
</>
exeNameReal
)
}
-- | Calculate the RPATHs for the component we are building.
--
-- Calculates relative RPATHs when 'relocatable' is set.
getRPaths
::
LocalBuildInfo
->
ComponentLocalBuildInfo
-- ^ Component we are building
->
IO
(
NubListR
FilePath
)
getRPaths
lbi
clbi
|
supportRPaths
hostOS
=
do
libraryPaths
<-
depLibraryPaths
False
(
relocatable
lbi
)
lbi
clbi
let
hostPref
=
case
hostOS
of
OSX
->
"@loader_path"
_
->
"$ORIGIN"
relPath
p
=
if
isRelative
p
then
hostPref
</>
p
else
p
rpaths
=
toNubListR
(
map
relPath
libraryPaths
)
return
rpaths
where
(
Platform
_
hostOS
)
=
hostPlatform
lbi
-- The list of RPath-supported operating systems below reflects the
-- platforms on which Cabal's RPATH handling is tested. It does _NOT_
-- reflect whether the OS supports RPATH.
-- E.g. when this comment was written, the *BSD operating systems were
-- untested with regards to Cabal RPATH handling, and were hence set to
-- 'False', while those operating systems themselves do support RPATH.
supportRPaths
Linux
=
True
supportRPaths
Windows
=
False
supportRPaths
OSX
=
True
supportRPaths
FreeBSD
=
False
supportRPaths
OpenBSD
=
False
supportRPaths
NetBSD
=
False
supportRPaths
DragonFly
=
False
supportRPaths
Solaris
=
False
supportRPaths
AIX
=
False
supportRPaths
HPUX
=
False
supportRPaths
IRIX
=
False
supportRPaths
HaLVM
=
False
supportRPaths
IOS
=
False
supportRPaths
(
OtherOS
_
)
=
False
-- Do _not_ add a default case so that we get a warning here when a new OS
-- is added.
getRPaths
_
_
=
return
mempty
-- | Filter the "-threaded" flag when profiling as it does not
-- work with ghc-6.8 and older.
...
...
@@ -995,6 +1050,25 @@ registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs =
HcPkg
.
reregister
(
hcPkgInfo
$
withPrograms
lbi
)
verbosity
packageDbs
(
Right
installedPkgInfo
)
pkgRoot
::
Verbosity
->
LocalBuildInfo
->
PackageDB
->
IO
FilePath
pkgRoot
verbosity
lbi
=
pkgRoot'
where
pkgRoot'
GlobalPackageDB
=
let
Just
ghcProg
=
lookupProgram
ghcProgram
(
withPrograms
lbi
)
in
fmap
takeDirectory
(
getGlobalPackageDB
verbosity
ghcProg
)
pkgRoot'
UserPackageDB
=
do
appDir
<-
getAppUserDataDirectory
"ghc"
let
ver
=
compilerVersion
(
compiler
lbi
)
subdir
=
System
.
Info
.
arch
++
'-'
:
System
.
Info
.
os
++
'-'
:
showVersion
ver
rootDir
=
appDir
</>
subdir
-- We must create the root directory for the user package database if it
-- does not yet exists. Otherwise '${pkgroot}' will resolve to a
-- directory at the time of 'ghc-pkg register', and registration will
-- fail.
createDirectoryIfMissing
True
rootDir
return
rootDir
pkgRoot'
(
SpecificPackageDB
fp
)
=
return
(
takeDirectory
fp
)
-- -----------------------------------------------------------------------------
-- Utils
...
...
Cabal/Distribution/Simple/GHC/IPI641.hs
View file @
ea8735aa
...
...
@@ -101,5 +101,6 @@ toCurrent ipi@InstalledPackageInfo{} =
Current
.
frameworkDirs
=
frameworkDirs
ipi
,
Current
.
frameworks
=
frameworks
ipi
,
Current
.
haddockInterfaces
=
haddockInterfaces
ipi
,
Current
.
haddockHTMLs
=
haddockHTMLs
ipi
Current
.
haddockHTMLs
=
haddockHTMLs
ipi
,
Current
.
pkgRoot
=
Nothing
}
Cabal/Distribution/Simple/GHC/IPI642.hs
View file @
ea8735aa
...
...
@@ -136,5 +136,6 @@ toCurrent ipi@InstalledPackageInfo{} =
Current
.
frameworkDirs
=
frameworkDirs
ipi
,
Current
.
frameworks
=
frameworks
ipi
,
Current
.
haddockInterfaces
=
haddockInterfaces
ipi
,
Current
.
haddockHTMLs
=
haddockHTMLs
ipi
Current
.
haddockHTMLs
=
haddockHTMLs
ipi
,
Current
.
pkgRoot
=
Nothing
}
Cabal/Distribution/Simple/LocalBuildInfo.hs
View file @
ea8735aa
...
...
@@ -42,6 +42,7 @@ module Distribution.Simple.LocalBuildInfo (
allComponentsInBuildOrder
,
componentsInBuildOrder
,
checkComponentsCyclic
,
depLibraryPaths
,
withAllComponentsInBuildOrder
,
withComponentsInBuildOrder
,
...
...
@@ -74,24 +75,28 @@ import Distribution.Package
import
Distribution.Simple.Compiler
(
Compiler
,
compilerInfo
,
PackageDBStack
,
OptimisationLevel
)
import
Distribution.Simple.PackageIndex
(
InstalledPackageIndex
)
(
InstalledPackageIndex
,
allPackages
)
import
Distribution.ModuleName
(
ModuleName
)
import
Distribution.Simple.Setup
(
ConfigFlags
)
import
Distribution.Simple.Utils
(
shortRelativePath
)
import
Distribution.Text
(
display
)
import
Distribution.System
(
Platform
)
(
Platform
(
..
)
)
import
Data.Array
((
!
))
import
Data.Binary
(
Binary
)
import
Data.Graph
import
Data.List
(
nub
,
find
)
import
Data.List
(
nub
,
find
,
stripPrefix
)
import
Data.Maybe
import
Data.Tree
(
flatten
)
import
GHC.Generics
(
Generic
)
import
Data.Map
(
Map
)
import
System.Directory
(
doesDirectoryExist
,
canonicalizePath
)
-- | Data cached after configuration step. See also
-- 'Distribution.Simple.Setup.ConfigFlags'.
data
LocalBuildInfo
=
LocalBuildInfo
{
...
...
@@ -139,7 +144,8 @@ data LocalBuildInfo = LocalBuildInfo {
stripExes
::
Bool
,
-- ^Whether to strip executables during install
stripLibs
::
Bool
,
-- ^Whether to strip libraries during install
progPrefix
::
PathTemplate
,
-- ^Prefix to be prepended to installed executables
progSuffix
::
PathTemplate
-- ^Suffix to be appended to installed executables
progSuffix
::
PathTemplate
,
-- ^Suffix to be appended to installed executables
relocatable
::
Bool
-- ^Whether to build a relocatable package
}
deriving
(
Generic
,
Read
,
Show
)
instance
Binary
LocalBuildInfo
...
...
@@ -402,6 +408,62 @@ checkComponentsCyclic es =
[]
->
Nothing
(
c
:
_
)
->
Just
(
map
vertexToNode
c
)
-- | Determine the directories containing the dynamic libraries of the
-- transitive dependencies of the component we are building.
--
-- When wanted, and possible, returns paths relative to the installDirs 'prefix'
depLibraryPaths
::
Bool
-- ^ Building for inplace?
->
Bool
-- ^ Generate prefix-relative library paths
->
LocalBuildInfo
->
ComponentLocalBuildInfo
-- ^ Component that is being built
->
IO
[
FilePath
]
depLibraryPaths
inplace
relative
lbi
clbi
=
do
let
pkgDescr
=
localPkgDescr
lbi
installDirs
=
absoluteInstallDirs
pkgDescr
lbi
NoCopyDest
executable
=
case
clbi
of
ExeComponentLocalBuildInfo
{}
->
True
_
->
False
relDir
|
executable
=
bindir
installDirs
|
otherwise
=
libdir
installDirs
let
hasInternalDeps
=
not
$
null
$
[
pkgid
|
(
_
,
pkgid
)
<-
componentPackageDeps
clbi
,
internal
pkgid
]
let
ipkgs
=
allPackages
(
installedPkgs
lbi
)
allDepLibDirs
=
concatMap
Installed
.
libraryDirs
ipkgs
internalLib
|
inplace
=
buildDir
lbi
|
otherwise
=
libdir
installDirs
allDepLibDirs'
=
if
hasInternalDeps
then
internalLib
:
allDepLibDirs
else
allDepLibDirs
allDepLibDirsC
<-
mapM
canonicalizePathNoFail
allDepLibDirs'
let
p
=
prefix
installDirs
prefixRelative
l
=
isJust
(
stripPrefix
p
l
)
libPaths
|
relative
&&
prefixRelative
relDir
=
map
(
\
l
->
if
prefixRelative
l
then
shortRelativePath
relDir
l
else
l
)
allDepLibDirsC
|
otherwise
=
allDepLibDirsC
return
libPaths
where
internal
pkgid
=
pkgid
==
packageId
(
localPkgDescr
lbi
)
-- 'canonicalizePath' fails on UNIX when the directory does not exists.
-- So just don't canonicalize when it doesn't exist.
canonicalizePathNoFail
p
=
do
exists
<-
doesDirectoryExist
p
if
exists
then
canonicalizePath
p
else
return
p
-- -----------------------------------------------------------------------------
-- Wrappers for a couple functions from InstallDirs
...
...
Cabal/Distribution/Simple/Program/GHC.hs
View file @
ea8735aa
...
...
@@ -189,6 +189,7 @@ data GhcOptions = GhcOptions {
ghcOptShared
::
Flag
Bool
,
ghcOptFPic
::
Flag
Bool
,
ghcOptDylibName
::
Flag
String
,
ghcOptRPaths
::
NubListR
FilePath
,
---------------
-- Misc flags
...
...
@@ -338,6 +339,9 @@ renderGhcOptions comp opts
,
[
"-L"
++
dir
|
dir
<-
flags
ghcOptLinkLibPath
]
,
concat
[
[
"-framework"
,
fmwk
]
|
fmwk
<-
flags
ghcOptLinkFrameworks
]
,
[
"-no-hs-main"
|
flagBool
ghcOptLinkNoHsMain
]
,
[
"-dynload deploy"
|
not
(
null
(
flags
ghcOptRPaths
))
]
,
concat
[
[
"-optl-Wl,-rpath,"
++
dir
]
|
dir
<-
flags
ghcOptRPaths
]
-------------
-- Packages
...
...
@@ -488,6 +492,7 @@ instance Monoid GhcOptions where
ghcOptShared
=
mempty
,
ghcOptFPic
=
mempty
,
ghcOptDylibName
=
mempty
,
ghcOptRPaths
=
mempty
,
ghcOptVerbosity
=
mempty
,
ghcOptCabal
=
mempty
}
...
...
@@ -539,6 +544,7 @@ instance Monoid GhcOptions where
ghcOptShared
=
combine
ghcOptShared
,
ghcOptFPic
=
combine
ghcOptFPic
,
ghcOptDylibName
=
combine
ghcOptDylibName
,
ghcOptRPaths
=
combine
ghcOptRPaths
,
ghcOptVerbosity
=
combine
ghcOptVerbosity
,
ghcOptCabal
=
combine
ghcOptCabal
}
...
...
Cabal/Distribution/Simple/Program/HcPkg.hs
View file @
ea8735aa
...
...
@@ -59,8 +59,6 @@ import Distribution.Compat.Exception
import
Data.Char
(
isSpace
)
import
Data.Maybe
(
fromMaybe
)
import
Data.List
(
stripPrefix
)
import
System.FilePath
as
FilePath
...
...
@@ -170,24 +168,13 @@ dump hpi verbosity packagedb = do
let
parsed
=
map
parseInstalledPackageInfo'
(
splitPkgs
str
)
in
case
[
msg
|
ParseFailed
msg
<-
parsed
]
of
[]
->
Left
[
setInstalledPackageId
.
maybe
id
mungePackagePaths
pkg
r
oot
.
maybe
id
mungePackagePaths
(
pkg
R
oot
pkg
)
$
pkg
|
ParseOk
_
(
pkg
root
,
pkg
)
<-
parsed
]
|
ParseOk
_
pkg
<-
parsed
]
msgs
->
Right
msgs
parseInstalledPackageInfo'
=
parseFieldsFlat
fields
(
Nothing
,
emptyInstalledPackageInfo
)
where
fields
=
liftFieldFst
pkgrootField
<