Commit 42fec407 authored by Alexis Williams's avatar Alexis Williams

Restructure code, fix library new-install solving on macOS

parent d091534e
......@@ -441,6 +441,7 @@ library
Distribution.GetOpt
Distribution.Lex
Distribution.Utils.String
Distribution.Simple.GHC.EnvironmentParser
Distribution.Simple.GHC.Internal
Distribution.Simple.GHC.IPI642
Distribution.Simple.GHC.IPIConvert
......
......@@ -53,12 +53,14 @@ module Distribution.Simple.GHC (
isDynamic,
getGlobalPackageDB,
pkgRoot,
-- * Constructing GHC environment files
-- * Constructing and deconstsructing GHC environment files
Internal.GhcEnvironmentFileEntry(..),
Internal.simpleGhcEnvironmentFile,
Internal.renderGhcEnvironmentFile,
Internal.writeGhcEnvironmentFile,
Internal.ghcPlatformAndVersionString,
readEnvironmentFile,
ParseErrorExc(..),
-- * Version-specific implementation quirks
getImplInfo,
GhcImplInfo(..)
......@@ -70,6 +72,7 @@ import Distribution.Compat.Prelude
import qualified Distribution.Simple.GHC.IPI642 as IPI642
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.Simple.GHC.ImplInfo
import Distribution.Simple.GHC.EnvironmentParser
import Distribution.PackageDescription.Utils (cabalBug)
import Distribution.PackageDescription as PD
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
......
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Distribution.Client.CmdInstall.EnvironmentParser
( readEnvironmentFile, ParseErrorExc(..)
, environmentFileToSpecifiers
) where
module Distribution.Simple.GHC.EnvironmentParser
( readEnvironmentFile, ParseErrorExc(..) ) where
import Prelude ()
import Distribution.Client.Compat.Prelude
import Distribution.Client.Types
( PackageSpecifier(..) )
import Distribution.Compat.Prelude
import Distribution.Simple.Compiler
( PackageDB(..) )
import Distribution.Simple.GHC
import Distribution.Simple.GHC.Internal
( GhcEnvironmentFileEntry(..) )
import Distribution.Solver.Types.PackageConstraint
( PackageProperty(..) )
import Distribution.Types.PackageId
( PackageIdentifier(..) )
import Distribution.Types.UnitId
( mkUnitId, unUnitId )
import Distribution.Types.VersionRange
( thisVersion )
( mkUnitId )
import Control.Exception
( Exception, throwIO )
......@@ -31,8 +22,6 @@ import Data.Char
( isAlphaNum )
import Data.Typeable
( Typeable )
import Distribution.Text
( simpleParse )
import qualified Text.Parsec as P
import Text.Parsec.String
( Parser, parseFromFile )
......@@ -63,10 +52,3 @@ readEnvironmentFile :: FilePath -> IO [GhcEnvironmentFileEntry]
readEnvironmentFile path =
either (throwIO . ParseErrorExc) return =<<
parseFromFile parseEnvironmentFile path
environmentFileToSpecifiers :: [GhcEnvironmentFileEntry] -> [PackageSpecifier a]
environmentFileToSpecifiers = foldMap $ \case
(GhcEnvFilePackageId unitId)
| Just PackageIdentifier{..} <- simpleParse (unUnitId unitId) ->
[ NamedPackage pkgName [PackagePropertyVersion (thisVersion pkgVersion)] ]
_ -> []
......@@ -26,7 +26,7 @@ import Distribution.Client.CmdSdist
import Distribution.Client.CmdInstall.EnvironmentParser
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags )
import Distribution.Client.Types
( PackageSpecifier(..), PackageLocation(..), UnresolvedSourcePackage )
import qualified Distribution.Client.InstallPlan as InstallPlan
......@@ -47,8 +47,12 @@ import Distribution.Simple.Program.Find
( ProgramSearchPathEntry(..) )
import Distribution.Client.Config
( getCabalDir )
import Distribution.Simple.PackageIndex
( lookupUnitId )
import Distribution.Types.InstalledPackageInfo
( InstalledPackageInfo(sourcePackageId) )
import Distribution.Client.IndexUtils
( getSourcePackages )
( getSourcePackages, getInstalledPackages )
import Distribution.Client.ProjectConfig
( readGlobalConfig, projectConfigWithBuilderRepoContext
, resolveBuildTimeSettings
......@@ -57,7 +61,8 @@ import Distribution.Client.ProjectConfig
import Distribution.Client.DistDirLayout
( defaultDistDirLayout, DistDirLayout(..), mkCabalDirLayout
, ProjectRoot(ProjectRootImplicit)
, storePackageDirectory, cabalStoreDirLayout )
, storePackageDirectory, cabalStoreDirLayout
, CabalDirLayout(..), StoreDirLayout(..) )
import Distribution.Client.RebuildMonad
( runRebuild )
import Distribution.Client.InstallSymlink
......@@ -307,8 +312,9 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
| dir <- fromNubList packageConfigProgramPathExtra ])
$ defaultProgramDb
(compiler@Compiler { compilerId = CompilerId compilerFlavor compilerVersion }, platform, _) <-
configCompilerEx hcFlavor hcPath hcPkg progDb verbosity
(compiler@Compiler { compilerId =
compilerId@(CompilerId compilerFlavor compilerVersion) }, platform, _) <-
configCompilerEx hcFlavor hcPath hcPkg progDb verbosity
let
envFile = home </> ".ghc" </> ghcPlatformAndVersionString platform compilerVersion
......@@ -322,7 +328,16 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
, envFileExists -> readEnvironmentFile envFile
| otherwise -> return []
let envSpecs = environmentFileToSpecifiers envEntries
cabalDir <- getCabalDir
let
mstoreDir = flagToMaybe (globalStoreDir globalFlags)
mlogsDir = flagToMaybe (globalLogsDir globalFlags)
cabalLayout = mkCabalDirLayout cabalDir mstoreDir mlogsDir
packageDbs = storePackageDBStack (cabalStoreDirLayout cabalLayout) compilerId
installedIndex <- getInstalledPackages verbosity compiler packageDbs defaultProgramDb
let envSpecs = environmentFileToSpecifiers installedIndex envEntries
-- Second, we need to use a fake project to let Cabal build the
-- installables correctly. For that, we need a place to put a
......@@ -369,18 +384,10 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx
let entries = entriesForLibraryComponents (targetsMap buildCtx)
createDirectoryIfMissing True (takeDirectory envFile)
when supportsPkgEnvFiles $ do
let
entries' = nub (envEntries ++ entries)
contents' = renderGhcEnvironmentFile entries'
writeFileAtomic envFile (BS.pack contents')
let mkPkgBinDir = (</> "bin") .
storePackageDirectory
(cabalStoreDirLayout $ cabalDirLayout baseCtx)
(compilerId compiler)
compilerId
-- If there are exes, symlink them
let symlinkBindirUnknown =
......@@ -395,6 +402,18 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
traverse_ (symlinkBuiltPackage verbosity mkPkgBinDir symlinkBindir)
$ Map.toList $ targetsMap buildCtx
runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes
let
baseEntries =
GhcEnvFileClearPackageDbStack
: fmap GhcEnvFilePackageDb packageDbs
entries = baseEntries ++ entriesForLibraryComponents (targetsMap buildCtx)
createDirectoryIfMissing True (takeDirectory envFile)
when supportsPkgEnvFiles $ do
let
entries' = nub (envEntries ++ entries)
contents' = renderGhcEnvironmentFile entries'
writeFileAtomic envFile (BS.pack contents')
where
configFlags' = disableTestsBenchsByDefault configFlags
verbosity = fromFlagOrDefault normal (configVerbosity configFlags')
......@@ -402,6 +421,15 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
globalFlags configFlags' configExFlags
installFlags haddockFlags
environmentFileToSpecifiers :: InstalledPackageIndex -> [GhcEnvironmentFileEntry]
-> [PackageSpecifier a]
environmentFileToSpecifiers ipi = foldMap $ \case
(GhcEnvFilePackageId unitId)
| Just InstalledPackageInfo{ sourcePackageId = PackageIdentifier{..} }
<- lookupUnitId ipi unitId ->
[ NamedPackage pkgName [PackagePropertyVersion (thisVersion pkgVersion)] ]
_ -> []
-- | Disables tests and benchmarks if they weren't explicitly enabled.
disableTestsBenchsByDefault :: ConfigFlags -> ConfigFlags
......
......@@ -155,7 +155,6 @@ library
Distribution.Client.CmdFreeze
Distribution.Client.CmdHaddock
Distribution.Client.CmdInstall
Distribution.Client.CmdInstall.EnvironmentParser
Distribution.Client.CmdRepl
Distribution.Client.CmdRun
Distribution.Client.CmdTest
......@@ -419,7 +418,6 @@ executable cabal
Distribution.Client.CmdFreeze
Distribution.Client.CmdHaddock
Distribution.Client.CmdInstall
Distribution.Client.CmdInstall.EnvironmentParser
Distribution.Client.CmdLegacy
Distribution.Client.CmdRepl
Distribution.Client.CmdRun
......
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