Commit 1d33c8f5 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Add $pkgkey template variable, and use it for install paths.



At the moment, $pkgkey is not supported for build reports, although in
principle we could add support for it, assuming that the configure step
succeeds.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 41610a0b
......@@ -123,6 +123,6 @@ benchOption pkg_descr lbi bm template =
fromPathTemplate $ substPathTemplate env template
where
env = initialPathTemplateEnv
(PD.package pkg_descr) (compilerId $ LBI.compiler lbi)
(LBI.hostPlatform lbi) ++
(PD.package pkg_descr) (LBI.pkgKey lbi)
(compilerId $ LBI.compiler lbi) (LBI.hostPlatform lbi) ++
[(BenchmarkNameVar, toPathTemplate $ PD.benchmarkName bm)]
......@@ -117,7 +117,7 @@ import Prelude hiding ( mapM )
import Control.Monad
( when, unless, foldM, filterM )
import Data.List
( (\\), nub, partition, isPrefixOf, inits, find )
( (\\), nub, partition, isPrefixOf, inits )
import Data.Maybe
( isNothing, catMaybes, fromMaybe )
import Data.Monoid
......
......@@ -534,7 +534,7 @@ haddockPackageFlags lbi clbi htmlTemplate = do
haddockTemplateEnv :: LocalBuildInfo -> PackageIdentifier -> PathTemplateEnv
haddockTemplateEnv lbi pkg_id =
(PrefixVar, prefix (installDirTemplates lbi))
: initialPathTemplateEnv pkg_id (compilerId (compiler lbi))
: initialPathTemplateEnv pkg_id (pkgKey lbi) (compilerId (compiler lbi))
(hostPlatform lbi)
-- ------------------------------------------------------------------------------
......
......@@ -49,7 +49,7 @@ import System.FilePath ((</>), isPathSeparator, pathSeparator)
import System.FilePath (dropDrive)
import Distribution.Package
( PackageIdentifier, packageName, packageVersion )
( PackageIdentifier, PackageKey, packageName, packageVersion )
import Distribution.System
( OS(..), buildOS, Platform(..) )
import Distribution.Compiler
......@@ -177,7 +177,7 @@ appendSubdirs append dirs = dirs {
-- users to be able to configure @--libdir=\/usr\/lib64@ for example but
-- because by default we want to support installing multiple versions of
-- packages and building the same package for multiple compilers we append the
-- libsubdir to get: @\/usr\/lib64\/$pkgid\/$compiler@.
-- libsubdir to get: @\/usr\/lib64\/$pkgkey\/$compiler@.
--
-- An additional complication is the need to support relocatable packages on
-- systems which support such things, like Windows.
......@@ -211,10 +211,10 @@ defaultInstallDirs comp userInstall _hasLibs = do
JHC -> "$compiler"
LHC -> "$compiler"
UHC -> "$pkgid"
_other -> "$arch-$os-$compiler" </> "$pkgid",
_other -> "$arch-$os-$compiler" </> "$pkgkey",
dynlibdir = "$libdir",
libexecdir = case buildOS of
Windows -> "$prefix" </> "$pkgid"
Windows -> "$prefix" </> "$pkgkey"
_other -> "$prefix" </> "libexec",
progdir = "$libdir" </> "hugs" </> "programs",
includedir = "$libdir" </> "$libsubdir" </> "include",
......@@ -283,10 +283,14 @@ substituteInstallDirTemplates env dirs = dirs'
-- | Convert from abstract install directories to actual absolute ones by
-- substituting for all the variables in the abstract paths, to get real
-- absolute path.
absoluteInstallDirs :: PackageIdentifier -> CompilerId -> CopyDest -> Platform
absoluteInstallDirs :: PackageIdentifier
-> PackageKey
-> CompilerId
-> CopyDest
-> Platform
-> InstallDirs PathTemplate
-> InstallDirs FilePath
absoluteInstallDirs pkgId compilerId copydest platform dirs =
absoluteInstallDirs pkgId pkg_key compilerId copydest platform dirs =
(case copydest of
CopyTo destdir -> fmap ((destdir </>) . dropDrive)
_ -> id)
......@@ -294,7 +298,7 @@ absoluteInstallDirs pkgId compilerId copydest platform dirs =
. fmap fromPathTemplate
$ substituteInstallDirTemplates env dirs
where
env = initialPathTemplateEnv pkgId compilerId platform
env = initialPathTemplateEnv pkgId pkg_key compilerId platform
-- |The location prefix for the /copy/ command.
......@@ -309,10 +313,13 @@ data CopyDest
-- prevents us from making a relocatable package (also known as a \"prefix
-- independent\" package).
--
prefixRelativeInstallDirs :: PackageIdentifier -> CompilerId -> Platform
prefixRelativeInstallDirs :: PackageIdentifier
-> PackageKey
-> CompilerId
-> Platform
-> InstallDirTemplates
-> InstallDirs (Maybe FilePath)
prefixRelativeInstallDirs pkgId compilerId platform dirs =
prefixRelativeInstallDirs pkgId pkg_key compilerId platform dirs =
fmap relative
. appendSubdirs combinePathTemplate
$ -- substitute the path template into each other, except that we map
......@@ -322,7 +329,7 @@ prefixRelativeInstallDirs pkgId compilerId platform dirs =
prefix = PathTemplate [Variable PrefixVar]
}
where
env = initialPathTemplateEnv pkgId compilerId platform
env = initialPathTemplateEnv pkgId pkg_key compilerId platform
-- If it starts with $prefix then it's relative and produce the relative
-- path by stripping off $prefix/ or $prefix
......@@ -358,6 +365,7 @@ data PathTemplateVariable =
| PkgNameVar -- ^ The @$pkg@ package name path variable
| PkgVerVar -- ^ The @$version@ package version path variable
| PkgIdVar -- ^ The @$pkgid@ package Id path variable, eg @foo-1.0@
| PkgKeyVar -- ^ The @$pkgkey@ package key path variable
| CompilerVar -- ^ The compiler name and version, eg @ghc-6.6.1@
| OSVar -- ^ The operating system name, eg @windows@ or @linux@
| ArchVar -- ^ The CPU architecture name, eg @i386@ or @x86_64@
......@@ -395,17 +403,21 @@ substPathTemplate environment (PathTemplate template) =
Nothing -> [component]
-- | The initial environment has all the static stuff but no paths
initialPathTemplateEnv :: PackageIdentifier -> CompilerId -> Platform
initialPathTemplateEnv :: PackageIdentifier
-> PackageKey
-> CompilerId
-> Platform
-> PathTemplateEnv
initialPathTemplateEnv pkgId compilerId platform =
packageTemplateEnv pkgId
initialPathTemplateEnv pkgId pkg_key compilerId platform =
packageTemplateEnv pkgId pkg_key
++ compilerTemplateEnv compilerId
++ platformTemplateEnv platform
packageTemplateEnv :: PackageIdentifier -> PathTemplateEnv
packageTemplateEnv pkgId =
packageTemplateEnv :: PackageIdentifier -> PackageKey -> PathTemplateEnv
packageTemplateEnv pkgId pkg_key =
[(PkgNameVar, PathTemplate [Ordinary $ display (packageName pkgId)])
,(PkgVerVar, PathTemplate [Ordinary $ display (packageVersion pkgId)])
,(PkgKeyVar, PathTemplate [Ordinary $ display pkg_key])
,(PkgIdVar, PathTemplate [Ordinary $ display pkgId])
]
......@@ -444,6 +456,7 @@ installDirsTemplateEnv dirs =
instance Show PathTemplateVariable where
show PrefixVar = "prefix"
show PkgKeyVar = "pkgkey"
show BindirVar = "bindir"
show LibdirVar = "libdir"
show LibsubdirVar = "libsubdir"
......@@ -468,6 +481,7 @@ instance Read PathTemplateVariable where
[ (var, drop (length varStr) s)
| (varStr, var) <- vars
, varStr `isPrefixOf` s ]
-- NB: order matters! Longer strings first
where vars = [("prefix", PrefixVar)
,("bindir", BindirVar)
,("libdir", LibdirVar)
......@@ -477,6 +491,7 @@ instance Read PathTemplateVariable where
,("docdir", DocdirVar)
,("htmldir", HtmldirVar)
,("pkgid", PkgIdVar)
,("pkgkey", PkgKeyVar)
,("pkg", PkgNameVar)
,("version", PkgVerVar)
,("compiler", CompilerVar)
......
......@@ -391,6 +391,7 @@ absoluteInstallDirs :: PackageDescription -> LocalBuildInfo -> CopyDest
absoluteInstallDirs pkg lbi copydest =
InstallDirs.absoluteInstallDirs
(packageId pkg)
(pkgKey lbi)
(compilerId (compiler lbi))
copydest
(hostPlatform lbi)
......@@ -402,6 +403,7 @@ prefixRelativeInstallDirs :: PackageId -> LocalBuildInfo
prefixRelativeInstallDirs pkg_descr lbi =
InstallDirs.prefixRelativeInstallDirs
(packageId pkg_descr)
(pkgKey lbi)
(compilerId (compiler lbi))
(hostPlatform lbi)
(installDirTemplates lbi)
......@@ -412,5 +414,6 @@ substPathTemplate pkgid lbi = fromPathTemplate
. ( InstallDirs.substPathTemplate env )
where env = initialPathTemplateEnv
pkgid
(pkgKey lbi)
(compilerId (compiler lbi))
(hostPlatform lbi)
......@@ -130,5 +130,5 @@ packageLogPath template pkg_descr lbi =
fromPathTemplate $ substPathTemplate env template
where
env = initialPathTemplateEnv
(PD.package pkg_descr) (compilerId $ LBI.compiler lbi)
(LBI.hostPlatform lbi)
(PD.package pkg_descr) (LBI.pkgKey lbi)
(compilerId $ LBI.compiler lbi) (LBI.hostPlatform lbi)
......@@ -147,6 +147,6 @@ testOption pkg_descr lbi suite template =
fromPathTemplate $ substPathTemplate env template
where
env = initialPathTemplateEnv
(PD.package pkg_descr) (compilerId $ LBI.compiler lbi)
(LBI.hostPlatform lbi) ++
(PD.package pkg_descr) (LBI.pkgKey lbi)
(compilerId $ LBI.compiler lbi) (LBI.hostPlatform lbi) ++
[(TestSuiteNameVar, toPathTemplate $ PD.testName suite)]
......@@ -148,8 +148,8 @@ testOption pkg_descr lbi suite template =
fromPathTemplate $ substPathTemplate env template
where
env = initialPathTemplateEnv
(PD.package pkg_descr) (compilerId $ LBI.compiler lbi)
(LBI.hostPlatform lbi) ++
(PD.package pkg_descr) (LBI.pkgKey lbi)
(compilerId $ LBI.compiler lbi) (LBI.hostPlatform lbi) ++
[(TestSuiteNameVar, toPathTemplate $ PD.testName suite)]
-- Test stub ----------
......
......@@ -113,8 +113,8 @@ testSuiteLogPath template pkg_descr lbi name result =
fromPathTemplate $ substPathTemplate env template
where
env = initialPathTemplateEnv
(PD.package pkg_descr) (compilerId $ LBI.compiler lbi)
(LBI.hostPlatform lbi)
(PD.package pkg_descr) (LBI.pkgKey lbi)
(compilerId $ LBI.compiler lbi) (LBI.hostPlatform lbi)
++ [ (TestSuiteNameVar, toPathTemplate name)
, (TestSuiteResultVar, toPathTemplate $ resultString result)
]
......
......@@ -93,6 +93,11 @@ storeLocal templates reports platform = sequence_
fromPathTemplate (substPathTemplate env template)
where env = initialPathTemplateEnv
(BuildReport.package report)
-- ToDo: In principle, we can support $pkgkey, but only
-- if the configure step succeeds. So add a Maybe field
-- to the build report, and either use that or make up
-- a fake identifier if it's not available.
(error "storeLocal: package key not available")
(BuildReport.compiler report)
platform
......
......@@ -99,7 +99,7 @@ import Distribution.Client.JobControl
import Distribution.Simple.Compiler
( CompilerId(..), Compiler(compilerId), compilerFlavor
, PackageDB(..), PackageDBStack, packageKeySupported )
, PackageDB(..), PackageDBStack )
import Distribution.Simple.Program (ProgramConfiguration,
defaultProgramConfiguration)
import qualified Distribution.Simple.InstallDirs as InstallDirs
......@@ -122,7 +122,7 @@ import Distribution.Simple.InstallDirs as InstallDirs
, initialPathTemplateEnv, installDirsTemplateEnv )
import Distribution.Package
( PackageIdentifier, PackageId, packageName, packageVersion
, Package(..), PackageFixedDeps(..), mkPackageKey
, Package(..), PackageFixedDeps(..), PackageKey
, Dependency(..), thisPackageVersion, InstalledPackageId )
import qualified Distribution.PackageDescription as PackageDescription
import Distribution.PackageDescription
......@@ -530,7 +530,7 @@ extractReinstalls (Reinstall ipids _) = ipids
extractReinstalls _ = []
packageStatus :: Compiler -> PackageIndex -> ReadyPackage -> PackageStatus
packageStatus comp installedPkgIndex cpkg@(ReadyPackage pid flags _ deps) =
packageStatus comp installedPkgIndex cpkg =
case PackageIndex.lookupPackageName installedPkgIndex
(packageName cpkg) of
[] -> NewPackage
......@@ -542,8 +542,7 @@ packageStatus comp installedPkgIndex cpkg@(ReadyPackage pid flags _ deps) =
where
pkg_key = mkPackageKey (packageKeySupported comp)
(packageId pid) (map Installed.packageKey deps) flags
pkg_key = readyPackageKey comp cpkg
changes :: Installed.InstalledPackageInfo
-> ReadyPackage
......@@ -682,7 +681,7 @@ postInstallActions verbosity
regenerateHaddockIndex verbosity packageDBs comp platform conf useSandbox
configFlags installFlags installPlan
symlinkBinaries verbosity configFlags installFlags installPlan
symlinkBinaries verbosity comp configFlags installFlags installPlan
printBuildFailures installPlan
......@@ -791,11 +790,12 @@ regenerateHaddockIndex verbosity packageDBs comp platform conf useSandbox
symlinkBinaries :: Verbosity
-> Compiler
-> ConfigFlags
-> InstallFlags
-> InstallPlan -> IO ()
symlinkBinaries verbosity configFlags installFlags plan = do
failed <- InstallSymlink.symlinkBinaries configFlags installFlags plan
symlinkBinaries verbosity comp configFlags installFlags plan = do
failed <- InstallSymlink.symlinkBinaries comp configFlags installFlags plan
case failed of
[] -> return ()
[(_, exe, path)] ->
......@@ -885,7 +885,7 @@ data InstallMisc = InstallMisc {
-- | If logging is enabled, contains location of the log file and the verbosity
-- level for logging.
type UseLogFile = Maybe (PackageIdentifier -> FilePath, Verbosity)
type UseLogFile = Maybe (PackageIdentifier -> PackageKey -> FilePath, Verbosity)
performInstallations :: Verbosity
-> InstallArgs
......@@ -910,13 +910,16 @@ performInstallations verbosity
installLock <- newLock -- serialise installation
cacheLock <- newLock -- serialise access to setup exe cache
executeInstallPlan verbosity jobControl useLogFile installPlan $ \rpkg ->
executeInstallPlan verbosity comp jobControl useLogFile installPlan $ \rpkg ->
-- Calculate the package key (ToDo: Is this right for source install)
let pkg_key = readyPackageKey comp rpkg in
installReadyPackage platform compid configFlags
rpkg $ \configFlags' src pkg pkgoverride ->
fetchSourcePackage verbosity fetchLimit src $ \src' ->
installLocalPackage verbosity buildLimit
(packageId pkg) src' distPref $ \mpath ->
installUnpackedPackage verbosity buildLimit installLock numJobs
installUnpackedPackage verbosity buildLimit installLock numJobs pkg_key
(setupScriptOptions installedPkgIndex cacheLock)
miscOptions configFlags' installFlags haddockFlags
compid platform pkg pkgoverride mpath useLogFile
......@@ -995,11 +998,11 @@ performInstallations verbosity
| parallelInstall = False
| otherwise = False
substLogFileName :: PathTemplate -> PackageIdentifier -> FilePath
substLogFileName template pkg = fromPathTemplate
. substPathTemplate env
$ template
where env = initialPathTemplateEnv (packageId pkg)
substLogFileName :: PathTemplate -> PackageIdentifier -> PackageKey -> FilePath
substLogFileName template pkg pkg_key = fromPathTemplate
. substPathTemplate env
$ template
where env = initialPathTemplateEnv (packageId pkg) pkg_key
(compilerId comp) platform
miscOptions = InstallMisc {
......@@ -1013,12 +1016,13 @@ performInstallations verbosity
executeInstallPlan :: Verbosity
-> JobControl IO (PackageId, BuildResult)
-> Compiler
-> JobControl IO (PackageId, PackageKey, BuildResult)
-> UseLogFile
-> InstallPlan
-> (ReadyPackage -> IO BuildResult)
-> IO InstallPlan
executeInstallPlan verbosity jobCtl useLogFile plan0 installPkg =
executeInstallPlan verbosity comp jobCtl useLogFile plan0 installPkg =
tryNewTasks 0 plan0
where
tryNewTasks taskCount plan = do
......@@ -1030,9 +1034,10 @@ executeInstallPlan verbosity jobCtl useLogFile plan0 installPkg =
[ do info verbosity $ "Ready to install " ++ display pkgid
spawnJob jobCtl $ do
buildResult <- installPkg pkg
return (packageId pkg, buildResult)
return (packageId pkg, pkg_key, buildResult)
| pkg <- pkgs
, let pkgid = packageId pkg]
, let pkgid = packageId pkg
pkg_key = readyPackageKey comp pkg ]
let taskCount' = taskCount + length pkgs
plan' = InstallPlan.processing pkgs plan
......@@ -1040,8 +1045,8 @@ executeInstallPlan verbosity jobCtl useLogFile plan0 installPkg =
waitForTasks taskCount plan = do
info verbosity $ "Waiting for install task to finish..."
(pkgid, buildResult) <- collectJob jobCtl
printBuildResult pkgid buildResult
(pkgid, pkg_key, buildResult) <- collectJob jobCtl
printBuildResult pkgid pkg_key buildResult
let taskCount' = taskCount-1
plan' = updatePlan pkgid buildResult plan
tryNewTasks taskCount' plan'
......@@ -1061,8 +1066,8 @@ executeInstallPlan verbosity jobCtl useLogFile plan0 installPkg =
-- Print build log if something went wrong, and 'Installed $PKGID'
-- otherwise.
printBuildResult :: PackageId -> BuildResult -> IO ()
printBuildResult pkgid buildResult = case buildResult of
printBuildResult :: PackageId -> PackageKey -> BuildResult -> IO ()
printBuildResult pkgid pkg_key buildResult = case buildResult of
(Right _) -> notice verbosity $ "Installed " ++ display pkgid
(Left _) -> do
notice verbosity $ "Failed to install " ++ display pkgid
......@@ -1070,7 +1075,7 @@ executeInstallPlan verbosity jobCtl useLogFile plan0 installPkg =
case useLogFile of
Nothing -> return ()
Just (mkLogFileName, _) -> do
let logName = mkLogFileName pkgid
let logName = mkLogFileName pkgid pkg_key
putStr $ "Build log ( " ++ logName ++ " ):\n"
printFile logName
......@@ -1218,6 +1223,7 @@ installUnpackedPackage
-> JobLimit
-> Lock
-> Int
-> PackageKey
-> SetupScriptOptions
-> InstallMisc
-> ConfigFlags
......@@ -1230,7 +1236,7 @@ installUnpackedPackage
-> Maybe FilePath -- ^ Directory to change to before starting the installation.
-> UseLogFile -- ^ File to log output to (if any)
-> IO BuildResult
installUnpackedPackage verbosity buildLimit installLock numJobs
installUnpackedPackage verbosity buildLimit installLock numJobs pkg_key
scriptOptions miscOptions
configFlags installFlags haddockFlags
compid platform pkg pkgoverride workingDir useLogFile = do
......@@ -1292,7 +1298,7 @@ installUnpackedPackage verbosity buildLimit installLock numJobs
maybePkgConf <- maybeGenPkgConf mLogPath
-- Actual installation
withWin32SelfUpgrade verbosity configFlags compid platform pkg $ do
withWin32SelfUpgrade verbosity pkg_key configFlags compid platform pkg $ do
case rootCmd miscOptions of
(Just cmd) -> reexec cmd
Nothing -> do
......@@ -1342,7 +1348,7 @@ installUnpackedPackage verbosity buildLimit installLock numJobs
}
where
CompilerId flavor _ = compid
env = initialPathTemplateEnv pkgid compid platform
env = initialPathTemplateEnv pkgid pkg_key compid platform
userInstall = fromFlagOrDefault defaultUserInstall
(configUserInstall configFlags')
......@@ -1376,7 +1382,7 @@ installUnpackedPackage verbosity buildLimit installLock numJobs
case useLogFile of
Nothing -> return Nothing
Just (mkLogFileName, _) -> do
let logFileName = mkLogFileName (packageId pkg)
let logFileName = mkLogFileName (packageId pkg) pkg_key
logDir = takeDirectory logFileName
unless (null logDir) $ createDirectoryIfMissing True logDir
logFileExists <- doesFileExist logFileName
......@@ -1425,13 +1431,14 @@ onFailure result action =
-- ------------------------------------------------------------
withWin32SelfUpgrade :: Verbosity
-> PackageKey
-> ConfigFlags
-> CompilerId
-> Platform
-> PackageDescription
-> IO a -> IO a
withWin32SelfUpgrade _ _ _ _ _ action | buildOS /= Windows = action
withWin32SelfUpgrade verbosity configFlags compid platform pkg action = do
withWin32SelfUpgrade _ _ _ _ _ _ action | buildOS /= Windows = action
withWin32SelfUpgrade verbosity pkg_key configFlags compid platform pkg action = do
defaultDirs <- InstallDirs.defaultInstallDirs
compFlavor
......@@ -1459,8 +1466,9 @@ withWin32SelfUpgrade verbosity configFlags compid platform pkg action = do
templateDirs = InstallDirs.combineInstallDirs fromFlagOrDefault
defaultDirs (configInstallDirs configFlags)
absoluteDirs = InstallDirs.absoluteInstallDirs
pkgid compid InstallDirs.NoCopyDest
pkgid pkg_key
compid InstallDirs.NoCopyDest
platform templateDirs
substTemplate = InstallDirs.fromPathTemplate
. InstallDirs.substPathTemplate env
where env = InstallDirs.initialPathTemplateEnv pkgid compid platform
where env = InstallDirs.initialPathTemplateEnv pkgid pkg_key compid platform
......@@ -22,12 +22,14 @@ import Distribution.Package (PackageIdentifier)
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Client.Setup (InstallFlags)
import Distribution.Simple.Setup (ConfigFlags)
import Distribution.Simple.Compiler
symlinkBinaries :: ConfigFlags
symlinkBinaries :: Compiler
-> ConfigFlags
-> InstallFlags
-> InstallPlan
-> IO [(PackageIdentifier, String, FilePath)]
symlinkBinaries _ _ _ = return []
symlinkBinaries _ _ _ _ = return []
symlinkBinary :: FilePath -> FilePath -> String -> String -> IO Bool
symlinkBinary _ _ _ _ = fail "Symlinking feature not available on Windows"
......@@ -42,7 +44,7 @@ import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Package
( PackageIdentifier, Package(packageId) )
( PackageIdentifier, Package(packageId), mkPackageKey, PackageKey )
import Distribution.Compiler
( CompilerId(..) )
import qualified Distribution.PackageDescription as PackageDescription
......@@ -53,6 +55,9 @@ import Distribution.PackageDescription.Configuration
import Distribution.Simple.Setup
( ConfigFlags(..), fromFlag, fromFlagOrDefault, flagToMaybe )
import qualified Distribution.Simple.InstallDirs as InstallDirs
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.Simple.Compiler
( Compiler, packageKeySupported )
import System.Posix.Files
( getSymbolicLinkStatus, isSymbolicLink, createSymbolicLink
......@@ -91,11 +96,12 @@ import Data.Maybe
-- controlled from the config file. Of course it only works on POSIX systems
-- with symlinks so is not available to Windows users.
--
symlinkBinaries :: ConfigFlags
symlinkBinaries :: Compiler
-> ConfigFlags
-> InstallFlags
-> InstallPlan
-> IO [(PackageIdentifier, String, FilePath)]
symlinkBinaries configFlags installFlags plan =
symlinkBinaries comp configFlags installFlags plan =
case flagToMaybe (installSymlinkBinDir installFlags) of
Nothing -> return []
Just symlinkBinDir
......@@ -105,7 +111,7 @@ symlinkBinaries configFlags installFlags plan =
-- TODO: do we want to do this here? :
-- createDirectoryIfMissing True publicBinDir
fmap catMaybes $ sequence
[ do privateBinDir <- pkgBinDir pkg
[ do privateBinDir <- pkgBinDir pkg pkg_key
ok <- symlinkBinary
publicBinDir privateBinDir
publicExeName privateExeName
......@@ -113,15 +119,17 @@ symlinkBinaries configFlags installFlags plan =
then return Nothing
else return (Just (pkgid, publicExeName,
privateBinDir </> privateExeName))
| (pkg, exe) <- exes
, let publicExeName = PackageDescription.exeName exe
| (ReadyPackage _ flags _ deps, pkg, exe) <- exes
, let pkgid = packageId pkg
pkg_key = mkPackageKey (packageKeySupported comp) pkgid
(map Installed.packageKey deps)
publicExeName = PackageDescription.exeName exe
privateExeName = prefix ++ publicExeName ++ suffix
pkgid = packageId pkg
prefix = substTemplate pkgid prefixTemplate
suffix = substTemplate pkgid suffixTemplate ]
prefix = substTemplate pkgid pkg_key prefixTemplate
suffix = substTemplate pkgid pkg_key suffixTemplate ]
where
exes =
[ (pkg, exe)
[ (cpkg, pkg, exe)
| InstallPlan.Installed cpkg _ <- InstallPlan.toList plan
, let pkg = pkgDescription cpkg
, exe <- PackageDescription.executables pkg
......@@ -137,8 +145,8 @@ symlinkBinaries configFlags installFlags plan =
-- This is sadly rather complicated. We're kind of re-doing part of the
-- configuration for the package. :-(
pkgBinDir :: PackageDescription -> IO FilePath
pkgBinDir pkg = do
pkgBinDir :: PackageDescription -> PackageKey -> IO FilePath
pkgBinDir pkg pkg_key = do
defaultDirs <- InstallDirs.defaultInstallDirs
compilerFlavor
(fromFlag (configUserInstall configFlags))
......@@ -146,13 +154,15 @@ symlinkBinaries configFlags installFlags plan =
let templateDirs = InstallDirs.combineInstallDirs fromFlagOrDefault
defaultDirs (configInstallDirs configFlags)
absoluteDirs = InstallDirs.absoluteInstallDirs
(packageId pkg) compilerId InstallDirs.NoCopyDest
(packageId pkg) pkg_key
compilerId InstallDirs.NoCopyDest
platform templateDirs
canonicalizePath (InstallDirs.bindir absoluteDirs)
substTemplate pkgid = InstallDirs.fromPathTemplate
. InstallDirs.substPathTemplate env
where env = InstallDirs.initialPathTemplateEnv pkgid compilerId platform
substTemplate pkgid pkg_key = InstallDirs.fromPathTemplate
. InstallDirs.substPathTemplate env
where env = InstallDirs.initialPathTemplateEnv pkgid pkg_key
compilerId platform
fromFlagTemplate = fromFlagOrDefault (InstallDirs.toPathTemplate "")
prefixTemplate = fromFlagTemplate (configProgPrefix configFlags)
......
......@@ -15,9 +15,10 @@
module Distribution.Client.Types where
import Distribution.Package
( PackageName, PackageId, Package(..), PackageFixedDeps(..) )
( PackageName, PackageId, Package(..), PackageFixedDeps(..)
, mkPackageKey, PackageKey )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
( InstalledPackageInfo, packageKey )
import Distribution.PackageDescription
( Benchmark(..), GenericPackageDescription(..), FlagAssignment
, TestSuite