From 346463817a9591a8e6422ac4e066f016d68fda62 Mon Sep 17 00:00:00 2001 From: Kirill Zaborsky Date: Mon, 21 Dec 2020 16:33:36 +0300 Subject: [PATCH] Initialize custom-setup deps for stack dist This `explicit-setup-deps` unnecessary and thus it was removed --- ChangeLog.md | 5 ++ doc/yaml_configuration.md | 25 -------- src/Stack/Build.hs | 6 ++ src/Stack/Build/Execute.hs | 116 +++---------------------------------- src/Stack/Config.hs | 1 - src/Stack/Ghci.hs | 11 ++-- src/Stack/SDist.hs | 29 ++++++++-- src/Stack/Types/Config.hs | 31 ---------- 8 files changed, 51 insertions(+), 173 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 5f1321decc..5c8928b488 100644 --- a/ChangeLog.md +++ b/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: Bug fixes: diff --git a/doc/yaml_configuration.md b/doc/yaml_configuration.md index a4bc92f8c1..067b6f48a5 100644 --- a/doc/yaml_configuration.md +++ b/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) diff --git a/src/Stack/Build.hs b/src/Stack/Build.hs index d4f05de350..23b9a97199 100644 --- a/src/Stack/Build.hs +++ b/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 . diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 0b11497283..a409313f09 100644 --- a/src/Stack/Build/Execute.hs +++ b/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 diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs index 4d651dfd27..cf41dbad9a 100644 --- a/src/Stack/Config.hs +++ b/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 diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index c8f5df5413..d207b97332 100644 --- a/src/Stack/Ghci.hs +++ b/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 diff --git a/src/Stack/SDist.hs b/src/Stack/SDist.hs index 9b66201d40..375a1ac608 100644 --- a/src/Stack/SDist.hs +++ b/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) diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs index cca8c6930d..23bb0b0cae 100644 --- a/src/Stack/Types/Config.hs +++ b/src/Stack/Types/Config.hs @@ -33,7 +33,6 @@ module Stack.Types.Config ,Config(..) ,HasConfig(..) ,askLatestSnapshotUrl - ,explicitSetupDeps ,configProjectRoot -- ** BuildConfig & HasBuildConfig ,BuildConfig(..) @@ -342,8 +341,6 @@ data Config = -- ^ How PVP upper bounds should be added to packages ,configModifyCodePage :: !Bool -- ^ Force the code page to UTF-8 on Windows - ,configExplicitSetupDeps :: !(Map (Maybe PackageName) Bool) - -- ^ See 'explicitSetupDeps'. 'Nothing' provides the default value. ,configRebuildGhcOptions :: !Bool -- ^ Rebuild on GHC options changes ,configApplyGhcOptions :: !ApplyGhcOptions @@ -835,8 +832,6 @@ data ConfigMonoid = -- ^ See 'configPvpBounds' ,configMonoidModifyCodePage :: !FirstTrue -- ^ See 'configModifyCodePage' - ,configMonoidExplicitSetupDeps :: !(Map (Maybe PackageName) Bool) - -- ^ See 'configExplicitSetupDeps' ,configMonoidRebuildGhcOptions :: !FirstFalse -- ^ See 'configMonoidRebuildGhcOptions' ,configMonoidApplyGhcOptions :: !(First ApplyGhcOptions) @@ -964,9 +959,6 @@ parseConfigMonoidObject rootDir obj = do configMonoidLocalProgramsBase <- First <$> obj ..:? configMonoidLocalProgramsBaseName configMonoidPvpBounds <- First <$> obj ..:? configMonoidPvpBoundsName configMonoidModifyCodePage <- FirstTrue <$> obj ..:? configMonoidModifyCodePageName - configMonoidExplicitSetupDeps <- - (obj ..:? configMonoidExplicitSetupDepsName ..!= mempty) - >>= fmap Map.fromList . mapM handleExplicitSetupDep . Map.toList configMonoidRebuildGhcOptions <- FirstFalse <$> obj ..:? configMonoidRebuildGhcOptionsName configMonoidApplyGhcOptions <- First <$> obj ..:? configMonoidApplyGhcOptionsName configMonoidAllowNewer <- First <$> obj ..:? configMonoidAllowNewerName @@ -995,16 +987,6 @@ parseConfigMonoidObject rootDir obj = do configMonoidStackDeveloperMode <- First <$> obj ..:? configMonoidStackDeveloperModeName return ConfigMonoid {..} - where - handleExplicitSetupDep :: (Monad m, MonadFail m) => (Text, Bool) -> m (Maybe PackageName, Bool) - handleExplicitSetupDep (name', b) = do - name <- - if name' == "*" - then return Nothing - else case parsePackageName $ T.unpack name' of - Nothing -> fail $ "Invalid package name: " ++ show name' - Just x -> return $ Just x - return (name, b) configMonoidWorkDirName :: Text configMonoidWorkDirName = "work-dir" @@ -1111,9 +1093,6 @@ configMonoidPvpBoundsName = "pvp-bounds" configMonoidModifyCodePageName :: Text configMonoidModifyCodePageName = "modify-code-page" -configMonoidExplicitSetupDepsName :: Text -configMonoidExplicitSetupDepsName = "explicit-setup-deps" - configMonoidRebuildGhcOptionsName :: Text configMonoidRebuildGhcOptionsName = "rebuild-ghc-options" @@ -1776,16 +1755,6 @@ instance ToJSON PvpBounds where instance FromJSON PvpBounds where parseJSON = withText "PvpBounds" (either fail return . parsePvpBounds) --- | Provide an explicit list of package dependencies when running a custom Setup.hs -explicitSetupDeps :: (MonadReader env m, HasConfig env) => PackageName -> m Bool -explicitSetupDeps name = do - m <- view $ configL.to configExplicitSetupDeps - return $ - Map.findWithDefault - (Map.findWithDefault False Nothing m) - (Just name) - m - -- | Data passed into Docker container for the Docker entrypoint's use newtype DockerEntrypoint = DockerEntrypoint { deUser :: Maybe DockerUser