Restructure code, fix library new-install solving on macOS

Cabal/Cabal.cabal

@@ -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

Cabal/Distribution/Simple/GHC.hs

@@ -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)

cabal-install/Distribution/Client/CmdInstall/EnvironmentParser.hs → Cabal/Distribution/Simple/GHC/EnvironmentParser.hs

 {-# 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)] ]
-    _ -> []

cabal-install/Distribution/Client/CmdInstall.hs

@@ -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

cabal-install/cabal-install.cabal

@@ -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