Merge pull request #5461 from commercialhaskell/4006-setup-custom-set…

…up-deps

Initialize custom-setup deps for stack dist

ChangeLog.md

@@ -16,6 +16,11 @@ Behavior changes:
   one package. See
   [#5421](https://github.com/commercialhaskell/stack/issues/5421)
 
+* `custom-setup` dependencies are now properly initialized for `stack dist`.
+  This makes `explicit-setup-deps` no longer required and that option was
+  removed. See
+  [#4006](https://github.com/commercialhaskell/stack/issues/4006)
+
 Other enhancements:
 
 * `stack list` is a new command to list package versions in a snapshot.

doc/yaml_configuration.md

@@ -781,31 +781,6 @@ is to modify.
 modify-code-page: false
 ```
 
-### explicit-setup-deps
-
-(Since 0.1.6)
-
-Decide whether a custom `Setup.hs` script should be run with an explicit list of
-dependencies, based on the dependencies of the package itself. It associates the
-name of a local package with a boolean. When it's `true`, the `Setup.hs` script
-is built with an explicit list of packages. When it's `false` (default), the
-`Setup.hs` script is built without access to the local DB, but can access any
-package in the snapshot / global DB.
-
-Note that in the future, this will be unnecessary, once Cabal provides full
-support for explicit Setup.hs dependencies.
-
-```yaml
-explicit-setup-deps:
-    "*": true # change the default
-    entropy: false # override the new default for one package
-```
-
-NOTE: since 1.4.0, Stack has support for Cabal's `custom-setup` block
-(introduced in Cabal 1.24). If a `custom-setup` block is provided in a `.cabal`
-file, it will override the setting of `explicit-setup-deps`, and instead rely
-on the stated dependencies.
-
 ### allow-newer
 
 (Since 0.1.7)

src/Stack/Build.hs

@@ -9,6 +9,7 @@
 
 module Stack.Build
   (build
+  ,buildLocalTargets
   ,loadPackage
   ,mkBaseConfigOpts
   ,queryBuildInfo
@@ -39,6 +40,7 @@ import           Stack.Build.Execute
 import           Stack.Build.Installed
 import           Stack.Build.Source
 import           Stack.Package
+import           Stack.Setup (withNewLocalBuildTargets)
 import           Stack.Types.Build
 import           Stack.Types.Config
 import           Stack.Types.NamedComponent
@@ -117,6 +119,10 @@ build msetLocalFiles = do
                          (smtTargets $ smTargets sourceMap)
                          plan
 
+buildLocalTargets :: HasEnvConfig env => NonEmpty Text -> RIO env (Either SomeException ())
+buildLocalTargets targets =
+  tryAny $ withNewLocalBuildTargets (NE.toList targets) $ build Nothing
+
 justLocals :: Plan -> [PackageIdentifier]
 justLocals =
     map taskProvides .

src/Stack/Build/Execute.hs

@@ -1024,10 +1024,8 @@ withSingleContext :: forall env a. HasEnvConfig env
                   => ActionContext
                   -> ExecuteEnv
                   -> Task
-                  -> Maybe (Map PackageIdentifier GhcPkgId)
-                  -- ^ All dependencies' package ids to provide to Setup.hs. If
-                  -- Nothing, just provide global and snapshot package
-                  -- databases.
+                  -> Map PackageIdentifier GhcPkgId
+                  -- ^ All dependencies' package ids to provide to Setup.hs.
                   -> Maybe String
                   -> (  Package                                -- Package info
                      -> Path Abs File                          -- Cabal file path
@@ -1040,7 +1038,7 @@ withSingleContext :: forall env a. HasEnvConfig env
                      -> OutputType
                      -> RIO env a)
                   -> RIO env a
-withSingleContext ActionContext {..} ee@ExecuteEnv {..} task@Task {..} mdeps msuffix inner0 =
+withSingleContext ActionContext {..} ee@ExecuteEnv {..} task@Task {..} allDeps msuffix inner0 =
     withPackage $ \package cabalfp pkgDir ->
     withOutputType pkgDir package $ \outputType ->
     withCabal package pkgDir outputType $ \cabal ->
@@ -1180,24 +1178,18 @@ withSingleContext ActionContext {..} ee@ExecuteEnv {..} task@Task {..} mdeps msu
 
                 getPackageArgs :: Path Abs Dir -> RIO env [String]
                 getPackageArgs setupDir =
-                    case (packageSetupDeps package, mdeps) of
+                    case packageSetupDeps package of
                         -- The package is using the Cabal custom-setup
                         -- configuration introduced in Cabal 1.24. In
                         -- this case, the package is providing an
                         -- explicit list of dependencies, and we
                         -- should simply use all of them.
-                        (Just customSetupDeps, _) -> do
+                        Just customSetupDeps -> do
                             unless (Map.member (mkPackageName "Cabal") customSetupDeps) $
                                 prettyWarnL
                                     [ fromString $ packageNameString $ packageName package
                                     , "has a setup-depends field, but it does not mention a Cabal dependency. This is likely to cause build errors."
                                     ]
-                            allDeps <-
-                                case mdeps of
-                                    Just x -> return x
-                                    Nothing -> do
-                                        prettyWarnS "In getPackageArgs: custom-setup in use, but no dependency map present"
-                                        return Map.empty
                             matchedDeps <- forM (Map.toList customSetupDeps) $ \(name, range) -> do
                                 let matches (PackageIdentifier name' version) =
                                         name == name' &&
@@ -1218,21 +1210,6 @@ withSingleContext ActionContext {..} ee@ExecuteEnv {..} task@Task {..} mdeps msu
                             writeBinaryFileAtomic cppMacrosFile (encodeUtf8Builder (T.pack (C.generatePackageVersionMacros macroDeps)))
                             return (packageDBArgs ++ depsArgs ++ cppArgs)
 
-                        -- This branch is taken when
-                        -- 'explicit-setup-deps' is requested in your
-                        -- stack.yaml file.
-                        (Nothing, Just deps) | explicitSetupDeps (packageName package) config -> do
-                            warnCustomNoDeps
-                            -- Stack always builds with the global Cabal for various
-                            -- reproducibility issues.
-                            let depsMinusCabal
-                                 = map ghcPkgIdString
-                                 $ Set.toList
-                                 $ addGlobalPackages deps (Map.elems eeGlobalDumpPkgs)
-                            return (
-                                packageDBArgs ++
-                                cabalPackageArg ++
-                                map ("-package-id=" ++) depsMinusCabal)
                         -- This branch is usually taken for builds, and
                         -- is always taken for `stack sdist`.
                         --
@@ -1250,7 +1227,7 @@ withSingleContext ActionContext {..} ee@ExecuteEnv {..} task@Task {..} mdeps msu
                         -- Currently, this branch is only taken via `stack
                         -- sdist` or when explicitly requested in the
                         -- stack.yaml file.
-                        (Nothing, _) -> do
+                        Nothing -> do
                             warnCustomNoDeps
                             return $ cabalPackageArg ++
                                     -- NOTE: This is different from
@@ -1542,7 +1519,7 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap
       where
         bindir = bcoSnapInstallRoot eeBaseConfigOpts </> bindirSuffix
 
-    realConfigAndBuild cache mcurator allDepsMap = withSingleContext ac ee task (Just allDepsMap) Nothing
+    realConfigAndBuild cache mcurator allDepsMap = withSingleContext ac ee task allDepsMap Nothing
         $ \package cabalfp pkgDir cabal0 announce _outputType -> do
             let cabal = cabal0 CloseOnException
             executableBuildStatuses <- getExecutableBuildStatuses package pkgDir
@@ -1859,7 +1836,7 @@ singleTest topts testsToRun ac ee task installedMap = do
     mcurator <- view $ buildConfigL.to bcCurator
     let pname = pkgName $ taskProvides task
         expectFailure = expectTestFailure pname mcurator
-    withSingleContext ac ee task (Just allDepsMap) (Just "test") $ \package _cabalfp pkgDir _cabal announce outputType -> do
+    withSingleContext ac ee task allDepsMap (Just "test") $ \package _cabalfp pkgDir _cabal announce outputType -> do
         config <- view configL
         let needHpc = toCoverage topts
 
@@ -2087,7 +2064,7 @@ singleBench :: HasEnvConfig env
             -> RIO env ()
 singleBench beopts benchesToRun ac ee task installedMap = do
     (allDepsMap, _cache) <- getConfigCache ee task installedMap False True
-    withSingleContext ac ee task (Just allDepsMap) (Just "bench") $ \_package _cabalfp _pkgDir cabal announce _outputType -> do
+    withSingleContext ac ee task allDepsMap (Just "bench") $ \_package _cabalfp _pkgDir cabal announce _outputType -> do
         let args = map T.unpack benchesToRun <> maybe []
                          ((:[]) . ("--benchmark-options=" <>))
                          (beoAdditionalArgs beopts)
@@ -2286,81 +2263,6 @@ taskComponents task =
         TTLocalMutable lp -> lpComponents lp -- FIXME probably just want lpWanted
         TTRemotePackage{} -> Set.empty
 
--- | Take the given list of package dependencies and the contents of the global
--- package database, and construct a set of installed package IDs that:
---
--- * Excludes the Cabal library (it's added later)
---
--- * Includes all packages depended on by this package
---
--- * Includes all global packages, unless: (1) it's hidden, (2) it's shadowed
---   by a depended-on package, or (3) one of its dependencies is not met.
---
--- See:
---
--- * https://github.com/commercialhaskell/stack/issues/941
---
--- * https://github.com/commercialhaskell/stack/issues/944
---
--- * https://github.com/commercialhaskell/stack/issues/949
-addGlobalPackages :: Map PackageIdentifier GhcPkgId -- ^ dependencies of the package
-                  -> [DumpPackage] -- ^ global packages
-                  -> Set GhcPkgId
-addGlobalPackages deps globals0 =
-    res
-  where
-    -- Initial set of packages: the installed IDs of all dependencies
-    res0 = Map.elems $ Map.filterWithKey (\ident _ -> not $ isCabal ident) deps
-
-    -- First check on globals: it's not shadowed by a dep, it's not Cabal, and
-    -- it's exposed
-    goodGlobal1 dp = not (isDep dp)
-                  && not (isCabal $ dpPackageIdent dp)
-                  && dpIsExposed dp
-    globals1 = filter goodGlobal1 globals0
-
-    -- Create a Map of unique package names in the global database
-    globals2 = Map.fromListWith chooseBest
-             $ map (pkgName . dpPackageIdent &&& id) globals1
-
-    -- Final result: add in globals that have their dependencies met
-    res = loop id (Map.elems globals2) $ Set.fromList res0
-
-    ----------------------------------
-    -- Some auxiliary helper functions
-    ----------------------------------
-
-    -- Is the given package identifier for any version of Cabal
-    isCabal (PackageIdentifier name _) = name == mkPackageName "Cabal"
-
-    -- Is the given package name provided by the package dependencies?
-    isDep dp = pkgName (dpPackageIdent dp) `Set.member` depNames
-    depNames = Set.map pkgName $ Map.keysSet deps
-
-    -- Choose the best of two competing global packages (the newest version)
-    chooseBest dp1 dp2
-        | getVer dp1 < getVer dp2 = dp2
-        | otherwise               = dp1
-      where
-        getVer = pkgVersion . dpPackageIdent
-
-    -- Are all dependencies of the given package met by the given Set of
-    -- installed packages
-    depsMet dp gids = all (`Set.member` gids) (dpDepends dp)
-
-    -- Find all globals that have all of their dependencies met
-    loop front (dp:dps) gids
-        -- This package has its deps met. Add it to the list of dependencies
-        -- and then traverse the list from the beginning (this package may have
-        -- been a dependency of an earlier one).
-        | depsMet dp gids = loop id (front dps) (Set.insert (dpGhcPkgId dp) gids)
-        -- Deps are not met, keep going
-        | otherwise = loop (front . (dp:)) dps gids
-    -- None of the packages we checked can be added, therefore drop them all
-    -- and return our results
-    loop _ [] gids = gids
-
-
 expectTestFailure :: PackageName -> Maybe Curator -> Bool
 expectTestFailure pname mcurator =
     maybe False (Set.member pname . curatorExpectTestFailure) mcurator

src/Stack/Config.hs

@@ -329,7 +329,6 @@ configFromConfigMonoid
          configSetupInfoInline = configMonoidSetupInfoInline
          configPvpBounds = fromFirst (PvpBounds PvpBoundsNone False) configMonoidPvpBounds
          configModifyCodePage = fromFirstTrue configMonoidModifyCodePage
-         configExplicitSetupDeps = configMonoidExplicitSetupDeps
          configRebuildGhcOptions = fromFirstFalse configMonoidRebuildGhcOptions
          configApplyGhcOptions = fromFirst AGOLocals configMonoidApplyGhcOptions
          configAllowNewer = fromFirst False configMonoidAllowNewer

src/Stack/Ghci.hs

@@ -21,6 +21,7 @@ import           Data.ByteString.Builder (byteString)
 import qualified Data.ByteString.Char8 as S8
 import qualified Data.ByteString.Lazy as LBS
 import           Data.List
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 import qualified Data.Text as T
@@ -41,7 +42,6 @@ import           Stack.Constants
 import           Stack.Constants.Config
 import           Stack.Ghci.Script
 import           Stack.Package
-import           Stack.Setup (withNewLocalBuildTargets)
 import           Stack.Types.Build
 import           Stack.Types.Config
 import           Stack.Types.NamedComponent
@@ -346,14 +346,17 @@ buildDepsAndInitialSteps GhciOpts{..} localTargets = do
     let targets = localTargets ++ map T.pack ghciAdditionalPackages
     -- If necessary, do the build, for local packagee targets, only do
     -- 'initialBuildSteps'.
-    when (not ghciNoBuild && not (null targets)) $ do
-        -- only new local targets could appear here
-        eres <- tryAny $ withNewLocalBuildTargets targets $ build Nothing
+    case NE.nonEmpty targets of
+      -- only new local targets could appear here
+      Just nonEmptyTargets | not ghciNoBuild -> do
+        eres <- buildLocalTargets nonEmptyTargets
         case eres of
             Right () -> return ()
             Left err -> do
                 prettyError $ fromString (show err)
                 prettyWarn "Build failed, but trying to launch GHCi anyway"
+      _ ->
+        return ()
 
 checkAdditionalPackages :: MonadThrow m => [String] -> m [PackageName]
 checkAdditionalPackages pkgs = forM pkgs $ \name -> do

src/Stack/SDist.hs

@@ -44,10 +44,11 @@ import           Distribution.Version (simplifyVersionRange, orLaterVersion, ear
 import           Path
 import           Path.IO hiding (getModificationTime, getPermissions, withSystemTempDir)
 import           RIO.PrettyPrint
-import           Stack.Build (mkBaseConfigOpts, build)
+import           Stack.Build (mkBaseConfigOpts, build, buildLocalTargets)
 import           Stack.Build.Execute
 import           Stack.Build.Installed
 import           Stack.Build.Source (projectLocalPackages)
+import           Stack.Types.GhcPkgId
 import           Stack.Package
 import           Stack.SourceMap
 import           Stack.Types.Build
@@ -103,9 +104,27 @@ getSDistTarball mpvpBounds pkgDir = do
         tweakCabal = pvpBounds /= PvpBoundsNone
         pkgFp = toFilePath pkgDir
     lp <- readLocalPackage pkgDir
+    forM_ (packageSetupDeps (lpPackage lp)) $ \customSetupDeps ->
+        case NE.nonEmpty (map (T.pack . packageNameString) (Map.keys customSetupDeps)) of
+          Just nonEmptyDepTargets -> do
+            eres <- buildLocalTargets nonEmptyDepTargets
+            case eres of
+              Left err ->
+                logError $ "Error building custom-setup dependencies: " <> displayShow err
+              Right _ ->
+                return ()
+          Nothing ->
+            logWarn "unexpected empty custom-setup dependencies"
     sourceMap <- view $ envConfigL.to envConfigSourceMap
+
+    installMap <- toInstallMap sourceMap
+    (installedMap, _globalDumpPkgs, _snapshotDumpPkgs, _localDumpPkgs) <-
+        getInstalled installMap
+    let deps = Map.fromList [ (pid, ghcPkgId)
+                            | (_, Library pid ghcPkgId _) <- Map.elems installedMap]
+
     logInfo $ "Getting file list for " <> fromString pkgFp
-    (fileList, cabalfp) <- getSDistFileList lp
+    (fileList, cabalfp) <- getSDistFileList lp deps
     logInfo $ "Building sdist tarball for " <> fromString pkgFp
     files <- normalizeTarballPaths (map (T.unpack . stripCR . T.pack) (lines fileList))
 
@@ -305,8 +324,8 @@ readLocalPackage pkgDir = do
         }
 
 -- | Returns a newline-separate list of paths, and the absolute path to the .cabal file.
-getSDistFileList :: HasEnvConfig env => LocalPackage -> RIO env (String, Path Abs File)
-getSDistFileList lp =
+getSDistFileList :: HasEnvConfig env => LocalPackage -> Map PackageIdentifier GhcPkgId -> RIO env (String, Path Abs File)
+getSDistFileList lp deps =
     withSystemTempDir (stackProgName <> "-sdist") $ \tmpdir -> do
         let bopts = defaultBuildOpts
         let boptsCli = defaultBuildOptsCLI
@@ -315,7 +334,7 @@ getSDistFileList lp =
         withExecuteEnv bopts boptsCli baseConfigOpts locals
             [] [] [] Nothing -- provide empty list of globals. This is a hack around custom Setup.hs files
             $ \ee ->
-            withSingleContext ac ee task Nothing (Just "sdist") $ \_package cabalfp _pkgDir cabal _announce _outputType -> do
+            withSingleContext ac ee task deps (Just "sdist") $ \_package cabalfp _pkgDir cabal _announce _outputType -> do
                 let outFile = toFilePath tmpdir FP.</> "source-files-list"
                 cabal CloseOnException KeepTHLoading ["sdist", "--list-sources", outFile]
                 contents <- liftIO (S.readFile outFile)