Commit 273dacfd authored by Francesco Gazzetta's avatar Francesco Gazzetta

Extract installLibraries and InstallExes from installAction

parent e8bc95de
......@@ -47,7 +47,7 @@ import Distribution.Client.ProjectConfig.Types
, projectConfigDistDir, projectConfigConfigFile )
import Distribution.Simple.Program.Db
( userSpecifyPaths, userSpecifyArgss, defaultProgramDb
, modifyProgramSearchPath )
, modifyProgramSearchPath, ProgramDb )
import Distribution.Simple.Program.Find
( ProgramSearchPathEntry(..) )
import Distribution.Client.Config
......@@ -90,7 +90,8 @@ import Distribution.Simple.Command
import Distribution.Simple.Configure
( configCompilerEx )
import Distribution.Simple.Compiler
( Compiler(..), CompilerId(..), CompilerFlavor(..) )
( Compiler(..), CompilerId(..), CompilerFlavor(..)
, PackageDBStack )
import Distribution.Simple.GHC
( ghcPlatformAndVersionString
, GhcImplInfo(..), getImplInfo
......@@ -566,59 +567,17 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags
buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx
runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes
-- Now that we built everything we can do the installation part.
-- First, figure out if / what parts we want to install:
let
dryRun = buildSettingDryRun $ buildSettings baseCtx
mkPkgBinDir = (</> "bin") .
storePackageDirectory
(cabalStoreDirLayout $ cabalDirLayout baseCtx)
compilerId
installLibs = fromFlagOrDefault False (ninstInstallLibs newInstallFlags)
when (not installLibs && not dryRun) $ do
-- If there are exes, symlink them
let symlinkBindirUnknown =
"symlink-bindir is not defined. Set it in your cabal config file "
++ "or use --symlink-bindir=<path>"
symlinkBindir <- fromFlagOrDefault (die' verbosity symlinkBindirUnknown)
$ fmap makeAbsolute
$ projectConfigSymlinkBinDir
$ projectConfigBuildOnly
$ projectConfig $ baseCtx
createDirectoryIfMissingVerbose verbosity False symlinkBindir
warnIfNoExes verbosity buildCtx
let
doSymlink = symlinkBuiltPackage
verbosity
overwritePolicy
mkPkgBinDir symlinkBindir
in traverse_ doSymlink $ Map.toList $ targetsMap buildCtx
when (installLibs && not dryRun) $
if supportsPkgEnvFiles
then do
-- Why do we get it again? If we updated a globalPackage then we need
-- the new version.
installedIndex' <- getInstalledPackages verbosity compiler packageDbs progDb'
let
getLatest = fmap (head . snd) . take 1 . sortBy (comparing (Down . fst))
. PI.lookupPackageName installedIndex'
globalLatest = concat (getLatest <$> globalPackages)
baseEntries =
GhcEnvFileClearPackageDbStack : fmap GhcEnvFilePackageDb packageDbs
globalEntries = GhcEnvFilePackageId . installedUnitId <$> globalLatest
pkgEntries = ordNub $
globalEntries
++ envEntries'
++ entriesForLibraryComponents (targetsMap buildCtx)
contents' = renderGhcEnvironmentFile (baseEntries ++ pkgEntries)
createDirectoryIfMissing True (takeDirectory envFile)
writeFileAtomic envFile (BS.pack contents')
else
warn verbosity $
"The current compiler doesn't support safely installing libraries, "
++ "so only executables will be available. (Library installation is "
++ "supported on GHC 8.0+ only)"
-- Then, install!
when (not dryRun) $
if installLibs
then installLibraries verbosity buildCtx compiler packageDbs progDb envFile envEntries'
else installExes verbosity baseCtx buildCtx compiler newInstallFlags
where
configFlags' = disableTestsBenchsByDefault configFlags
verbosity = fromFlagOrDefault normal (configVerbosity configFlags')
......@@ -626,9 +585,76 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags
globalFlags configFlags' configExFlags
installFlags haddockFlags testFlags
globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)
-- | Install any built exe by symlinking it
installExes :: Verbosity
-> ProjectBaseContext
-> ProjectBuildContext
-> Compiler
-> NewInstallFlags
-> IO ()
installExes verbosity baseCtx buildCtx compiler newInstallFlags = do
let mkPkgBinDir = (</> "bin") .
storePackageDirectory
(cabalStoreDirLayout $ cabalDirLayout baseCtx)
(compilerId compiler)
symlinkBindirUnknown =
"symlink-bindir is not defined. Set it in your cabal config file "
++ "or use --symlink-bindir=<path>"
symlinkBindir <- fromFlagOrDefault (die' verbosity symlinkBindirUnknown)
$ fmap makeAbsolute
$ projectConfigSymlinkBinDir
$ projectConfigBuildOnly
$ projectConfig baseCtx
createDirectoryIfMissingVerbose verbosity False symlinkBindir
warnIfNoExes verbosity buildCtx
let
doSymlink = symlinkBuiltPackage
verbosity
overwritePolicy
mkPkgBinDir symlinkBindir
in traverse_ doSymlink $ Map.toList $ targetsMap buildCtx
where
overwritePolicy = fromFlagOrDefault NeverOverwrite
$ ninstOverwritePolicy newInstallFlags
-- | Install any built library by adding it to the default ghc environment
installLibraries :: Verbosity
-> ProjectBuildContext
-> Compiler
-> PackageDBStack
-> ProgramDb
-> FilePath -- ^ Environment file
-> [GhcEnvironmentFileEntry]
-> IO ()
installLibraries verbosity buildCtx compiler
packageDbs programDb envFile envEntries = do
-- Why do we get it again? If we updated a globalPackage then we need
-- the new version.
installedIndex <- getInstalledPackages verbosity compiler packageDbs programDb
if supportsPkgEnvFiles $ getImplInfo compiler
then do
let
getLatest = fmap (head . snd) . take 1 . sortBy (comparing (Down . fst))
. PI.lookupPackageName installedIndex
globalLatest = concat (getLatest <$> globalPackages)
baseEntries =
GhcEnvFileClearPackageDbStack : fmap GhcEnvFilePackageDb packageDbs
globalEntries = GhcEnvFilePackageId . installedUnitId <$> globalLatest
pkgEntries = ordNub $
globalEntries
++ envEntries
++ entriesForLibraryComponents (targetsMap buildCtx)
contents' = renderGhcEnvironmentFile (baseEntries ++ pkgEntries)
createDirectoryIfMissing True (takeDirectory envFile)
writeFileAtomic envFile (BS.pack contents')
else
warn verbosity $
"The current compiler doesn't support safely installing libraries, "
++ "so only executables will be available. (Library installation is "
++ "supported on GHC 8.0+ only)"
warnIfNoExes :: Verbosity -> ProjectBuildContext -> IO ()
warnIfNoExes verbosity buildCtx =
when noExes $
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment