Merge branch 'master' into andrea/remove-cabal-file

.github/mergify.yml

@@ -12,6 +12,7 @@ pull_request_rules:
       - or:
         - label=merge me
         - label=squash+merge me
+        - label=merge+no rebase
       - '#approved-reviews-by>=2'
 
   # rebase+merge strategy
@@ -44,6 +45,17 @@ pull_request_rules:
       - label=merge delay passed
       - '#approved-reviews-by>=2'
 
+  # merge+no rebase strategy
+  - actions:
+      merge:
+        method: merge
+    name: Merge "merge+no rebase" pull requests directly (without a queue)
+    conditions:
+      - base=master
+      - label=merge+no rebase
+      - label=merge delay passed
+      - '#approved-reviews-by>=2'
+
   # rebase+merge strategy for backports: require 1 approver instead of 2
   - actions:
       queue:

.hlint.yaml

@@ -24,7 +24,6 @@
 - ignore: {name: "Redundant map"} # 1 hint
 - ignore: {name: "Redundant multi-way if"} # 1 hint
 - ignore: {name: "Redundant return"} # 4 hints
-- ignore: {name: "Redundant where"} # 3 hints
 - ignore: {name: "Replace case with fromMaybe"} # 5 hints
 - ignore: {name: "Replace case with maybe"} # 10 hints
 - ignore: {name: "Unused LANGUAGE pragma"} # 121 hints

Cabal-syntax/src/Distribution/Fields/ParseResult.hs

@@ -67,7 +67,8 @@ runParseResult :: ParseResult a -> ([PWarning], Either (Maybe Version, NonEmpty
 runParseResult pr = unPR pr emptyPRState failure success
   where
     failure (PRState warns [] v) = (warns, Left (v, PError zeroPos "panic" :| []))
-    failure (PRState warns (err : errs) v) = (warns, Left (v, err :| errs)) where
+    failure (PRState warns (err : errs) v) = (warns, Left (v, err :| errs))
+
     success (PRState warns [] _) x = (warns, Right x)
     -- If there are any errors, don't return the result
     success (PRState warns (err : errs) v) _ = (warns, Left (v, err :| errs))

Cabal-syntax/src/Distribution/Types/Mixin.hs

@@ -67,7 +67,6 @@ instance Parsec Mixin where
     P.spaces
     incl <- parsec
     return (mkMixin pn ln incl)
-    where
 
 versionGuardMultilibs :: CabalParsing m => m ()
 versionGuardMultilibs = do

Cabal/Cabal.cabal

@@ -98,6 +98,7 @@ library
     Distribution.Simple.Command
     Distribution.Simple.Compiler
     Distribution.Simple.Configure
+    Distribution.Simple.Errors
     Distribution.Simple.Flag
     Distribution.Simple.GHC
     Distribution.Simple.GHCJS
@@ -148,6 +149,7 @@ library
     Distribution.Types.LocalBuildInfo
     Distribution.Types.TargetInfo
     Distribution.Types.GivenComponent
+    Distribution.Types.ParStrat
     Distribution.Utils.Json
     Distribution.Utils.NubList
     Distribution.Utils.Progress

Cabal/src/Distribution/PackageDescription/Check.hs

@@ -1352,18 +1352,13 @@ checkFields pkg =
       , isNoVersion vr
       ]
 
-    internalLibraries =
-      map
-        (maybe (packageName pkg) unqualComponentNameToPackageName . libraryNameString . libName)
-        (allLibraries pkg)
-
     internalExecutables = map exeName $ executables pkg
 
     internalLibDeps =
       [ dep
       | bi <- allBuildInfo pkg
       , dep@(Dependency name _ _) <- targetBuildDepends bi
-      , name `elem` internalLibraries
+      , name == packageName pkg
       ]
 
     internalExeDeps =

Cabal/src/Distribution/Simple/Bench.hs

@@ -31,8 +31,10 @@ import qualified Distribution.Simple.LocalBuildInfo as LBI
 import Distribution.Simple.Setup.Benchmark
 import Distribution.Simple.UserHooks
 import Distribution.Simple.Utils
+
 import Distribution.Types.UnqualComponentName
 
+import Distribution.Simple.Errors
 import System.Directory (doesFileExist)
 import System.FilePath ((<.>), (</>))
 
@@ -65,10 +67,8 @@ bench args pkg_descr lbi flags = do
             -- Check that the benchmark executable exists.
             exists <- doesFileExist cmd
             unless exists $
-              die' verbosity $
-                "Could not find benchmark program \""
-                  ++ cmd
-                  ++ "\". Did you build the package first?"
+              dieWithException verbosity $
+                NoBenchMarkProgram cmd
 
             notice verbosity $ startMessage name
             -- This will redirect the child process
@@ -92,9 +92,7 @@ bench args pkg_descr lbi flags = do
     exitSuccess
 
   when (PD.hasBenchmarks pkg_descr && null enabledBenchmarks) $
-    die' verbosity $
-      "No benchmarks enabled. Did you remember to configure with "
-        ++ "\'--enable-benchmarks\'?"
+    dieWithException verbosity EnableBenchMark
 
   bmsToRun <- case benchmarkNames of
     [] -> return enabledBenchmarks
@@ -106,11 +104,8 @@ bench args pkg_descr lbi flags = do
             Just t -> return t
             _
               | mkUnqualComponentName bmName `elem` allNames ->
-                  die' verbosity $
-                    "Package configured with benchmark "
-                      ++ bmName
-                      ++ " disabled."
-              | otherwise -> die' verbosity $ "no such benchmark: " ++ bmName
+                  dieWithException verbosity $ BenchMarkNameDisabled bmName
+              | otherwise -> dieWithException verbosity $ NoBenchMark bmName
 
   let totalBenchmarks = length bmsToRun
   notice verbosity $ "Running " ++ show totalBenchmarks ++ " benchmarks..."

Cabal/src/Distribution/Simple/Build.hs

@@ -41,6 +41,7 @@ import Distribution.Types.LocalBuildInfo
 import Distribution.Types.ModuleRenaming
 import Distribution.Types.MungedPackageId
 import Distribution.Types.MungedPackageName
+import Distribution.Types.ParStrat
 import Distribution.Types.TargetInfo
 import Distribution.Utils.Path
 
@@ -93,6 +94,7 @@ import Distribution.Compat.Graph (IsNode (..))
 
 import Control.Monad
 import qualified Data.ByteString.Lazy as LBS
+import Distribution.Simple.Errors
 import System.Directory (doesFileExist, getCurrentDirectory, removeFile)
 import System.FilePath (takeDirectory, (<.>), (</>))
 
@@ -110,6 +112,7 @@ build
   -- ^ preprocessors to run before compiling
   -> IO ()
 build pkg_descr lbi flags suffixes = do
+  checkSemaphoreSupport verbosity (compiler lbi) flags
   targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags)
   let componentsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets)
   info verbosity $
@@ -145,10 +148,21 @@ build pkg_descr lbi flags suffixes = do
             , withPackageDB = withPackageDB lbi ++ [internalPackageDB]
             , installedPkgs = index
             }
+    par_strat <-
+      toFlag <$> case buildUseSemaphore flags of
+        Flag sem_name -> case buildNumJobs flags of
+          Flag{} -> do
+            warn verbosity $ "Ignoring -j due to --semaphore"
+            return $ UseSem sem_name
+          NoFlag -> return $ UseSem sem_name
+        NoFlag -> return $ case buildNumJobs flags of
+          Flag n -> NumJobs n
+          NoFlag -> Serial
+
     mb_ipi <-
       buildComponent
         verbosity
-        (buildNumJobs flags)
+        par_strat
         pkg_descr
         lbi'
         suffixes
@@ -162,6 +176,15 @@ build pkg_descr lbi flags suffixes = do
     distPref = fromFlag (buildDistPref flags)
     verbosity = fromFlag (buildVerbosity flags)
 
+-- | Check for conditions that would prevent the build from succeeding.
+checkSemaphoreSupport
+  :: Verbosity -> Compiler -> BuildFlags -> IO ()
+checkSemaphoreSupport verbosity comp flags = do
+  unless (jsemSupported comp || (isNothing (flagToMaybe (buildUseSemaphore flags)))) $
+    die' verbosity $
+      "Your compiler does not support the -jsem flag. "
+        ++ "To use this feature you must use GHC 9.8 or later."
+
 -- | Write available build information for 'LocalBuildInfo' to disk.
 --
 -- Dumps detailed build information 'build-info.json' to the given directory.
@@ -198,9 +221,7 @@ dumpBuildInfo verbosity distPref dumpBuildInfoFlag pkg_descr lbi flags = do
 
     (compilerProg, _) <- case flavorToProgram (compilerFlavor (compiler lbi)) of
       Nothing ->
-        die' verbosity $
-          "dumpBuildInfo: Unknown compiler flavor: "
-            ++ show (compilerFlavor (compiler lbi))
+        dieWithException verbosity $ UnknownCompilerFlavor (compilerFlavor (compiler lbi))
       Just program -> requireProgram verbosity program (withPrograms lbi)
 
     let (warns, json) = mkBuildInfo pwd pkg_descr lbi flags (compilerProg, compiler lbi) activeTargets
@@ -248,9 +269,9 @@ repl pkg_descr lbi flags suffixes args = do
       -- This seems DEEPLY questionable.
       [] -> case allTargetsInBuildOrder' pkg_descr lbi of
         (target : _) -> return target
-        [] -> die' verbosity $ "Failed to determine target."
+        [] -> dieWithException verbosity $ FailedToDetermineTarget
       [target] -> return target
-      _ -> die' verbosity $ "The 'repl' command does not support multiple targets at once."
+      _ -> dieWithException verbosity $ NoMultipleTargets
   let componentsToBuild = neededTargetsInBuildOrder' pkg_descr lbi [nodeKey target]
   debug verbosity $
     "Component build order: "
@@ -313,11 +334,11 @@ startInterpreter verbosity programDb comp platform packageDBs =
   case compilerFlavor comp of
     GHC -> GHC.startInterpreter verbosity programDb comp platform packageDBs
     GHCJS -> GHCJS.startInterpreter verbosity programDb comp platform packageDBs
-    _ -> die' verbosity "A REPL is not supported with this compiler."
+    _ -> dieWithException verbosity REPLNotSupported
 
 buildComponent
   :: Verbosity
-  -> Flag (Maybe Int)
+  -> Flag ParStrat
   -> PackageDescription
   -> LocalBuildInfo
   -> [PPSuffixHandler]
@@ -512,7 +533,7 @@ buildComponent
   (CTest TestSuite{testInterface = TestSuiteUnsupported tt})
   _
   _ =
-    die' verbosity $ "No support for building test suite type " ++ prettyShow tt
+    dieWithException verbosity $ NoSupportBuildingTestSuite tt
 buildComponent
   verbosity
   numJobs
@@ -544,7 +565,7 @@ buildComponent
   (CBench Benchmark{benchmarkInterface = BenchmarkUnsupported tt})
   _
   _ =
-    die' verbosity $ "No support for building benchmark type " ++ prettyShow tt
+    dieWithException verbosity $ NoSupportBuildingBenchMark tt
 
 generateCode
   :: [String]
@@ -717,7 +738,7 @@ replComponent
   (CTest TestSuite{testInterface = TestSuiteUnsupported tt})
   _
   _ =
-    die' verbosity $ "No support for building test suite type " ++ prettyShow tt
+    dieWithException verbosity $ NoSupportBuildingTestSuite tt
 replComponent
   replFlags
   verbosity
@@ -742,7 +763,7 @@ replComponent
   (CBench Benchmark{benchmarkInterface = BenchmarkUnsupported tt})
   _
   _ =
-    die' verbosity $ "No support for building benchmark type " ++ prettyShow tt
+    dieWithException verbosity $ NoSupportBuildingBenchMark tt
 
 ----------------------------------------------------
 -- Shared code for buildComponent and replComponent
@@ -926,7 +947,7 @@ addInternalBuildTools pkg lbi bi progs =
 -- multiple libs, e.g. for 'LibTest' library-style test suites
 buildLib
   :: Verbosity
-  -> Flag (Maybe Int)
+  -> Flag ParStrat
   -> PackageDescription
   -> LocalBuildInfo
   -> Library
@@ -938,15 +959,15 @@ buildLib verbosity numJobs pkg_descr lbi lib clbi =
     GHCJS -> GHCJS.buildLib verbosity numJobs pkg_descr lbi lib clbi
     UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi
     HaskellSuite{} -> HaskellSuite.buildLib verbosity pkg_descr lbi lib clbi
-    _ -> die' verbosity "Building is not supported with this compiler."
+    _ -> dieWithException verbosity BuildingNotSupportedWithCompiler
 
 -- | Build a foreign library
 --
 -- NOTE: We assume that we already checked that we can actually build the
 -- foreign library in configure.
 buildFLib
   :: Verbosity
-  -> Flag (Maybe Int)
+  -> Flag ParStrat
   -> PackageDescription
   -> LocalBuildInfo
   -> ForeignLib
@@ -955,11 +976,11 @@ buildFLib
 buildFLib verbosity numJobs pkg_descr lbi flib clbi =
   case compilerFlavor (compiler lbi) of
     GHC -> GHC.buildFLib verbosity numJobs pkg_descr lbi flib clbi
-    _ -> die' verbosity "Building is not supported with this compiler."
+    _ -> dieWithException verbosity BuildingNotSupportedWithCompiler
 
 buildExe
   :: Verbosity
-  -> Flag (Maybe Int)
+  -> Flag ParStrat
   -> PackageDescription
   -> LocalBuildInfo
   -> Executable
@@ -970,7 +991,7 @@ buildExe verbosity numJobs pkg_descr lbi exe clbi =
     GHC -> GHC.buildExe verbosity numJobs pkg_descr lbi exe clbi
     GHCJS -> GHCJS.buildExe verbosity numJobs pkg_descr lbi exe clbi
     UHC -> UHC.buildExe verbosity pkg_descr lbi exe clbi
-    _ -> die' verbosity "Building is not supported with this compiler."
+    _ -> dieWithException verbosity BuildingNotSupportedWithCompiler
 
 replLib
   :: ReplOptions
@@ -986,7 +1007,7 @@ replLib replFlags verbosity pkg_descr lbi lib clbi =
     -- NoFlag as the numJobs parameter.
     GHC -> GHC.replLib replFlags verbosity NoFlag pkg_descr lbi lib clbi
     GHCJS -> GHCJS.replLib (replOptionsFlags replFlags) verbosity NoFlag pkg_descr lbi lib clbi
-    _ -> die' verbosity "A REPL is not supported for this compiler."
+    _ -> dieWithException verbosity REPLNotSupported
 
 replExe
   :: ReplOptions
@@ -1000,7 +1021,7 @@ replExe replFlags verbosity pkg_descr lbi exe clbi =
   case compilerFlavor (compiler lbi) of
     GHC -> GHC.replExe replFlags verbosity NoFlag pkg_descr lbi exe clbi
     GHCJS -> GHCJS.replExe (replOptionsFlags replFlags) verbosity NoFlag pkg_descr lbi exe clbi
-    _ -> die' verbosity "A REPL is not supported for this compiler."
+    _ -> dieWithException verbosity REPLNotSupported
 
 replFLib
   :: ReplOptions
@@ -1013,7 +1034,7 @@ replFLib
 replFLib replFlags verbosity pkg_descr lbi exe clbi =
   case compilerFlavor (compiler lbi) of
     GHC -> GHC.replFLib replFlags verbosity NoFlag pkg_descr lbi exe clbi
-    _ -> die' verbosity "A REPL is not supported for this compiler."
+    _ -> dieWithException verbosity REPLNotSupported
 
 -- | Runs 'componentInitialBuildSteps' on every configured component.
 initialBuildSteps

Cabal/src/Distribution/Simple/BuildPaths.hs

@@ -50,20 +50,20 @@ module Distribution.Simple.BuildPaths
 import Distribution.Compat.Prelude
 import Prelude ()
 
+import Data.List (stripPrefix)
 import Distribution.Compiler
 import Distribution.ModuleName as ModuleName
 import Distribution.Package
 import Distribution.PackageDescription
 import Distribution.Pretty
+import Distribution.Simple.Errors
 import Distribution.Simple.LocalBuildInfo
 import Distribution.Simple.Setup.Common (defaultDistPref)
 import Distribution.Simple.Setup.Haddock (HaddockTarget (..))
 import Distribution.Simple.Utils
 import Distribution.System
 import Distribution.Utils.Path
 import Distribution.Verbosity
-
-import Data.List (stripPrefix)
 import System.FilePath (normalise, (<.>), (</>))
 
 -- ---------------------------------------------------------------------------
@@ -192,7 +192,8 @@ getSourceFiles verbosity dirs modules = flip traverse modules $ \m ->
     findFileWithExtension ["hs", "lhs", "hsig", "lhsig"] dirs (ModuleName.toFilePath m)
       >>= maybe (notFound m) (return . normalise)
   where
-    notFound module_ = die' verbosity $ "can't find source for module " ++ prettyShow module_
+    notFound module_ =
+      dieWithException verbosity $ CantFindSourceModule module_
 
 -- | The directory where we put build results for an executable
 exeBuildDir :: LocalBuildInfo -> Executable -> FilePath