diff --git a/.github/mergify.yml b/.github/mergify.yml index 3f6e9f6e078..5864577f608 100644 --- a/.github/mergify.yml +++ b/.github/mergify.yml @@ -97,10 +97,6 @@ pull_request_rules: - label=merge delay passed - '#approved-reviews-by>=2' - '-label~=^blocked:' - # unlike the others, we need to force this one to be up to date - # because it's intended for when Mergify doesn't have permission - # to rebase - - '#commits-behind=0' # merge strategy for release branches - actions: diff --git a/Cabal/src/Distribution/Simple/Utils.hs b/Cabal/src/Distribution/Simple/Utils.hs index d51601e5c27..d2e738900da 100644 --- a/Cabal/src/Distribution/Simple/Utils.hs +++ b/Cabal/src/Distribution/Simple/Utils.hs @@ -534,7 +534,7 @@ verbosityHandle verbosity warn :: Verbosity -> String -> IO () warn verbosity msg = warnMessage "Warning" verbosity msg --- | Like 'warn', but prepend @Error: …@ instead of @Waring: …@ before the +-- | Like 'warn', but prepend @Error: …@ instead of @Warning: …@ before the -- the message. Useful when you want to highlight the condition is an error -- but do not want to quit the program yet. warnError :: Verbosity -> String -> IO () diff --git a/Makefile b/Makefile index 5cf1cae4d6f..24d840ce39e 100644 --- a/Makefile +++ b/Makefile @@ -49,12 +49,18 @@ whitespace: ## Run fix-whitespace in check mode fix-whitespace: ## Run fix-whitespace in fix mode fix-whitespace --verbose +.PHONY: lint +lint: ## Run HLint + hlint -j . + +.PHONY: lint-json +lint-json: ## Run HLint in JSON mode + hlint -j --json -- . + # local checks .PHONY: checks -checks: whitespace style - # this should probably be a rule - hlint -j --json -- . +checks: whitespace style lint-json # source generation: SPDX diff --git a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs b/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs index c57ade0c3e3..b98d493656c 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs @@ -16,6 +16,7 @@ module Distribution.Solver.Types.ProjectConfigPath -- * Checks and Normalization , isCyclicConfigPath + , isTopLevelConfigPath , canonicalizeConfigPath ) where @@ -138,6 +139,11 @@ nullProjectConfigPath = ProjectConfigPath $ "unused" :| [] isCyclicConfigPath :: ProjectConfigPath -> Bool isCyclicConfigPath (ProjectConfigPath p) = length p /= length (NE.nub p) +-- | Check if the project config path is top-level, meaning it was not included by +-- some other project config. +isTopLevelConfigPath :: ProjectConfigPath -> Bool +isTopLevelConfigPath (ProjectConfigPath p) = NE.length p == 1 + -- | Prepends the path of the importee to the importer path. consProjectConfigPath :: FilePath -> ProjectConfigPath -> ProjectConfigPath consProjectConfigPath p ps = ProjectConfigPath (p <| coerce ps) diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 1587b20a44d..a5df21b185b 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -467,6 +467,7 @@ installAction flags@NixStyleFlags{extraFlags, configFlags, installFlags, project fetchAndReadSourcePackages verbosity distDirLayout + compiler (projectConfigShared config) (projectConfigBuildOnly config) [ProjectPackageRemoteTarball uri | uri <- uris] diff --git a/cabal-install/src/Distribution/Client/CmdPath.hs b/cabal-install/src/Distribution/Client/CmdPath.hs index 8ca8d6181f1..61fd8162b73 100644 --- a/cabal-install/src/Distribution/Client/CmdPath.hs +++ b/cabal-install/src/Distribution/Client/CmdPath.hs @@ -95,7 +95,7 @@ pathCommand :: CommandUI (NixStyleFlags PathFlags) pathCommand = CommandUI { commandName = "path" - , commandSynopsis = "Query for simple project information" + , commandSynopsis = "Query for simple project information." , commandDescription = Just $ \_ -> wrapText $ "Query for configuration and project information such as project GHC.\n" diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index f66cf0d651c..705c62d62d1 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -457,8 +457,8 @@ readRepoIndex verbosity repoCtxt repo idxState = if isDoesNotExistError e then do case repo of - RepoRemote{..} -> dieWithException verbosity $ MissingPackageList repoRemote - RepoSecure{..} -> dieWithException verbosity $ MissingPackageList repoRemote + RepoRemote{..} -> warn verbosity $ exceptionMessageCabalInstall $ MissingPackageList repoRemote + RepoSecure{..} -> warn verbosity $ exceptionMessageCabalInstall $ MissingPackageList repoRemote RepoLocalNoIndex local _ -> warn verbosity $ "Error during construction of local+noindex " diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs index b6a8198ae5c..635cd7e1689 100644 --- a/cabal-install/src/Distribution/Client/Install.hs +++ b/cabal-install/src/Distribution/Client/Install.hs @@ -142,6 +142,7 @@ import Distribution.Solver.Types.PkgConfigDb import Distribution.Solver.Types.Settings import Distribution.Solver.Types.SourcePackage as SourcePackage +import Distribution.Client.ProjectConfig import Distribution.Client.Utils ( MergeResult (..) , ProgressPhase (..) @@ -1443,7 +1444,7 @@ performInstallations if parallelInstall then newParallelJobControl numJobs else newSerialJobControl - fetchLimit <- newJobLimit (min numJobs numFetchJobs) + fetchLimit <- newJobLimit (min numJobs maxNumFetchJobs) installLock <- newLock -- serialise installation cacheLock <- newLock -- serialise access to setup exe cache executeInstallPlan @@ -1486,7 +1487,6 @@ performInstallations cinfo = compilerInfo comp numJobs = determineNumJobs (installNumJobs installFlags) - numFetchJobs = 2 parallelInstall = numJobs >= 2 keepGoing = fromFlag (installKeepGoing installFlags) distPref = diff --git a/cabal-install/src/Distribution/Client/JobControl.hs b/cabal-install/src/Distribution/Client/JobControl.hs index 2b9f472d3dc..9cc7ac92a05 100644 --- a/cabal-install/src/Distribution/Client/JobControl.hs +++ b/cabal-install/src/Distribution/Client/JobControl.hs @@ -31,6 +31,11 @@ module Distribution.Client.JobControl , Lock , newLock , criticalSection + + -- * Higher level utils + , newJobControlFromParStrat + , withJobControl + , mapConcurrentWithJobs ) where import Distribution.Client.Compat.Prelude @@ -40,11 +45,14 @@ import Control.Concurrent (forkIO, forkIOWithUnmask, threadDelay) import Control.Concurrent.MVar import Control.Concurrent.STM (STM, TVar, atomically, modifyTVar', newTVarIO, readTVar) import Control.Concurrent.STM.TChan -import Control.Exception (bracket_, mask_, try) +import Control.Exception (bracket, bracket_, mask_, try) import Control.Monad (forever, replicateM_) import Distribution.Client.Compat.Semaphore +import Distribution.Client.Utils (numberOfProcessors) import Distribution.Compat.Stack +import Distribution.Simple.Compiler import Distribution.Simple.Utils +import Distribution.Types.ParStrat import System.Semaphore -- | A simple concurrency abstraction. Jobs can be spawned and can complete @@ -262,3 +270,38 @@ newLock = fmap Lock $ newMVar () criticalSection :: Lock -> IO a -> IO a criticalSection (Lock lck) act = bracket_ (takeMVar lck) (putMVar lck ()) act + +-------------------------------------------------------------------------------- +-- More high level utils +-------------------------------------------------------------------------------- + +newJobControlFromParStrat + :: Verbosity + -> Compiler + -> ParStratInstall + -- ^ The parallel strategy + -> Maybe Int + -- ^ A cap on the number of jobs (e.g. to force a maximum of 2 concurrent downloads despite a -j8 parallel strategy) + -> IO (JobControl IO a) +newJobControlFromParStrat verbosity compiler parStrat numJobsCap = case parStrat of + Serial -> newSerialJobControl + NumJobs n -> newParallelJobControl (capJobs (fromMaybe numberOfProcessors n)) + UseSem n -> + if jsemSupported compiler + then newSemaphoreJobControl verbosity (capJobs n) + else do + warn verbosity "-jsem is not supported by the selected compiler, falling back to normal parallelism control." + newParallelJobControl (capJobs n) + where + capJobs n = min (fromMaybe maxBound numJobsCap) n + +withJobControl :: IO (JobControl IO a) -> (JobControl IO a -> IO b) -> IO b +withJobControl mkJC = bracket mkJC cleanupJobControl + +-- | Concurrently execute actions on a list using the given JobControl. +-- The maximum number of concurrent jobs is tied to the JobControl instance. +-- The resulting list does /not/ preserve the original order! +mapConcurrentWithJobs :: JobControl IO b -> (a -> IO b) -> [a] -> IO [b] +mapConcurrentWithJobs jobControl f xs = do + traverse_ (spawnJob jobControl . f) xs + traverse (const $ collectJob jobControl) xs diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index e6278a5ef9a..a3ebcc4e4c5 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -236,6 +236,7 @@ import Distribution.Simple.Utils , notice , topHandler , tryFindPackageDesc + , warn ) import Distribution.Text ( display @@ -1343,6 +1344,7 @@ checkAction checkFlags extraArgs _globalFlags = do formatAction :: Flag Verbosity -> [String] -> Action formatAction verbosityFlag extraArgs _globalFlags = do let verbosity = fromFlag verbosityFlag + warn verbosity "This command is not a full formatter yet" path <- case extraArgs of [] -> relativeSymbolicPath <$> tryFindPackageDesc verbosity Nothing (p : _) -> return $ makeSymbolicPath p diff --git a/cabal-install/src/Distribution/Client/ParseUtils.hs b/cabal-install/src/Distribution/Client/ParseUtils.hs index 18062b7428f..96c702a2970 100644 --- a/cabal-install/src/Distribution/Client/ParseUtils.hs +++ b/cabal-install/src/Distribution/Client/ParseUtils.hs @@ -1,6 +1,8 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} ----------------------------------------------------------------------------- @@ -53,6 +55,7 @@ import Distribution.Deprecated.ParseUtils ( Field (..) , FieldDescr (..) , LineNo + , PError (..) , ParseResult (..) , liftField , lineNo @@ -292,13 +295,16 @@ parseFieldsAndSections fieldDescrs sectionDescrs fgSectionDescrs = setField a (F line name value) = case Map.lookup name fieldMap of Just (FieldDescr _ _ set) -> set line value a - Nothing -> do - warning $ - "Unrecognized field '" - ++ name - ++ "' on line " - ++ show line - return a + Nothing -> + case Left <$> Map.lookup name sectionMap <|> Right <$> Map.lookup name fgSectionMap of + Just _ -> ParseFailed $ FieldShouldBeStanza name line + Nothing -> do + warning $ + "Unrecognized field '" + ++ name + ++ "' on line " + ++ show line + return a setField a (Section line name param fields) = case Left <$> Map.lookup name sectionMap <|> Right <$> Map.lookup name fgSectionMap of Just (Left (SectionDescr _ fieldDescrs' sectionDescrs' _ set sectionEmpty)) -> do diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs index 4d7bde7fc55..e70a89af8a3 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs @@ -88,7 +88,7 @@ import qualified Data.Set as Set import qualified Text.PrettyPrint as Disp -import Control.Exception (assert, bracket, handle) +import Control.Exception (assert, handle) import System.Directory (doesDirectoryExist, doesFileExist, renameDirectory) import System.FilePath (makeRelative, normalise, takeDirectory, (<.>), ()) import System.Semaphore (SemaphoreName (..)) @@ -98,7 +98,6 @@ import Distribution.Simple.Flag (fromFlagOrDefault) import Distribution.Client.ProjectBuilding.PackageFileMonitor import Distribution.Client.ProjectBuilding.UnpackedPackage (annotateFailureNoLog, buildAndInstallUnpackedPackage, buildInplaceUnpackedPackage) -import Distribution.Client.Utils (numberOfProcessors) ------------------------------------------------------------------------------ @@ -355,17 +354,6 @@ rebuildTargets } | fromFlagOrDefault False (projectConfigOfflineMode config) && not (null packagesToDownload) = return offlineError | otherwise = do - -- Concurrency control: create the job controller and concurrency limits - -- for downloading, building and installing. - mkJobControl <- case buildSettingNumJobs of - Serial -> newSerialJobControl - NumJobs n -> newParallelJobControl (fromMaybe numberOfProcessors n) - UseSem n -> - if jsemSupported compiler - then newSemaphoreJobControl verbosity n - else do - warn verbosity "-jsem is not supported by the selected compiler, falling back to normal parallelism control." - newParallelJobControl n registerLock <- newLock -- serialise registration cacheLock <- newLock -- serialise access to setup exe cache -- TODO: [code cleanup] eliminate setup exe cache @@ -380,7 +368,9 @@ rebuildTargets createDirectoryIfMissingVerbose verbosity True distTempDirectory traverse_ (createPackageDBIfMissing verbosity compiler progdb) packageDBsToUse - bracket (pure mkJobControl) cleanupJobControl $ \jobControl -> do + -- Concurrency control: create the job controller and concurrency limits + -- for downloading, building and installing. + withJobControl (newJobControlFromParStrat verbosity compiler buildSettingNumJobs Nothing) $ \jobControl -> do -- Before traversing the install plan, preemptively find all packages that -- will need to be downloaded and start downloading them. asyncDownloadPackages @@ -391,7 +381,7 @@ rebuildTargets $ \downloadMap -> -- For each package in the plan, in dependency order, but in parallel... InstallPlan.execute - mkJobControl + jobControl keepGoing (BuildFailure Nothing . DependentFailed . packageId) installPlan diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 72328978d2f..eea6b958b70 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -37,6 +37,7 @@ module Distribution.Client.ProjectConfig , writeProjectLocalFreezeConfig , writeProjectConfigFile , commandLineFlagsToProjectConfig + , onlyTopLevelProvenance -- * Packages within projects , ProjectPackageLocation (..) @@ -54,10 +55,14 @@ module Distribution.Client.ProjectConfig , resolveSolverSettings , BuildTimeSettings (..) , resolveBuildTimeSettings + , resolveNumJobsSetting -- * Checking configuration , checkBadPerPackageCompilerPaths , BadPerPackageCompilerPaths (..) + + -- * Globals + , maxNumFetchJobs ) where import Distribution.Client.Compat.Prelude @@ -67,6 +72,7 @@ import Prelude () import Distribution.Client.Glob ( isTrivialRootedGlob ) +import Distribution.Client.JobControl import Distribution.Client.ProjectConfig.Legacy import Distribution.Client.ProjectConfig.Types import Distribution.Client.RebuildMonad @@ -433,12 +439,7 @@ resolveBuildTimeSettings -- buildSettingLogVerbosity -- defined below, more complicated buildSettingBuildReports = fromFlag projectConfigBuildReports buildSettingSymlinkBinDir = flagToList projectConfigSymlinkBinDir - buildSettingNumJobs = - if fromFlag projectConfigUseSemaphore - then UseSem (determineNumJobs projectConfigNumJobs) - else case (determineNumJobs projectConfigNumJobs) of - 1 -> Serial - n -> NumJobs (Just n) + buildSettingNumJobs = resolveNumJobsSetting projectConfigUseSemaphore projectConfigNumJobs buildSettingKeepGoing = fromFlag projectConfigKeepGoing buildSettingOfflineMode = fromFlag projectConfigOfflineMode buildSettingKeepTempFiles = fromFlag projectConfigKeepTempFiles @@ -534,6 +535,20 @@ resolveBuildTimeSettings | isParallelBuild buildSettingNumJobs = False | otherwise = False +-- | Determine the number of jobs (ParStrat) from the project config +resolveNumJobsSetting + :: Flag Bool + -- ^ Whether to use a semaphore (-jsem) + -> Flag (Maybe Int) + -- ^ The number of jobs to run concurrently + -> ParStratX Int +resolveNumJobsSetting projectConfigUseSemaphore projectConfigNumJobs = + if fromFlag projectConfigUseSemaphore + then UseSem (determineNumJobs projectConfigNumJobs) + else case (determineNumJobs projectConfigNumJobs) of + 1 -> Serial + n -> NumJobs (Just n) + --------------------------------------------- -- Reading and writing project config files -- @@ -1212,6 +1227,7 @@ mplusMaybeT ma mb = do fetchAndReadSourcePackages :: Verbosity -> DistDirLayout + -> Compiler -> ProjectConfigShared -> ProjectConfigBuildOnly -> [ProjectPackageLocation] @@ -1219,6 +1235,7 @@ fetchAndReadSourcePackages fetchAndReadSourcePackages verbosity distDirLayout + compiler projectConfigShared projectConfigBuildOnly pkgLocations = do @@ -1255,7 +1272,9 @@ fetchAndReadSourcePackages syncAndReadSourcePackagesRemoteRepos verbosity distDirLayout + compiler projectConfigShared + projectConfigBuildOnly (fromFlag (projectConfigOfflineMode projectConfigBuildOnly)) [repo | ProjectPackageRemoteRepo repo <- pkgLocations] @@ -1372,16 +1391,23 @@ fetchAndReadSourcePackageRemoteTarball syncAndReadSourcePackagesRemoteRepos :: Verbosity -> DistDirLayout + -> Compiler -> ProjectConfigShared + -> ProjectConfigBuildOnly -> Bool -> [SourceRepoList] -> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)] syncAndReadSourcePackagesRemoteRepos verbosity DistDirLayout{distDownloadSrcDirectory} + compiler ProjectConfigShared { projectConfigProgPathExtra } + ProjectConfigBuildOnly + { projectConfigUseSemaphore + , projectConfigNumJobs + } offlineMode repos = do repos' <- @@ -1407,10 +1433,15 @@ syncAndReadSourcePackagesRemoteRepos in configureVCS verbosity progPathExtra vcs concat - <$> sequenceA - [ rerunIfChanged verbosity monitor repoGroup' $ do - vcs' <- getConfiguredVCS repoType - syncRepoGroupAndReadSourcePackages vcs' pathStem repoGroup' + <$> rerunConcurrentlyIfChanged + verbosity + (newJobControlFromParStrat verbosity compiler parStrat (Just maxNumFetchJobs)) + [ ( monitor + , repoGroup' + , do + vcs' <- getConfiguredVCS repoType + syncRepoGroupAndReadSourcePackages vcs' pathStem repoGroup' + ) | repoGroup@((primaryRepo, repoType) : _) <- Map.elems reposByLocation , let repoGroup' = map fst repoGroup pathStem = @@ -1423,6 +1454,7 @@ syncAndReadSourcePackagesRemoteRepos monitor = newFileMonitor (pathStem <.> "cache") ] where + parStrat = resolveNumJobsSetting projectConfigUseSemaphore projectConfigNumJobs syncRepoGroupAndReadSourcePackages :: VCS ConfiguredProgram -> FilePath @@ -1753,3 +1785,16 @@ checkBadPerPackageCompilerPaths compilerPrograms packagesConfig = ] of [] -> return () ps -> throwIO (BadPerPackageCompilerPaths ps) + +-- | Filter out non-top-level project configs. +onlyTopLevelProvenance :: Set ProjectConfigProvenance -> Set ProjectConfigProvenance +onlyTopLevelProvenance = Set.filter $ \case + Implicit -> False + Explicit ps -> isTopLevelConfigPath ps + +-- | The maximum amount of fetch jobs that can run concurrently. +-- For instance, this is used to limit the amount of concurrent downloads from +-- hackage, or the amount of concurrent git clones for +-- source-repository-package stanzas. +maxNumFetchJobs :: Int +maxNumFetchJobs = 2 diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 7354e5e9cb3..49720fdd8ea 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -206,12 +206,10 @@ type ProjectConfigSkeleton = CondTree ConfVar [ProjectConfigPath] ProjectConfig singletonProjectConfigSkeleton :: ProjectConfig -> ProjectConfigSkeleton singletonProjectConfigSkeleton x = CondNode x mempty mempty -instantiateProjectConfigSkeletonFetchingCompiler :: Monad m => m (OS, Arch, CompilerInfo) -> FlagAssignment -> ProjectConfigSkeleton -> m ProjectConfig -instantiateProjectConfigSkeletonFetchingCompiler fetch flags skel - | null (toListOf traverseCondTreeV skel) = pure $ fst (ignoreConditions skel) - | otherwise = do - (os, arch, impl) <- fetch - pure $ instantiateProjectConfigSkeletonWithCompiler os arch impl flags skel +instantiateProjectConfigSkeletonFetchingCompiler :: (OS, Arch, CompilerInfo) -> FlagAssignment -> ProjectConfigSkeleton -> ProjectConfig +instantiateProjectConfigSkeletonFetchingCompiler (os, arch, impl) flags skel + | null (toListOf traverseCondTreeV skel) = fst (ignoreConditions skel) + | otherwise = instantiateProjectConfigSkeletonWithCompiler os arch impl flags skel instantiateProjectConfigSkeletonWithCompiler :: OS -> Arch -> CompilerInfo -> FlagAssignment -> ProjectConfigSkeleton -> ProjectConfig instantiateProjectConfigSkeletonWithCompiler os arch impl _flags skel = go $ mapTreeConds (fst . simplifyWithSysParams os arch impl) skel diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index a0a978bd634..ccace6f8025 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -195,6 +195,7 @@ import Distribution.Backpack.LinkedComponent import Distribution.Backpack.ModuleShape import Distribution.Simple.Utils +import Distribution.Verbosity import Distribution.Version import qualified Distribution.InstalledPackageInfo as IPI @@ -384,26 +385,25 @@ rebuildProjectConfig $ do liftIO $ info verbosity "Project settings changed, reconfiguring..." projectConfigSkeleton <- phaseReadProjectConfig - let fetchCompiler = do - -- have to create the cache directory before configuring the compiler - liftIO $ createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory - (compiler, Platform arch os, _) <- configureCompiler verbosity distDirLayout (fst (PD.ignoreConditions projectConfigSkeleton) <> cliConfig) - pure (os, arch, compilerInfo compiler) - projectConfig <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectConfigSkeleton + -- have to create the cache directory before configuring the compiler + liftIO $ createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory + (compiler, Platform arch os, _) <- configureCompiler verbosity distDirLayout (fst (PD.ignoreConditions projectConfigSkeleton) <> cliConfig) + + let projectConfig = instantiateProjectConfigSkeletonFetchingCompiler (os, arch, compilerInfo compiler) mempty projectConfigSkeleton when (projectConfigDistDir (projectConfigShared $ projectConfig) /= NoFlag) $ liftIO $ warn verbosity "The builddir option is not supported in project and config files. It will be ignored." - localPackages <- phaseReadLocalPackages (projectConfig <> cliConfig) + localPackages <- phaseReadLocalPackages compiler (projectConfig <> cliConfig) return (projectConfig, localPackages) - sequence_ - [ do - notice verbosity . render . vcat $ - text "Configuration is affected by the following files:" - : [text "-" <+> docProjectConfigPath path] - | Explicit path <- Set.toList $ projectConfigProvenance projectConfig - ] + let configfiles = + [ text "-" <+> docProjectConfigPath path + | Explicit path <- Set.toList . (if verbosity >= verbose then id else onlyTopLevelProvenance) $ projectConfigProvenance projectConfig + ] + unless (null configfiles) $ + notice (verboseStderr verbosity) . render . vcat $ + text "Configuration is affected by the following files:" : configfiles return (projectConfig <> cliConfig, localPackages) where @@ -426,9 +426,11 @@ rebuildProjectConfig -- NOTE: These are all packages mentioned in the project configuration. -- Whether or not they will be considered local to the project will be decided by `shouldBeLocal`. phaseReadLocalPackages - :: ProjectConfig + :: Compiler + -> ProjectConfig -> Rebuild [PackageSpecifier UnresolvedSourcePackage] phaseReadLocalPackages + compiler projectConfig@ProjectConfig { projectConfigShared , projectConfigBuildOnly @@ -443,6 +445,7 @@ rebuildProjectConfig fetchAndReadSourcePackages verbosity distDirLayout + compiler projectConfigShared projectConfigBuildOnly pkgLocations diff --git a/cabal-install/src/Distribution/Client/RebuildMonad.hs b/cabal-install/src/Distribution/Client/RebuildMonad.hs index 2950d9f7a30..e6450addabc 100644 --- a/cabal-install/src/Distribution/Client/RebuildMonad.hs +++ b/cabal-install/src/Distribution/Client/RebuildMonad.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} -- | An abstraction for re-running actions if values or files have changed. @@ -42,6 +43,7 @@ module Distribution.Client.RebuildMonad , FileMonitor (..) , newFileMonitor , rerunIfChanged + , rerunConcurrentlyIfChanged -- * Utils , delayInitSharedResource @@ -64,11 +66,13 @@ import Prelude () import Distribution.Client.FileMonitor import Distribution.Client.Glob hiding (matchFileGlob) import qualified Distribution.Client.Glob as Glob (matchFileGlob) +import Distribution.Client.JobControl import Distribution.Simple.PreProcess.Types (Suffix (..)) import Distribution.Simple.Utils (debug) import Control.Concurrent.MVar (MVar, modifyMVar, newMVar) +import Control.Monad import Control.Monad.Reader as Reader import Control.Monad.State as State import qualified Data.Map.Strict as Map @@ -123,39 +127,61 @@ rerunIfChanged -> Rebuild b -> Rebuild b rerunIfChanged verbosity monitor key action = do + -- rerunIfChanged is implemented in terms of rerunConcurrentlyIfChanged, but + -- nothing concurrent will happen since the list of concurrent actions has a + -- single value that will be waited for alone. + rerunConcurrentlyIfChanged verbosity newSerialJobControl [(monitor, key, action)] >>= \case + [x] -> return x + _ -> error "rerunIfChanged: impossible!" + +-- | Like 'rerunIfChanged' meets 'mapConcurrently': For when we want multiple actions +-- that need to do be re-run-if-changed asynchronously. The function returns +-- when all values have finished computing. +rerunConcurrentlyIfChanged + :: (Binary a, Structured a, Binary b, Structured b) + => Verbosity + -> IO (JobControl IO (b, [MonitorFilePath])) + -> [(FileMonitor a b, a, Rebuild b)] + -> Rebuild [b] +rerunConcurrentlyIfChanged verbosity mkJobControl triples = do rootDir <- askRoot - changed <- liftIO $ checkFileMonitorChanged monitor rootDir key - case changed of - MonitorUnchanged result files -> do - liftIO $ - debug verbosity $ - "File monitor '" - ++ monitorName - ++ "' unchanged." - monitorFiles files - return result - MonitorChanged reason -> do - liftIO $ - debug verbosity $ - "File monitor '" - ++ monitorName - ++ "' changed: " - ++ showReason reason - startTime <- liftIO $ beginUpdateFileMonitor - (result, files) <- liftIO $ unRebuild rootDir action - liftIO $ - updateFileMonitor - monitor - rootDir - (Just startTime) - files - key - result - monitorFiles files - return result - where - monitorName = takeFileName (fileMonitorCacheFile monitor) + dacts <- forM triples $ \(monitor, key, action) -> do + let monitorName = takeFileName (fileMonitorCacheFile monitor) + changed <- liftIO $ checkFileMonitorChanged monitor rootDir key + case changed of + MonitorUnchanged result files -> do + liftIO $ + debug verbosity $ + "File monitor '" + ++ monitorName + ++ "' unchanged." + monitorFiles files + return (return (result, [])) + MonitorChanged reason -> do + liftIO $ + debug verbosity $ + "File monitor '" + ++ monitorName + ++ "' changed: " + ++ showReason reason + return $ do + startTime <- beginUpdateFileMonitor + (result, files) <- unRebuild rootDir action + updateFileMonitor + monitor + rootDir + (Just startTime) + files + key + result + return (result, files) + (results, files) <- liftIO $ + withJobControl mkJobControl $ \jobControl -> do + unzip <$> mapConcurrentWithJobs jobControl id dacts + monitorFiles (concat files) + return results + where showReason (MonitoredFileChanged file) = "file " ++ file showReason (MonitoredValueChanged _) = "monitor value changed" showReason MonitorFirstRun = "first run" diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index d4f152a4557..95db58bc8c1 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -381,7 +381,7 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags{..} targetStrings glo createDirectoryIfMissingVerbose verbosity True (distProjectCacheDirectory $ distDirLayout ctx) (compiler, platform@(Platform arch os), _) <- runRebuild projectRoot $ configureCompiler verbosity (distDirLayout ctx) (fst (ignoreConditions projectCfgSkeleton) <> projectConfig ctx) - projectCfg <- instantiateProjectConfigSkeletonFetchingCompiler (pure (os, arch, compilerInfo compiler)) mempty projectCfgSkeleton + let projectCfg = instantiateProjectConfigSkeletonFetchingCompiler (os, arch, compilerInfo compiler) mempty projectCfgSkeleton let ctx' = ctx & lProjectConfig %~ (<> projectCfg) diff --git a/cabal-install/src/Distribution/Client/VCS.hs b/cabal-install/src/Distribution/Client/VCS.hs index 57c0a82376e..029e190a790 100644 --- a/cabal-install/src/Distribution/Client/VCS.hs +++ b/cabal-install/src/Distribution/Client/VCS.hs @@ -483,6 +483,9 @@ vcsGit = resetArgs tag = "reset" : verboseArg ++ ["--hard", tag, "--"] verboseArg = ["--quiet" | verbosity < Verbosity.normal] + -- Note: No --depth=1 for vcsCloneRepo since that is used for `cabal get -s`, + -- whereas `vcsSyncRepo` is used for source-repository-package where we do want shallow clones. + vcsSyncRepos :: Verbosity -> ConfiguredProgram @@ -529,7 +532,10 @@ vcsGit = (removePathForcibly gitModulesDir) (\e -> if isPermissionError e then removePathForcibly gitModulesDir else throw e) else removeDirectoryRecursive gitModulesDir - git localDir resetArgs + when (resetTarget /= "HEAD") $ do + git localDir fetchArgs -- first fetch the tag if needed + git localDir setTagArgs + git localDir resetArgs -- only then reset to the commit git localDir $ ["submodule", "sync", "--recursive"] ++ verboseArg git localDir $ ["submodule", "update", "--force", "--init", "--recursive"] ++ verboseArg git localDir $ ["submodule", "foreach", "--recursive"] ++ verboseArg ++ ["git clean -ffxdq"] @@ -543,13 +549,20 @@ vcsGit = } cloneArgs = - ["clone", "--no-checkout", loc, localDir] + ["clone", "--depth=1", "--no-checkout", loc, localDir] ++ case peer of Nothing -> [] Just peerLocalDir -> ["--reference", peerLocalDir] ++ verboseArg where loc = srpLocation + -- To checkout/reset to a particular commit, we must first fetch it + -- (since the base clone is shallow). + fetchArgs = "fetch" : verboseArg ++ ["origin", resetTarget] + -- And then create the Tag from the FETCH_HEAD (which we should have just fetched) + setTagArgs = ["tag", "-f", resetTarget, "FETCH_HEAD"] + -- Then resetting to that tag will work (if we don't create the tag + -- locally from FETCH_HEAD, it won't exist). resetArgs = "reset" : verboseArg ++ ["--hard", resetTarget, "--"] resetTarget = fromMaybe "HEAD" (srpBranch `mplus` srpTag) verboseArg = ["--quiet" | verbosity < Verbosity.normal] diff --git a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs b/cabal-install/src/Distribution/Deprecated/ParseUtils.hs index e1d389ac9aa..4743213fde9 100644 --- a/cabal-install/src/Distribution/Deprecated/ParseUtils.hs +++ b/cabal-install/src/Distribution/Deprecated/ParseUtils.hs @@ -91,6 +91,7 @@ data PError = AmbiguousParse String LineNo | NoParse String LineNo | TabsError LineNo + | FieldShouldBeStanza String LineNo | FromString String (Maybe LineNo) deriving (Eq, Show) @@ -186,6 +187,10 @@ locatedErrorMsg (NoParse f n) = , "Parse of field '" ++ f ++ "' failed." ) locatedErrorMsg (TabsError n) = (Just n, "Tab used as indentation.") +locatedErrorMsg (FieldShouldBeStanza name lineNumber) = + ( Just lineNumber + , "'" ++ name ++ "' is a stanza, not a field. Remove the trailing ':' to parse a stanza." + ) locatedErrorMsg (FromString s n) = (n, s) syntaxError :: LineNo -> String -> ParseResult a diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out index be9a79bbc22..c2690ee4366 100644 --- a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.out @@ -3,7 +3,6 @@ Downloading the latest package list from test-local-repo # cabal v2-run Configuration is affected by the following files: - cabal.project -Configuration is affected by the following files: - extra.project imported by: cabal.project Resolving dependencies... @@ -70,9 +69,7 @@ cyclical import of cyclical-2-out-out-self-b.config; Configuration is affected by the following files: - noncyclical-same-filename-a.config imported by: noncyclical-same-filename-a.project -Configuration is affected by the following files: - noncyclical-same-filename-a.project -Configuration is affected by the following files: - same-filename/noncyclical-same-filename-a.config imported by: noncyclical-same-filename-a.config imported by: noncyclical-same-filename-a.project @@ -89,9 +86,7 @@ Configuration is affected by the following files: - noncyclical-same-filename-b.config imported by: same-filename/noncyclical-same-filename-b.config imported by: noncyclical-same-filename-b.project -Configuration is affected by the following files: - noncyclical-same-filename-b.project -Configuration is affected by the following files: - same-filename/noncyclical-same-filename-b.config imported by: noncyclical-same-filename-b.project Up to date @@ -126,17 +121,14 @@ cyclical import of cyclical-same-filename-out-out-back.config; # cabal v2-build Configuration is affected by the following files: - hops-0.project -Configuration is affected by the following files: - hops-2.config imported by: hops/hops-1.config imported by: hops-0.project -Configuration is affected by the following files: - hops-4.config imported by: hops/hops-3.config imported by: hops-2.config imported by: hops/hops-1.config imported by: hops-0.project -Configuration is affected by the following files: - hops-6.config imported by: hops/hops-5.config imported by: hops-4.config @@ -144,7 +136,6 @@ Configuration is affected by the following files: imported by: hops-2.config imported by: hops/hops-1.config imported by: hops-0.project -Configuration is affected by the following files: - hops-8.config imported by: hops/hops-7.config imported by: hops-6.config @@ -154,22 +145,18 @@ Configuration is affected by the following files: imported by: hops-2.config imported by: hops/hops-1.config imported by: hops-0.project -Configuration is affected by the following files: - hops/hops-1.config imported by: hops-0.project -Configuration is affected by the following files: - hops/hops-3.config imported by: hops-2.config imported by: hops/hops-1.config imported by: hops-0.project -Configuration is affected by the following files: - hops/hops-5.config imported by: hops-4.config imported by: hops/hops-3.config imported by: hops-2.config imported by: hops/hops-1.config imported by: hops-0.project -Configuration is affected by the following files: - hops/hops-7.config imported by: hops-6.config imported by: hops/hops-5.config @@ -178,7 +165,6 @@ Configuration is affected by the following files: imported by: hops-2.config imported by: hops/hops-1.config imported by: hops-0.project -Configuration is affected by the following files: - hops/hops-9.config imported by: hops-8.config imported by: hops/hops-7.config @@ -194,17 +180,14 @@ Up to date # cabal v2-build Configuration is affected by the following files: - oops-0.project -Configuration is affected by the following files: - oops-2.config imported by: oops/oops-1.config imported by: oops-0.project -Configuration is affected by the following files: - oops-4.config imported by: oops/oops-3.config imported by: oops-2.config imported by: oops/oops-1.config imported by: oops-0.project -Configuration is affected by the following files: - oops-6.config imported by: oops/oops-5.config imported by: oops-4.config @@ -212,7 +195,6 @@ Configuration is affected by the following files: imported by: oops-2.config imported by: oops/oops-1.config imported by: oops-0.project -Configuration is affected by the following files: - oops-8.config imported by: oops/oops-7.config imported by: oops-6.config @@ -222,22 +204,18 @@ Configuration is affected by the following files: imported by: oops-2.config imported by: oops/oops-1.config imported by: oops-0.project -Configuration is affected by the following files: - oops/oops-1.config imported by: oops-0.project -Configuration is affected by the following files: - oops/oops-3.config imported by: oops-2.config imported by: oops/oops-1.config imported by: oops-0.project -Configuration is affected by the following files: - oops/oops-5.config imported by: oops-4.config imported by: oops/oops-3.config imported by: oops-2.config imported by: oops/oops-1.config imported by: oops-0.project -Configuration is affected by the following files: - oops/oops-7.config imported by: oops-6.config imported by: oops/oops-5.config @@ -246,7 +224,6 @@ Configuration is affected by the following files: imported by: oops-2.config imported by: oops/oops-1.config imported by: oops-0.project -Configuration is affected by the following files: - oops/oops-9.config imported by: oops-8.config imported by: oops/oops-7.config @@ -277,6 +254,131 @@ Could not resolve dependencies: (constraint from oops-0.project requires ==1.4.3.0) [__1] fail (backjumping, conflict set: hashable, oops) After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: hashable (3), oops (2) +# checking if we detect when the same config is imported via many different paths (we don't) +# cabal v2-build +Configuration is affected by the following files: +- yops-0.project +- yops-2.config + imported by: yops/yops-1.config + imported by: yops-0.project +- yops-4.config + imported by: yops/yops-3.config + imported by: yops-0.project +- yops-4.config + imported by: yops/yops-3.config + imported by: yops-2.config + imported by: yops/yops-1.config + imported by: yops-0.project +- yops-6.config + imported by: yops/yops-5.config + imported by: yops-0.project +- yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-0.project +- yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-2.config + imported by: yops/yops-1.config + imported by: yops-0.project +- yops-8.config + imported by: yops/yops-7.config + imported by: yops-0.project +- yops-8.config + imported by: yops/yops-7.config + imported by: yops-6.config + imported by: yops/yops-5.config + imported by: yops-0.project +- yops-8.config + imported by: yops/yops-7.config + imported by: yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-0.project +- yops-8.config + imported by: yops/yops-7.config + imported by: yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-2.config + imported by: yops/yops-1.config + imported by: yops-0.project +- yops/yops-1.config + imported by: yops-0.project +- yops/yops-3.config + imported by: yops-0.project +- yops/yops-3.config + imported by: yops-2.config + imported by: yops/yops-1.config + imported by: yops-0.project +- yops/yops-5.config + imported by: yops-0.project +- yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-0.project +- yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-2.config + imported by: yops/yops-1.config + imported by: yops-0.project +- yops/yops-7.config + imported by: yops-0.project +- yops/yops-7.config + imported by: yops-6.config + imported by: yops/yops-5.config + imported by: yops-0.project +- yops/yops-7.config + imported by: yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-0.project +- yops/yops-7.config + imported by: yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-2.config + imported by: yops/yops-1.config + imported by: yops-0.project +- yops/yops-9.config + imported by: yops-0.project +- yops/yops-9.config + imported by: yops-8.config + imported by: yops/yops-7.config + imported by: yops-0.project +- yops/yops-9.config + imported by: yops-8.config + imported by: yops/yops-7.config + imported by: yops-6.config + imported by: yops/yops-5.config + imported by: yops-0.project +- yops/yops-9.config + imported by: yops-8.config + imported by: yops/yops-7.config + imported by: yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-0.project +- yops/yops-9.config + imported by: yops-8.config + imported by: yops/yops-7.config + imported by: yops-6.config + imported by: yops/yops-5.config + imported by: yops-4.config + imported by: yops/yops-3.config + imported by: yops-2.config + imported by: yops/yops-1.config + imported by: yops-0.project +Up to date # checking bad conditional # cabal v2-build Error: [Cabal-7090] diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs index b5429e39776..67118d362c0 100644 --- a/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs @@ -225,6 +225,39 @@ main = cabalTest . withRepo "repo" . recordMode RecordMarked $ do \ imported by: oops-0.project") oopsing + -- The project is named yops as it is like hops but with y's for forks. + -- +-- yops-0.project + -- +-- yops/yops-1.config + -- +-- yops-2.config + -- +-- yops/yops-3.config + -- +-- yops-4.config + -- +-- yops/yops-5.config + -- +-- yops-6.config + -- +-- yops/yops-7.config + -- +-- yops-8.config + -- +-- yops/yops-9.config (no further imports) + -- +-- yops/yops-3.config + -- +-- yops-4.config + -- +-- yops/yops-5.config + -- +-- yops-6.config + -- +-- yops/yops-7.config + -- +-- yops-8.config + -- +-- yops/yops-9.config (no further imports) + -- +-- yops/yops-5.config + -- +-- yops-6.config + -- +-- yops/yops-7.config + -- +-- yops-8.config + -- +-- yops/yops-9.config (no further imports) + -- +-- yops/yops-7.config + -- +-- yops-8.config + -- +-- yops/yops-9.config (no further imports) + -- +-- yops/yops-9.config (no further imports) + -- + -- We don't check and don't error or warn on the same config being imported + -- via many different paths. + log "checking if we detect when the same config is imported via many different paths (we don't)" + yopping <- cabal' "v2-build" [ "--project-file=yops-0.project" ] + log "checking bad conditional" badIf <- fails $ cabal' "v2-build" [ "--project-file=bad-conditional.project" ] assertOutputContains "Cannot set compiler in a conditional clause of a cabal project file" badIf diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/yops-0.project b/cabal-testsuite/PackageTests/ConditionalAndImport/yops-0.project new file mode 100644 index 00000000000..28f582bab91 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/yops-0.project @@ -0,0 +1,7 @@ +packages: . + +import: yops/yops-1.config +import: yops/yops-3.config +import: yops/yops-5.config +import: yops/yops-7.config +import: yops/yops-9.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/yops-2.config b/cabal-testsuite/PackageTests/ConditionalAndImport/yops-2.config new file mode 100644 index 00000000000..c8535704f13 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/yops-2.config @@ -0,0 +1 @@ +import: yops/yops-3.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/yops-4.config b/cabal-testsuite/PackageTests/ConditionalAndImport/yops-4.config new file mode 100644 index 00000000000..024d1c94d1e --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/yops-4.config @@ -0,0 +1 @@ +import: yops/yops-5.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/yops-6.config b/cabal-testsuite/PackageTests/ConditionalAndImport/yops-6.config new file mode 100644 index 00000000000..4df25a90a59 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/yops-6.config @@ -0,0 +1 @@ +import: yops/yops-7.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/yops-8.config b/cabal-testsuite/PackageTests/ConditionalAndImport/yops-8.config new file mode 100644 index 00000000000..a2d27ab2b16 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/yops-8.config @@ -0,0 +1 @@ +import: yops/yops-9.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-1.config b/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-1.config new file mode 100644 index 00000000000..5ad1fe73bd3 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-1.config @@ -0,0 +1 @@ +import: ../yops-2.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-3.config b/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-3.config new file mode 100644 index 00000000000..6cbaeb3fa87 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-3.config @@ -0,0 +1 @@ +import: ../yops-4.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-5.config b/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-5.config new file mode 100644 index 00000000000..ae0901cedd6 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-5.config @@ -0,0 +1 @@ +import: ../yops-6.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-7.config b/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-7.config new file mode 100644 index 00000000000..18edcb74c20 --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-7.config @@ -0,0 +1 @@ +import: ../yops-8.config diff --git a/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-9.config b/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-9.config new file mode 100644 index 00000000000..61813df4e2c --- /dev/null +++ b/cabal-testsuite/PackageTests/ConditionalAndImport/yops/yops-9.config @@ -0,0 +1 @@ +-- No imports here diff --git a/cabal-testsuite/PackageTests/ExtraProgPath/setup.out b/cabal-testsuite/PackageTests/ExtraProgPath/setup.out index a64476a2939..ed22f251035 100644 --- a/cabal-testsuite/PackageTests/ExtraProgPath/setup.out +++ b/cabal-testsuite/PackageTests/ExtraProgPath/setup.out @@ -1,8 +1,8 @@ # cabal v2-build -Configuration is affected by the following files: -- cabal.project Warning: cannot determine version of /pkg-config : "" +Configuration is affected by the following files: +- cabal.project Resolving dependencies... Error: [Cabal-7107] Could not resolve dependencies: diff --git a/cabal-testsuite/PackageTests/Get/T7248/cabal.out b/cabal-testsuite/PackageTests/Get/T7248/cabal.out index a172b425d4d..0c6e3ce035c 100644 --- a/cabal-testsuite/PackageTests/Get/T7248/cabal.out +++ b/cabal-testsuite/PackageTests/Get/T7248/cabal.out @@ -1,4 +1,6 @@ # cabal get Warning: /cabal.config: Unrecognized stanza on line 3 -Error: [Cabal-7160] -The package list for 'repo.invalid' does not exist. Run 'cabal update' to download it. +Warning: The package list for 'repo.invalid' does not exist. Run 'cabal update' to download it. +Error: [Cabal-7100] +There is no package named 'a-b-s-e-n-t'. +You may need to run 'cabal update' to get the latest list of available packages. diff --git a/cabal-testsuite/PackageTests/NewConfigure/LocalConfigOverwrite/cabal.out b/cabal-testsuite/PackageTests/NewConfigure/LocalConfigOverwrite/cabal.out index a8f7c951277..14c74f590ec 100644 --- a/cabal-testsuite/PackageTests/NewConfigure/LocalConfigOverwrite/cabal.out +++ b/cabal-testsuite/PackageTests/NewConfigure/LocalConfigOverwrite/cabal.out @@ -1,12 +1,10 @@ # cabal v2-configure Configuration is affected by the following files: - cabal.project -Configuration is affected by the following files: - cabal.project.local 'cabal.project.local' already exists, backing it up to 'cabal.project.local~'. # cabal v2-configure Configuration is affected by the following files: - foo.project -Configuration is affected by the following files: - foo.project.local 'foo.project.local' already exists, backing it up to 'foo.project.local~'. diff --git a/cabal-testsuite/PackageTests/NewFreeze/BuildTools/new_freeze.out b/cabal-testsuite/PackageTests/NewFreeze/BuildTools/new_freeze.out index fa90f30f471..9674cd0cc8b 100644 --- a/cabal-testsuite/PackageTests/NewFreeze/BuildTools/new_freeze.out +++ b/cabal-testsuite/PackageTests/NewFreeze/BuildTools/new_freeze.out @@ -18,7 +18,6 @@ Wrote freeze file: /cabal.project.freeze # cabal v2-build Configuration is affected by the following files: - cabal.project -Configuration is affected by the following files: - cabal.project.freeze Resolving dependencies... Build profile: -w ghc- -O1 diff --git a/cabal-testsuite/PackageTests/NewFreeze/Flags/new_freeze.out b/cabal-testsuite/PackageTests/NewFreeze/Flags/new_freeze.out index 84064b158d5..8adf0bf2702 100644 --- a/cabal-testsuite/PackageTests/NewFreeze/Flags/new_freeze.out +++ b/cabal-testsuite/PackageTests/NewFreeze/Flags/new_freeze.out @@ -17,7 +17,6 @@ Wrote freeze file: /cabal.project.freeze # cabal v2-build Configuration is affected by the following files: - cabal.project -Configuration is affected by the following files: - cabal.project.freeze Resolving dependencies... Build profile: -w ghc- -O1 diff --git a/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.out b/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.out index 540a69d4128..f07819538f4 100644 --- a/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.out +++ b/cabal-testsuite/PackageTests/NewFreeze/FreezeFile/new_freeze.out @@ -24,7 +24,6 @@ Wrote freeze file: /cabal.project.freeze # cabal v2-build Configuration is affected by the following files: - cabal.project -Configuration is affected by the following files: - cabal.project.freeze Resolving dependencies... Build profile: -w ghc- -O1 @@ -41,7 +40,6 @@ Building executable 'my-exe' for my-local-package-1.0... # cabal v2-freeze Configuration is affected by the following files: - cabal.project -Configuration is affected by the following files: - cabal.project.freeze Wrote freeze file: /cabal.project.freeze # cabal v2-build diff --git a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out new file mode 100644 index 00000000000..60680b86db3 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.out @@ -0,0 +1,4 @@ +# cabal build +Error: [Cabal-7090] +Error parsing project file /cabal.project:4: +'source-repository-package' is a stanza, not a field. Remove the trailing ':' to parse a stanza. diff --git a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.project b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.project new file mode 100644 index 00000000000..518ac39f5fb --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.project @@ -0,0 +1,6 @@ +packages: . + +-- This is an error; a trailing `:` is syntax for a field, not a stanza! +source-repository-package: + type: git + location: https://github.com/haskell-hvr/Only diff --git a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.test.hs new file mode 100644 index 00000000000..39636819157 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/cabal.test.hs @@ -0,0 +1,6 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + result <- fails $ cabal' "build" [] + assertOutputContains "Error parsing project file" result + assertOutputContains "'source-repository-package' is a stanza, not a field." result diff --git a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/src/MyLib.hs b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/src/MyLib.hs new file mode 100644 index 00000000000..e657c4403f6 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/src/MyLib.hs @@ -0,0 +1,4 @@ +module MyLib (someFunc) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/test.cabal b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/test.cabal new file mode 100644 index 00000000000..86374a457c7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectConfig/FieldStanzaConfusion/test.cabal @@ -0,0 +1,13 @@ +cabal-version: 3.0 +name: test +version: 0.1.0.0 +license: NONE +author: rbt@sent.as +maintainer: Rebecca Turner +build-type: Simple + +library + exposed-modules: MyLib + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/RelativePathProjectImports/cabal.out b/cabal-testsuite/PackageTests/RelativePathProjectImports/cabal.out index d5870b1955b..10c4953236f 100644 --- a/cabal-testsuite/PackageTests/RelativePathProjectImports/cabal.out +++ b/cabal-testsuite/PackageTests/RelativePathProjectImports/cabal.out @@ -1,7 +1,6 @@ # cabal build Configuration is affected by the following files: - cabal.project -Configuration is affected by the following files: - dep/cabal.project imported by: cabal.project Resolving dependencies... @@ -22,7 +21,6 @@ Building library for main-0.1... # cabal build Configuration is affected by the following files: - cabal.project -Configuration is affected by the following files: - dep/cabal.project imported by: cabal.project Resolving dependencies... diff --git a/cabal-testsuite/PackageTests/VersionPriority/1-local.out b/cabal-testsuite/PackageTests/VersionPriority/1-local.out index 1806aebd5a8..acca1619534 100644 --- a/cabal-testsuite/PackageTests/VersionPriority/1-local.out +++ b/cabal-testsuite/PackageTests/VersionPriority/1-local.out @@ -3,7 +3,6 @@ Downloading the latest package list from test-local-repo # cabal v2-build Configuration is affected by the following files: - 1-local-constraints-import.project -Configuration is affected by the following files: - stackage-local.config imported by: 1-local-constraints-import.project Resolving dependencies... @@ -21,7 +20,6 @@ After searching the rest of the dependency tree exhaustively, these were the goa # cabal v2-build Configuration is affected by the following files: - 1-local-import-constraints.project -Configuration is affected by the following files: - stackage-local.config imported by: 1-local-import-constraints.project Resolving dependencies... diff --git a/cabal-testsuite/PackageTests/VersionPriority/1-web.out b/cabal-testsuite/PackageTests/VersionPriority/1-web.out index 13e930c943b..f7ca5a23be8 100644 --- a/cabal-testsuite/PackageTests/VersionPriority/1-web.out +++ b/cabal-testsuite/PackageTests/VersionPriority/1-web.out @@ -3,10 +3,8 @@ Downloading the latest package list from test-local-repo # cabal v2-build Configuration is affected by the following files: - 1-web-constraints-import.project -Configuration is affected by the following files: - project-stackage/nightly-2023-12-07.config imported by: 1-web-constraints-import.project -Configuration is affected by the following files: - with-ghc.config imported by: 1-web-constraints-import.project Resolving dependencies... @@ -24,10 +22,8 @@ After searching the rest of the dependency tree exhaustively, these were the goa # cabal v2-build Configuration is affected by the following files: - 1-web-import-constraints.project -Configuration is affected by the following files: - project-stackage/nightly-2023-12-07.config imported by: 1-web-import-constraints.project -Configuration is affected by the following files: - with-ghc.config imported by: 1-web-import-constraints.project Resolving dependencies... diff --git a/cabal-testsuite/PackageTests/VersionPriority/2-local.out b/cabal-testsuite/PackageTests/VersionPriority/2-local.out index 211c4ee9d9c..bf3ae4cb27c 100644 --- a/cabal-testsuite/PackageTests/VersionPriority/2-local.out +++ b/cabal-testsuite/PackageTests/VersionPriority/2-local.out @@ -3,10 +3,8 @@ Downloading the latest package list from test-local-repo # cabal v2-build Configuration is affected by the following files: - 2-local-constraints-import.project -Configuration is affected by the following files: - hop-local.config imported by: 2-local-constraints-import.project -Configuration is affected by the following files: - stackage-local.config imported by: hop-local.config imported by: 2-local-constraints-import.project @@ -26,10 +24,8 @@ After searching the rest of the dependency tree exhaustively, these were the goa # cabal v2-build Configuration is affected by the following files: - 2-local-import-constraints.project -Configuration is affected by the following files: - hop-local.config imported by: 2-local-import-constraints.project -Configuration is affected by the following files: - stackage-local.config imported by: hop-local.config imported by: 2-local-import-constraints.project diff --git a/cabal-testsuite/PackageTests/VersionPriority/2-web.out b/cabal-testsuite/PackageTests/VersionPriority/2-web.out index d592a88a472..17bc5a01962 100644 --- a/cabal-testsuite/PackageTests/VersionPriority/2-web.out +++ b/cabal-testsuite/PackageTests/VersionPriority/2-web.out @@ -3,14 +3,11 @@ Downloading the latest package list from test-local-repo # cabal v2-build Configuration is affected by the following files: - 2-web-constraints-import.project -Configuration is affected by the following files: - project-stackage/nightly-2023-12-07.config imported by: stackage-web.config imported by: 2-web-constraints-import.project -Configuration is affected by the following files: - stackage-web.config imported by: 2-web-constraints-import.project -Configuration is affected by the following files: - with-ghc.config imported by: 2-web-constraints-import.project Resolving dependencies... @@ -29,14 +26,11 @@ After searching the rest of the dependency tree exhaustively, these were the goa # cabal v2-build Configuration is affected by the following files: - 2-web-import-constraints.project -Configuration is affected by the following files: - project-stackage/nightly-2023-12-07.config imported by: stackage-web.config imported by: 2-web-import-constraints.project -Configuration is affected by the following files: - stackage-web.config imported by: 2-web-import-constraints.project -Configuration is affected by the following files: - with-ghc.config imported by: 2-web-import-constraints.project Resolving dependencies... diff --git a/cabal-testsuite/PackageTests/VersionPriority/3-web.out b/cabal-testsuite/PackageTests/VersionPriority/3-web.out index 9f26901c50a..d9eee435ab1 100644 --- a/cabal-testsuite/PackageTests/VersionPriority/3-web.out +++ b/cabal-testsuite/PackageTests/VersionPriority/3-web.out @@ -3,19 +3,15 @@ Downloading the latest package list from test-local-repo # cabal v2-build Configuration is affected by the following files: - 3-web-constraints-import.project -Configuration is affected by the following files: - hop-web.config imported by: 3-web-constraints-import.project -Configuration is affected by the following files: - project-stackage/nightly-2023-12-07.config imported by: stackage-web.config imported by: hop-web.config imported by: 3-web-constraints-import.project -Configuration is affected by the following files: - stackage-web.config imported by: hop-web.config imported by: 3-web-constraints-import.project -Configuration is affected by the following files: - with-ghc.config imported by: 3-web-constraints-import.project Resolving dependencies... @@ -35,19 +31,15 @@ After searching the rest of the dependency tree exhaustively, these were the goa # cabal v2-build Configuration is affected by the following files: - 3-web-import-constraints.project -Configuration is affected by the following files: - hop-web.config imported by: 3-web-import-constraints.project -Configuration is affected by the following files: - project-stackage/nightly-2023-12-07.config imported by: stackage-web.config imported by: hop-web.config imported by: 3-web-import-constraints.project -Configuration is affected by the following files: - stackage-web.config imported by: hop-web.config imported by: 3-web-import-constraints.project -Configuration is affected by the following files: - with-ghc.config imported by: 3-web-import-constraints.project Resolving dependencies... diff --git a/cabal-testsuite/README.md b/cabal-testsuite/README.md index 73b39d56801..2c3d17e6150 100644 --- a/cabal-testsuite/README.md +++ b/cabal-testsuite/README.md @@ -1,18 +1,21 @@ cabal-testsuite is a suite of integration tests for Cabal-based frameworks. -How to run ----------- +# How to run 1. Build `cabal-testsuite` (`cabal build cabal-testsuite:cabal-tests`) 2. Run the `cabal-tests` executable. It will scan for all tests in your current directory and subdirectories and run them. - To run a specific set of tests, use `cabal-tests --with-cabal=CABALBIN PATH ...`. - (e.g. `cabal run cabal-testsuite:cabal-tests -- --with-cabal=cabal cabal-testsuite/PackageTests/TestOptions/setup.test.hs`) - You can control parallelism using the `-j` flag. There are a few useful flags: +* To run a specific set of tests, pass the path to a `.test.hs` file to run or + use the `-p`/`--pattern` flag to filter tests. + + See the ["Selecting tests"](#selecting-tests) section below for more details. + +* `-j INT` controls the number of threads used for running tests. + * `--with-cabal PATH` can be used to specify the path of a `cabal-install` executable. IF YOU DO NOT SPECIFY THIS FLAG, CABAL INSTALL TESTS WILL NOT RUN. @@ -28,6 +31,28 @@ There are a few useful flags: * `--keep-tmp-files` can be used to keep the temporary directories that tests are run in. +## Selecting tests + +To run a specific set of tests, use `cabal-tests --with-cabal=CABALBIN PATH ...`, e.g.: + +``` +cabal run cabal-testsuite:cabal-tests -- \ + --with-cabal=cabal \ + cabal-testsuite/PackageTests/TestOptions/setup.test.hs +``` + +Alternatively, use `-p`/`--pattern` to select tests dynamically: + +``` +cabal run cabal-testsuite:cabal-tests -- \ + --with-cabal=cabal \ + --pattern "/TestOptions/" +``` + +See [the documentation for Tasty pattern +syntax](https://hackage.haskell.org/package/tasty#patterns) for more +information. + ## Which Cabal library version do cabal-install tests use? By default the `cabal-install` tests will use the `Cabal` library which comes with @@ -74,8 +99,7 @@ components have broken doctests our CI currently checks that `Cabal-syntax` and `Cabal` doctests pass via `make doctest-install && make doctest` (you can use this `make`-based workflow too). -How to write ------------- +# How to write If you learn better by example, just look at the tests that live in `cabal-testsuite/PackageTests`; if you `git log -p`, you can @@ -155,8 +179,7 @@ allow multiple tests to be defined in one file but run in parallel; at the moment, these just indicate long running tests that should be run early (to avoid straggling). -Frequently asked questions --------------------------- +# Frequently asked questions For all of these answers, to see examples of the functions in question, grep the test suite. @@ -223,8 +246,7 @@ long before editing a file, in order for file system timestamp resolution to pick it up. Use `withDelay` and `delay` prior to making a modification. -Hermetic tests --------------- +# Hermetic tests Tests are run in a fresh temporary system directory. This attempts to isolate the tests from anything specific to do with your directory structure. In particular @@ -235,8 +257,7 @@ tests from anything specific to do with your directory structure. In particular * You must `git add` all files which are relevant to the test, otherwise they will not be copied. -Design notes ------------- +# Design notes This is the second rewrite of the integration testing framework. The primary goal was to use Haskell as the test language (letting us take @@ -296,8 +317,7 @@ figure out how to get out the threading setting, and then spawn that many GHCi servers to service the running threads. Improvements welcome. -Expect tests ------------- +# Expect tests An expect test (aka _golden test_) is a test where we read out the output of the test @@ -366,8 +386,7 @@ Some other notes: on the output for the string you're looking for. Try to be deterministic, but sometimes it's not (easily) possible. -Non-goals ---------- +# Non-goals Here are some things we do not currently plan on supporting: diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 7de6a531115..0f3383af38a 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -105,6 +105,8 @@ executable cabal-tests -- dependencies specific to exe:cabal-tests , clock ^>= 0.7.2 || ^>=0.8 , directory + , tasty + , containers build-tool-depends: cabal-testsuite:setup default-extensions: TypeOperators diff --git a/cabal-testsuite/main/cabal-tests.hs b/cabal-testsuite/main/cabal-tests.hs index 4ffdadd4352..d0d61e62a9f 100644 --- a/cabal-testsuite/main/cabal-tests.hs +++ b/cabal-testsuite/main/cabal-tests.hs @@ -23,7 +23,19 @@ import Control.Exception import Control.Monad import GHC.Conc (numCapabilities) import Data.List +import Data.Proxy (Proxy(Proxy)) +import qualified Data.Sequence as Seq (fromList) import Text.Printf +import qualified Test.Tasty.Options as Tasty + ( OptionSet + , OptionDescription (Option) + , lookupOption + ) +import qualified Test.Tasty.Runners as Tasty + ( optionParser + , TestPattern + , testPatternMatches + ) import qualified System.Clock as Clock import System.IO import System.FilePath @@ -72,7 +84,8 @@ data MainArgs = MainArgs { mainArgQuiet :: Bool, mainArgDistDir :: Maybe FilePath, mainArgCabalSpec :: Maybe CabalLibSpec, - mainCommonArgs :: CommonArgs + mainCommonArgs :: CommonArgs, + mainTastyArgs :: Tasty.OptionSet } data CabalLibSpec = BootCabalLib | InTreeCabalLib FilePath FilePath | SpecificCabalLib String FilePath @@ -117,6 +130,17 @@ mainArgParser = MainArgs <> metavar "DIR")) <*> optional cabalLibSpecParser <*> commonArgParser + <*> tastyArgParser + +tastyArgParser :: Parser Tasty.OptionSet +tastyArgParser = + let (warnings, parser) = + Tasty.optionParser + [ Tasty.Option (Proxy @Tasty.TestPattern) + ] + in if null warnings + then parser + else error $ unlines ("Failed to create parser for Tasty CLI options:" : warnings) -- Unpack and build a specific released version of Cabal and Cabal-syntax libraries buildCabalLibsProject :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO [FilePath] @@ -184,6 +208,7 @@ main = do -- Parse arguments. N.B. 'helper' adds the option `--help`. args <- execParser $ info (mainArgParser <**> helper) mempty let verbosity = if mainArgVerbose args then verbose else normal + testPattern = Tasty.lookupOption @Tasty.TestPattern (mainTastyArgs args) pkg_dbs <- -- Not path to cabal-install so we're not going to run cabal-install tests so we @@ -264,7 +289,7 @@ main = do -- NB: getDirectoryContentsRecursive is lazy IO, but it -- doesn't handle directories disappearing gracefully. Fix -- this! - (single_tests, multi_tests) <- evaluate (partitionTests test_scripts) + (single_tests, multi_tests) <- evaluate (partitionTests testPattern test_scripts) let all_tests = multi_tests ++ single_tests margin = maximum (map length all_tests) + 2 hPutStrLn stderr $ "tests to run: " ++ show (length all_tests) @@ -381,10 +406,19 @@ main = do findTests :: IO [FilePath] findTests = getDirectoryContentsRecursive "." -partitionTests :: [FilePath] -> ([FilePath], [FilePath]) -partitionTests = go [] [] +-- | Partition a list of paths into a tuple of test paths and multi-test paths. +-- +-- Non-test paths and test paths that don't match the given `Tasty.TestPattern` are dropped. +partitionTests :: Tasty.TestPattern -> [FilePath] -> ([FilePath], [FilePath]) +partitionTests testPattern paths = + go [] [] paths where - go ts ms [] = (ts, ms) + -- Filter a list, keeping only paths that match the @pattern@. + keepPatternMatches = filter (Tasty.testPatternMatches testPattern . toTastyPath) + + toTastyPath path = Seq.fromList $ splitDirectories path + + go ts ms [] = (keepPatternMatches ts, keepPatternMatches ms) go ts ms (f:fs) = -- NB: Keep this synchronized with isTestFile case takeExtensions f of diff --git a/cabal-validate/src/Cli.hs b/cabal-validate/src/Cli.hs index 423769cd1d9..482fb2096b1 100644 --- a/cabal-validate/src/Cli.hs +++ b/cabal-validate/src/Cli.hs @@ -233,8 +233,8 @@ resolveOpts opts = do else "cabal.validate.project" tastyArgs' = - "--hide-successes" - : maybe + optional (rawTastyHideSuccesses opts) "--hide-successes" + ++ maybe [] (\tastyPattern -> ["--pattern", tastyPattern]) (rawTastyPattern opts) @@ -282,6 +282,7 @@ data RawOpts = RawOpts , rawExtraCompilers :: [FilePath] , rawTastyPattern :: Maybe String , rawTastyArgs :: [String] + , rawTastyHideSuccesses :: Bool , rawDoctest :: Bool , rawSteps :: [Step] , rawListSteps :: Bool @@ -352,6 +353,11 @@ rawOptsParser = <> help "Extra arguments to pass to Tasty test suites" ) ) + <*> boolOption + True + "hide-successes" + ( help "Do not print tests that passed successfully" + ) <*> boolOption False "doctest" diff --git a/changelog.d/pr-10254 b/changelog.d/pr-10254 new file mode 100644 index 00000000000..b07b66b561f --- /dev/null +++ b/changelog.d/pr-10254 @@ -0,0 +1,16 @@ +synopsis: Shallow and concurrent cloning of git repos +packages: cabal-install +prs: #10254 + +description: { + +- Clone git repositories specified in source-repository-package stanzas + shallowly, since to build the package from the repository we only need to + read the commit specified. The rest of the repo is not needed. + Note that this does not change the behaviour of `cabal get -s`, which will + still clone the repository in full. +- Clone VCS repositories concurrently, with a maximum of two concurrent tasks + at the same time (just like when downloading packages asynchronously) + +} + diff --git a/changelog.d/pr-10525 b/changelog.d/pr-10525 new file mode 100644 index 00000000000..7235d0bec74 --- /dev/null +++ b/changelog.d/pr-10525 @@ -0,0 +1,34 @@ +--- +synopsis: "A trailing colon after a stanza name in `cabal.project` is now an error" +packages: [cabal-install] +prs: 10525 +--- + +It is now a hard error to use a trailing colon after a stanza name in +`cabal.project` or `*.cabal` files: + +``` +packages: . + +source-repository-package: + type: git + location: https://github.com/haskell/cabal + tag: f34aba976a60940295f41b6649674e9568893894 +``` + +``` +$ cabal build +Error parsing project file cabal.project:3: +'source-repository-package' is a stanza, not a field. Remove the trailing ':' to parse a stanza. +``` + +Previously, the warning message was easily ignored and somewhat misleading, as +the difference between a stanza and a field is not immediately obvious to +Haskellers used to config languages like JSON and YAML (which don't distinguish +between fields which have string or list values and stanzas which have nested +fields): + +``` +Warning: cabal.project: Unrecognized field +'source-repository-package' on line 3 +``` diff --git a/changelog.d/pr-10549 b/changelog.d/pr-10549 new file mode 100644 index 00000000000..257fc103197 --- /dev/null +++ b/changelog.d/pr-10549 @@ -0,0 +1,11 @@ +synopsis: Warn on `cabal format` +packages: cabal-install +prs: #10549 +issues: +significance: + +description: { + +- Despite its name, `cabal format` is not a proper formatter for cabal files. By chance users have sometimes found the command eventhough it is not mentioned in the help text, and they used it to format cabal files. This has some downsides like comments are stripped away or common stanzas are inlined, the command is more like a dump of the resolved package description. There are future plans (#7544) to make it an actual formatter so, rather than going through a deprecation cycle, we decided to keep this command for future use and in the meantime just warn the user about the fact that it is not a proper formatter. + +} diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index 60795c4d7f6..d13d13216c4 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -19,7 +19,6 @@ Commands [global] user-config Display and update the user's global cabal configuration. help Help about commands. - path Display paths used by cabal. [package database] update Updates list of known packages. @@ -36,6 +35,7 @@ Commands freeze Freeze dependencies. gen-bounds Generate dependency bounds. outdated Check for outdated dependencies. + path Query for simple project information. [project building and installing] build Compile targets within the project.