From bff077ec142a9ef9220c9883ed31157775c0507d Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Fri, 15 Sep 2023 15:21:20 -0400 Subject: [PATCH 01/47] Add back reference from constraints to flags --- doc/cabal-project.rst | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index 90f819a529c..fedf8c4e935 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -448,8 +448,17 @@ The following settings control the behavior of the dependency solver: :: - constraints: bar == 2.1, - bar +foo -baz + constraints: + bar == 2.1 + , bar +foo -baz + + This is equivalent to writing constraints and :cfg-field:`flags` separately: + + :: + + constraints: bar == 2.1 + package bar + flags: +foo -baz Valid constraints take the same form as for the :option:`runhaskell Setup.hs configure --constraint` @@ -754,8 +763,6 @@ feature was added. local packages support the same named flags. If a flag is not supported by a package, it is ignored. - See also the solver configuration field :cfg-field:`constraints`. - The command line variant of this flag is ``--flags``. There is also a shortened form ``-ffoo -f-bar``. @@ -763,7 +770,8 @@ feature was added. ``hans`` is a flag for a transitive dependency that is not in the local package; in this case, the flag will be silently ignored. If ``haskell-tor`` is the package you want this flag to apply to, try - ``--constraint="haskell-tor +hans"`` instead. + ``--constraint="haskell-tor +hans"`` instead. Flags can be specified as + package :cfg-field:`constraints`. .. cfg-field:: with-compiler: PATH -w PATH or -wPATH, --with-compiler=PATH From 24b2bd59500c7da13233a151bf8b330b709425ff Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Fri, 6 Oct 2023 16:31:12 -0400 Subject: [PATCH 02/47] Simplify to avoid an an typo --- cabal-testsuite/README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal-testsuite/README.md b/cabal-testsuite/README.md index e206530d0fb..1fba1d85446 100644 --- a/cabal-testsuite/README.md +++ b/cabal-testsuite/README.md @@ -226,8 +226,8 @@ technical innovations to make this work: to these scripts. * The startup latency of `runghc` can be quite high, which adds up - when you have many tests. To solve this, in `Test.Cabal.Server` - we have an implementation an GHCi server, for which we can reuse + when you have many tests. To solve this, our `Test.Cabal.Server` + GHCi server implementation can reuse a GHCi instance as we are running test scripts. It took some technical ingenuity to implement this, but the result is that running scripts is essentially free. From 46369b235de8d3d6520fceab6212711fd7c357cf Mon Sep 17 00:00:00 2001 From: liamzee Date: Mon, 16 Oct 2023 01:40:44 +0800 Subject: [PATCH 03/47] Add or Expand 5 Comments To help make the Cabal codebase more accessible, expandResponse in Cabal/Distribution.ResponseFile received Haddock documentation. The defaultMainHelper function in Cabal/Distribution.Simple received hidden Haddock documentation. In the hidden module cabal-install/Distribution.Client.Main, the Haddock documentation for main was expanded, additional commenting explaining the response file compatibility code in main was added, and documentation for mainWorker was added. --- Cabal/src/Distribution/Compat/ResponseFile.hs | 6 +++++ Cabal/src/Distribution/Simple.hs | 7 ++++++ cabal-install/src/Distribution/Client/Main.hs | 22 +++++++++++++++++++ 3 files changed, 35 insertions(+) diff --git a/Cabal/src/Distribution/Compat/ResponseFile.hs b/Cabal/src/Distribution/Compat/ResponseFile.hs index c03207fed55..189a423bd08 100644 --- a/Cabal/src/Distribution/Compat/ResponseFile.hs +++ b/Cabal/src/Distribution/Compat/ResponseFile.hs @@ -65,6 +65,12 @@ escape cs c #endif +-- | The arg file / response file parser. +-- +-- This is not a well-documented capability, and is a bit eccentric +-- (try @cabal \@foo \@bar@ to see what that does), but is crucial +-- for allowing complex arguments to cabal and cabal-install when +-- using command prompts with strongly-limited argument length. expandResponse :: [String] -> IO [String] expandResponse = go recursionLimit "." where diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs index d6f50d0af90..0f200922928 100644 --- a/Cabal/src/Distribution/Simple.hs +++ b/Cabal/src/Distribution/Simple.hs @@ -155,6 +155,13 @@ defaultMainWithHooksNoReadArgs :: UserHooks -> GenericPackageDescription -> [Str defaultMainWithHooksNoReadArgs hooks pkg_descr = defaultMainHelper hooks{readDesc = return (Just pkg_descr)} +-- | Less the helper, and more the central command chooser of +-- the Simple build system, with other defaultMain functions acting as +-- exposed callers. +-- +-- Given hooks and args, this runs 'commandsRun' onto the args, +-- getting 'CommandParse' data back, which is then pattern-matched into +-- IO actions for execution. defaultMainHelper :: UserHooks -> Args -> IO () defaultMainHelper hooks args = topHandler $ do args' <- expandResponse args diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 1a46893c9b8..4c9269fe271 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -267,6 +267,18 @@ import System.IO ) -- | Entry point +-- +-- This does three things. +-- +-- One, it initializes the program, providing support for termination +-- signals, preparing console linebuffering, and relaxing encoding errors. +-- +-- Two, it processes (via an IO action) response +-- files, calling expandResponse in Cabal/Distribution.Compat.ResponseFile +-- +-- Three, it calls the mainWorker, which calls the argument parser, +-- producing CommandParse data, which mainWorker pattern-matches +-- into IO actions for execution. main :: [String] -> IO () main args = do installTerminationHandler @@ -279,6 +291,11 @@ main args = do -- when writing to stderr and stdout. relaxEncodingErrors stdout relaxEncodingErrors stderr + + -- Response files support. + -- See expandResponse documentation in + -- Cabal/Distribution.Compat.ResponseFile + -- for more information. let (args0, args1) = break (== "--") args mainWorker =<< (++ args1) <$> expandResponse args0 @@ -296,6 +313,11 @@ warnIfAssertionsAreEnabled = assertionsEnabledMsg = "Warning: this is a debug build of cabal-install with assertions enabled." +-- | Core worker, similar to defaultMainHelper in Cabal/Distribution.Simple +-- +-- With an exception-handler @topHandler@, mainWorker calls commandsRun +-- to parse arguments, then pattern-matches the CommandParse data +-- into IO actions for execution. mainWorker :: [String] -> IO () mainWorker args = do topHandler $ From 059e35159ca35b39aa1662fe9d734c9abde19196 Mon Sep 17 00:00:00 2001 From: SuganyaAK Date: Wed, 11 Oct 2023 11:29:17 -0400 Subject: [PATCH 04/47] Remaining Cabal-Install package errors --- .../Distribution/Client/CmdErrorMessages.hs | 5 +- .../src/Distribution/Client/CmdFreeze.hs | 8 +- .../src/Distribution/Client/CmdHaddock.hs | 7 +- .../Distribution/Client/CmdHaddockProject.hs | 5 +- .../src/Distribution/Client/CmdInstall.hs | 37 +- .../src/Distribution/Client/CmdSdist.hs | 12 +- .../src/Distribution/Client/Configure.hs | 7 +- .../src/Distribution/Client/Errors.hs | 381 +++++++++++++++++- .../src/Distribution/Client/Freeze.hs | 3 +- cabal-install/src/Distribution/Client/Get.hs | 5 +- .../src/Distribution/Client/HttpUtils.hs | 75 +--- .../src/Distribution/Client/IndexUtils.hs | 7 +- .../src/Distribution/Client/Install.hs | 40 +- .../Client/ProjectOrchestration.hs | 11 +- .../Distribution/Client/ProjectPlanning.hs | 3 +- .../src/Distribution/Client/ScriptUtils.hs | 5 +- .../src/Distribution/Client/TargetSelector.hs | 202 ++-------- .../src/Distribution/Client/Utils.hs | 5 +- .../Distribution/Client/Win32SelfUpgrade.hs | 5 +- 19 files changed, 512 insertions(+), 311 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdErrorMessages.hs b/cabal-install/src/Distribution/Client/CmdErrorMessages.hs index e8b5a415db6..8345d9ed59a 100644 --- a/cabal-install/src/Distribution/Client/CmdErrorMessages.hs +++ b/cabal-install/src/Distribution/Client/CmdErrorMessages.hs @@ -37,7 +37,7 @@ import Distribution.Package , packageName ) import Distribution.Simple.Utils - ( die' + ( dieWithException ) import Distribution.Solver.Types.OptionalStanza ( OptionalStanza (..) @@ -51,6 +51,7 @@ import Distribution.Types.LibraryName ) import qualified Data.List.NonEmpty as NE +import Distribution.Client.Errors ----------------------- -- Singular or plural @@ -227,7 +228,7 @@ renderComponentKind Plural ckind = case ckind of -- | Default implementation of 'reportTargetProblems' simply renders one problem per line. reportTargetProblems :: Verbosity -> String -> [TargetProblem'] -> IO a reportTargetProblems verbosity verb = - die' verbosity . unlines . map (renderTargetProblem verb absurd) + dieWithException verbosity . CmdErrorMessages . map (renderTargetProblem verb absurd) -- | Default implementation of 'renderTargetProblem'. renderTargetProblem diff --git a/cabal-install/src/Distribution/Client/CmdFreeze.hs b/cabal-install/src/Distribution/Client/CmdFreeze.hs index db8ef81fca2..85c7eb137e2 100644 --- a/cabal-install/src/Distribution/Client/CmdFreeze.hs +++ b/cabal-install/src/Distribution/Client/CmdFreeze.hs @@ -54,7 +54,7 @@ import Distribution.PackageDescription ) import Distribution.Simple.Flag (Flag (..), fromFlagOrDefault) import Distribution.Simple.Utils - ( die' + ( dieWithException , notice , wrapText ) @@ -70,6 +70,7 @@ import Distribution.Version import qualified Data.Map as Map +import Distribution.Client.Errors import Distribution.Simple.Command ( CommandUI (..) , usageAlternatives @@ -125,9 +126,8 @@ freezeCommand = freezeAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO () freezeAction flags@NixStyleFlags{..} extraArgs globalFlags = do unless (null extraArgs) $ - die' verbosity $ - "'freeze' doesn't take any extra arguments: " - ++ unwords extraArgs + dieWithException verbosity $ + FreezeAction extraArgs ProjectBaseContext { distDirLayout diff --git a/cabal-install/src/Distribution/Client/CmdHaddock.hs b/cabal-install/src/Distribution/Client/CmdHaddock.hs index fea0cb4411d..b67bda4bcec 100644 --- a/cabal-install/src/Distribution/Client/CmdHaddock.hs +++ b/cabal-install/src/Distribution/Client/CmdHaddock.hs @@ -60,7 +60,7 @@ import Distribution.Simple.Setup , trueArg ) import Distribution.Simple.Utils - ( die' + ( dieWithException , notice , wrapText ) @@ -68,6 +68,7 @@ import Distribution.Verbosity ( normal ) +import Distribution.Client.Errors import qualified System.Exit (exitSuccess) newtype ClientHaddockFlags = ClientHaddockFlags {openInBrowser :: Flag Bool} @@ -167,9 +168,7 @@ haddockAction relFlags targetStrings globalFlags = do buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do when (buildSettingOnlyDeps (buildSettings baseCtx)) $ - die' - verbosity - "The haddock command does not support '--only-dependencies'." + dieWithException verbosity HaddockCommandDoesn'tSupport -- When we interpret the targets on the command line, interpret them as -- haddock targets diff --git a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs index d63e890a3ee..cac23c9b51b 100644 --- a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs +++ b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs @@ -84,7 +84,7 @@ import Distribution.Simple.Setup import Distribution.Simple.Utils ( copyDirectoryRecursive , createDirectoryIfMissingVerbose - , die' + , dieWithException , warn ) import Distribution.Types.InstalledPackageInfo (InstalledPackageInfo (..)) @@ -97,6 +97,7 @@ import Distribution.Verbosity as Verbosity ( normal ) +import Distribution.Client.Errors import System.Directory (doesDirectoryExist, doesFileExist) import System.FilePath (normalise, takeDirectory, (<.>), ()) @@ -384,7 +385,7 @@ haddockProjectAction flags _extraArgs globalFlags = do reportTargetProblems :: Show x => [x] -> IO a reportTargetProblems = - die' verbosity . unlines . map show + dieWithException verbosity . CmdHaddockReportTargetProblems . map show -- TODO: this is just a sketch selectPackageTargets diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 46ce2cd6e5a..cb032d2b712 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -162,7 +162,7 @@ import Distribution.Simple.Setup ) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose - , die' + , dieWithException , notice , ordNub , safeHead @@ -220,6 +220,7 @@ import Data.Ord ( Down (..) ) import qualified Data.Set as S +import Distribution.Client.Errors import Distribution.Utils.NubList ( fromNubList ) @@ -424,17 +425,13 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt let xs = searchByName packageIndex (unPackageName name) let emptyIf True _ = [] emptyIf False zs = zs - die' verbosity $ - concat $ - [ "Unknown package \"" - , unPackageName name - , "\". " - ] - ++ emptyIf + str2 = + emptyIf (null xs) [ "Did you mean any of the following?\n" , unlines (("- " ++) . unPackageName . fst <$> xs) ] + dieWithException verbosity $ WithoutProject (unPackageName name) str2 let (uris, packageSpecifiers) = partitionEithers $ map woPackageSpecifiers tss @@ -541,7 +538,7 @@ installAction flags@NixStyleFlags{extraFlags = clientInstallFlags', ..} targetSt let es = filter (\e -> not $ getPackageName e `S.member` nameIntersection) envSpecs nge = map snd . filter (\e -> not $ fst e `S.member` nameIntersection) $ nonGlobalEnvEntries in pure (es, nge) - else die' verbosity $ "Packages requested to install already exist in environment file at " ++ envFile ++ ". Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: " ++ intercalate ", " (map prettyShow $ S.toList nameIntersection) + else dieWithException verbosity $ PackagesAlreadyExistInEnvfile envFile (map prettyShow $ S.toList nameIntersection) -- we construct an installed index of files in the cleaned target environment (absent overwrites) so that we can solve with regards to packages installed locally but not in the upstream repo let installedPacks = PI.allPackagesByName installedIndex @@ -617,20 +614,16 @@ addLocalConfigToTargets config targetStrings = -- | Verify that invalid config options were not passed to the install command. -- --- If an invalid configuration is found the command will @die'@. +-- If an invalid configuration is found the command will @dieWithException@. verifyPreconditionsOrDie :: Verbosity -> ConfigFlags -> IO () verifyPreconditionsOrDie verbosity configFlags = do -- We never try to build tests/benchmarks for remote packages. -- So we set them as disabled by default and error if they are explicitly -- enabled. when (configTests configFlags == Flag True) $ - die' verbosity $ - "--enable-tests was specified, but tests can't " - ++ "be enabled in a remote package" + dieWithException verbosity ConfigTests when (configBenchmarks configFlags == Flag True) $ - die' verbosity $ - "--enable-benchmarks was specified, but benchmarks can't " - ++ "be enabled in a remote package" + dieWithException verbosity ConfigBenchmarks getClientInstallFlags :: Verbosity -> GlobalFlags -> ClientInstallFlags -> IO ClientInstallFlags getClientInstallFlags verbosity globalFlags existingClientInstallFlags = do @@ -733,13 +726,7 @@ partitionToKnownTargetsAndHackagePackages verbosity pkgDb elaboratedPlan targetS case searchByName (packageIndex pkgDb) (unPackageName hn) of [] -> return () xs -> - die' verbosity . concat $ - [ "Unknown package \"" - , unPackageName hn - , "\". " - , "Did you mean any of the following?\n" - , unlines (("- " ++) . unPackageName . fst <$> xs) - ] + dieWithException verbosity $ UnknownPackage (unPackageName hn) (("- " ++) . unPackageName . fst <$> xs) _ -> return () when (not . null $ errs') $ reportBuildTargetProblems verbosity errs' @@ -1058,7 +1045,7 @@ installUnitExes InstallMethodSymlink -> "Symlinking" InstallMethodCopy -> "Copying" <> " '" <> prettyShow exe <> "' failed." - unless success $ die' verbosity errorMessage + unless success $ dieWithException verbosity $ InstallUnitExes errorMessage -- | Install a specific exe. installBuiltExe @@ -1265,4 +1252,4 @@ reportBuildTargetProblems verbosity problems = reportTargetProblems verbosity "b reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a reportCannotPruneDependencies verbosity = - die' verbosity . renderCannotPruneDependencies + dieWithException verbosity . SelectComponentTargetError . renderCannotPruneDependencies diff --git a/cabal-install/src/Distribution/Client/CmdSdist.hs b/cabal-install/src/Distribution/Client/CmdSdist.hs index 38839c8292a..c77c1eae910 100644 --- a/cabal-install/src/Distribution/Client/CmdSdist.hs +++ b/cabal-install/src/Distribution/Client/CmdSdist.hs @@ -63,6 +63,7 @@ import Distribution.Solver.Types.SourcePackage ( SourcePackage (..) ) +import Distribution.Client.Errors import Distribution.Client.SrcDist ( packageDirToSdist ) @@ -106,8 +107,7 @@ import Distribution.Simple.SrcDist ( listPackageSourcesWithDie ) import Distribution.Simple.Utils - ( die' - , dieWithException + ( dieWithException , notice , withOutputMarker , wrapText @@ -258,12 +258,12 @@ sdistAction (pf@ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do | otherwise -> distSdistFile distDirLayout (packageId pkg) case reifyTargetSelectors localPkgs targetSelectors of - Left errs -> die' verbosity . unlines . fmap renderTargetProblem $ errs + Left errs -> dieWithException verbosity $ SdistActionException . fmap renderTargetProblem $ errs Right pkgs | length pkgs > 1 , not listSources , Just "-" <- mOutputPath' -> - die' verbosity "Can't write multiple tarballs to standard output!" + dieWithException verbosity Can'tWriteMultipleTarballs | otherwise -> traverse_ (\pkg -> packageToSdist verbosity (distProjectRootDirectory distDirLayout) format (outputPath pkg) pkg) pkgs where @@ -306,7 +306,7 @@ data OutputFormat packageToSdist :: Verbosity -> FilePath -> OutputFormat -> FilePath -> UnresolvedSourcePackage -> IO () packageToSdist verbosity projectRootDir format outputFile pkg = do - let death = die' verbosity ("The impossible happened: a local package isn't local" <> (show pkg)) + let death = dieWithException verbosity $ ImpossibleHappened (show pkg) dir0 <- case srcpkgSource pkg of LocalUnpackedPackage path -> pure (Right path) RemoteSourceRepoPackage _ (Just tgz) -> pure (Left tgz) @@ -335,7 +335,7 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do case format of TarGzArchive -> do writeLBS =<< BSL.readFile tgz - _ -> die' verbosity ("cannot convert tarball package to " ++ show format) + _ -> dieWithException verbosity $ CannotConvertTarballPackage (show format) Right dir -> case format of SourceList nulSep -> do let gpd :: GenericPackageDescription diff --git a/cabal-install/src/Distribution/Client/Configure.hs b/cabal-install/src/Distribution/Client/Configure.hs index 56b882d6d2a..b01681d9727 100644 --- a/cabal-install/src/Distribution/Client/Configure.hs +++ b/cabal-install/src/Distribution/Client/Configure.hs @@ -107,7 +107,7 @@ import Distribution.Simple.Setup import Distribution.Simple.Utils as Utils ( debug , defaultPackageDesc - , die' + , dieWithException , notice , warn ) @@ -128,6 +128,7 @@ import Distribution.Version , thisVersion ) +import Distribution.Client.Errors import System.FilePath (()) -- | Choose the Cabal version such that the setup scripts compiled against this @@ -223,9 +224,7 @@ configure pkg extraArgs _ -> - die' verbosity $ - "internal error: configure install plan should have exactly " - ++ "one local ready package." + dieWithException verbosity ConfigureInstallInternalError where setupScriptOptions :: InstalledPackageIndex diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index 9214ae56fb6..1b690ec3ef4 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -1,6 +1,9 @@ {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} ----------------------------------------------------------------------------- @@ -18,12 +21,17 @@ module Distribution.Client.Errors , exceptionMessageCabalInstall ) where +import Data.ByteString (ByteString) +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as BS8 +import Data.List (groupBy) import Distribution.Compat.Prelude import Distribution.Deprecated.ParseUtils (PWarning, showPWarning) import Distribution.Package import Distribution.Pretty import Distribution.Simple (VersionRange) import Distribution.Simple.Utils +import Network.URI import Text.Regex.Posix.ByteString (WrapError) data CabalInstallException @@ -120,6 +128,57 @@ data CabalInstallException | FreezeFileExistsErr FilePath | FinalizePDFailed | ProjectTargetSelector String String + | PhaseRunSolverErr String + | HaddockCommandDoesn'tSupport + | CannotParseURIFragment String String + | MakeDownload URI ByteString ByteString + | FailedToDownloadURI URI String + | RemoteRepoCheckHttps String String + | TransportCheckHttps URI String + | NoPostYet + | WGetServerError FilePath String + | Couldn'tEstablishHttpConnection + | StatusParseFail URI String + | TryUpgradeToHttps [String] + | UnknownHttpTransportSpecified String [String] + | CmdHaddockReportTargetProblems [String] + | FailedExtractingScriptBlock String + | FreezeAction [String] + | TryFindPackageDescErr String + | DieIfNotHaddockFailure String + | ConfigureInstallInternalError + | CmdErrorMessages [String] + | ReportTargetSelectorProblems [String] + | UnrecognisedTarget [(String, [String], String)] + | NoSuchTargetSelectorErr [(String, [(Maybe (String, String), String, String, [String])])] + | TargetSelectorAmbiguousErr [(String, [(String, String)])] + | TargetSelectorNoCurrentPackageErr String + | TargetSelectorNoTargetsInCwdTrue + | TargetSelectorNoTargetsInCwdFalse + | TargetSelectorNoTargetsInProjectErr + | TargetSelectorNoScriptErr String + | MatchingInternalErrorErr String String String [(String, [String])] + | ReportPlanningFailure String + | Can'tDownloadPackagesOffline [String] + | SomePackagesFailedToInstall [(String, String)] + | PackageDotCabalFileNotFound FilePath + | PkgConfParsedFailed String + | BrokenException String + | WithoutProject String [String] + | PackagesAlreadyExistInEnvfile FilePath [String] + | ConfigTests + | ConfigBenchmarks + | UnknownPackage String [String] + | InstallUnitExes String + | SelectComponentTargetError String + | SdistActionException [String] + | Can'tWriteMultipleTarballs + | ImpossibleHappened String + | CannotConvertTarballPackage String + | Win32SelfUpgradeNotNeeded + | FreezeException String + | PkgSpecifierException [String] + | CorruptedIndexCache String deriving (Show, Typeable) exceptionCodeCabalInstall :: CabalInstallException -> Int @@ -217,6 +276,58 @@ exceptionCodeCabalInstall e = case e of FreezeFileExistsErr{} -> 7104 FinalizePDFailed{} -> 7105 ProjectTargetSelector{} -> 7106 + PhaseRunSolverErr{} -> 7107 + HaddockCommandDoesn'tSupport{} -> 7108 + CannotParseURIFragment{} -> 7109 + MakeDownload{} -> 7110 + FailedToDownloadURI{} -> 7111 + RemoteRepoCheckHttps{} -> 7112 + TransportCheckHttps{} -> 7113 + NoPostYet{} -> 7114 + WGetServerError{} -> 7115 + Couldn'tEstablishHttpConnection{} -> 7116 + StatusParseFail{} -> 7117 + TryUpgradeToHttps{} -> 7118 + UnknownHttpTransportSpecified{} -> 7119 + CmdHaddockReportTargetProblems{} -> 7120 + FailedExtractingScriptBlock{} -> 7121 + FreezeAction{} -> 7122 + TryFindPackageDescErr{} -> 7124 + DieIfNotHaddockFailure{} -> 7125 + ConfigureInstallInternalError{} -> 7126 + CmdErrorMessages{} -> 7127 + ReportTargetSelectorProblems{} -> 7128 + UnrecognisedTarget{} -> 7129 + NoSuchTargetSelectorErr{} -> 7131 + TargetSelectorAmbiguousErr{} -> 7132 + TargetSelectorNoCurrentPackageErr{} -> 7133 + TargetSelectorNoTargetsInCwdTrue{} -> 7134 + TargetSelectorNoTargetsInCwdFalse{} -> 7135 + TargetSelectorNoTargetsInProjectErr{} -> 7136 + TargetSelectorNoScriptErr{} -> 7137 + MatchingInternalErrorErr{} -> 7130 + ReportPlanningFailure{} -> 7138 + Can'tDownloadPackagesOffline{} -> 7139 + SomePackagesFailedToInstall{} -> 7140 + PackageDotCabalFileNotFound{} -> 7141 + PkgConfParsedFailed{} -> 7142 + BrokenException{} -> 7143 + WithoutProject{} -> 7144 + PackagesAlreadyExistInEnvfile{} -> 7145 + ConfigTests{} -> 7146 + ConfigBenchmarks{} -> 7147 + UnknownPackage{} -> 7148 + InstallUnitExes{} -> 7149 + SelectComponentTargetError{} -> 7150 + SdistActionException{} -> 7151 + Can'tWriteMultipleTarballs{} -> 7152 + ImpossibleHappened{} -> 7153 + CannotConvertTarballPackage{} -> 7154 + Win32SelfUpgradeNotNeeded{} -> 7155 + FreezeException{} -> 7156 + PkgSpecifierException{} -> 7157 + CorruptedIndexCache{} -> 7158 + exceptionMessageCabalInstall :: CabalInstallException -> String exceptionMessageCabalInstall e = case e of UnpackGet -> @@ -235,7 +346,7 @@ exceptionMessageCabalInstall e = case e of CouldNotFindExecutable -> "run: Could not find executable in LocalBuildInfo" FoundMultipleMatchingExes -> "run: Found multiple matching exes in LocalBuildInfo" NoRemoteRepositories -> "Cannot upload. No remote repositories are configured." - NotATarDotGzFile path -> "Not a tar.gz file: " ++ path + NotATarDotGzFile paths -> "Not a tar.gz file: " ++ paths ExpectedMatchingFileName -> "Expected a file name matching the pattern -docs.tar.gz" NoTargetProvided -> "One target is required, none provided" OneTargetRequired -> "One target is required, given multiple" @@ -277,7 +388,7 @@ exceptionMessageCabalInstall e = case e of ++ msg ++ "The package index or index cache is probably " ++ "corrupt. Running cabal update might fix it." - ReadIndexCache path -> show (path) + ReadIndexCache paths -> show (paths) ConfigStateFileException err -> err UploadAction -> "the 'upload' command expects at least one .tar.gz archive." UploadActionDocumentation -> @@ -292,7 +403,7 @@ exceptionMessageCabalInstall e = case e of InitAction -> "'init' only takes a single, optional, extra " ++ "argument for the project root directory" - UserConfigAction path -> path ++ " already exists." + UserConfigAction paths -> paths ++ " already exists." SpecifySubcommand -> "Please specify a subcommand (see 'help user-config')" UnknownUserConfigSubcommand extraArgs -> "Unknown 'user-config' subcommand: " ++ unwords extraArgs ManpageAction extraArgs -> "'man' doesn't take any extra arguments: " ++ unwords extraArgs @@ -453,6 +564,270 @@ exceptionMessageCabalInstall e = case e of ++ "a freeze file via 'cabal freeze'." FinalizePDFailed -> "finalizePD failed" ProjectTargetSelector input err -> "Invalid package ID: " ++ input ++ "\n" ++ err + PhaseRunSolverErr msg -> msg + HaddockCommandDoesn'tSupport -> "The haddock command does not support '--only-dependencies'." + CannotParseURIFragment uriFrag err -> "Cannot parse URI fragment " ++ uriFrag ++ " " ++ err + MakeDownload uri expected actual -> + unwords + [ "Failed to download" + , show uri + , ": SHA256 don't match; expected:" + , BS8.unpack (Base16.encode expected) + , "actual:" + , BS8.unpack (Base16.encode actual) + ] + FailedToDownloadURI uri errCode -> + "failed to download " + ++ show uri + ++ " : HTTP code " + ++ errCode + RemoteRepoCheckHttps unRepoName requiresHttpsErrorMessage -> + "The remote repository '" + ++ unRepoName + ++ "' specifies a URL that " + ++ requiresHttpsErrorMessage + TransportCheckHttps uri requiresHttpsErrorMessage -> + "The URL " + ++ show uri + ++ " " + ++ requiresHttpsErrorMessage + NoPostYet -> "Posting (for report upload) is not implemented yet" + WGetServerError programPath resp -> + "'" + ++ programPath + ++ "' exited with an error:\n" + ++ resp + Couldn'tEstablishHttpConnection -> + "Couldn't establish HTTP connection. " + ++ "Possible cause: HTTP proxy server is down." + StatusParseFail uri r -> + "Failed to download " + ++ show uri + ++ " : " + ++ "No Status Code could be parsed from response: " + ++ r + TryUpgradeToHttps str -> + "The builtin HTTP implementation does not support HTTPS, but using " + ++ "HTTPS for authenticated uploads is recommended. " + ++ "The transport implementations with HTTPS support are " + ++ intercalate ", " str + ++ "but they require the corresponding external program to be " + ++ "available. You can either make one available or use plain HTTP by " + ++ "using the global flag --http-transport=plain-http (or putting the " + ++ "equivalent in the config file). With plain HTTP, your password " + ++ "is sent using HTTP digest authentication so it cannot be easily " + ++ "intercepted, but it is not as secure as using HTTPS." + UnknownHttpTransportSpecified name str -> + "Unknown HTTP transport specified: " + ++ name + ++ ". The supported transports are " + ++ intercalate + ", " + str + CmdHaddockReportTargetProblems str -> unlines str + FailedExtractingScriptBlock eStr -> "Failed extracting script block: " ++ eStr + FreezeAction extraArgs -> + "'freeze' doesn't take any extra arguments: " + ++ unwords extraArgs + TryFindPackageDescErr err -> err + DieIfNotHaddockFailure errorStr -> errorStr + ConfigureInstallInternalError -> + "internal error: configure install plan should have exactly " + ++ "one local ready package." + CmdErrorMessages err -> unlines err + ReportTargetSelectorProblems targets -> + unlines + [ "Unrecognised target syntax for '" ++ name ++ "'." + | name <- targets + ] + UnrecognisedTarget targets -> + unlines + [ "Unrecognised target '" + ++ target + ++ "'.\n" + ++ "Expected a " + ++ intercalate " or " expected + ++ ", rather than '" + ++ got + ++ "'." + | (target, expected, got) <- targets + ] + NoSuchTargetSelectorErr targets -> + unlines + [ "Unknown target '" + ++ target + ++ "'.\n" + ++ unlines + [ ( case inside of + Just (kind, "") -> + "The " ++ kind ++ " has no " + Just (kind, thing) -> + "The " ++ kind ++ " " ++ thing ++ " has no " + Nothing -> "There is no " + ) + ++ intercalate + " or " + [ mungeThing thing ++ " '" ++ got ++ "'" + | (thing, got, _alts) <- nosuch' + ] + ++ "." + ++ if null alternatives + then "" + else + "\nPerhaps you meant " + ++ intercalate + ";\nor " + [ "the " ++ thing ++ " '" ++ intercalate "' or '" alts ++ "'?" + | (thing, alts) <- alternatives + ] + | (inside, nosuch') <- groupByContainer nosuch + , let alternatives = + [ (thing, alts) + | (thing, _got, alts@(_ : _)) <- nosuch' + ] + ] + | (target, nosuch) <- targets + , let groupByContainer = + map + ( \g@((inside, _, _, _) : _) -> + ( inside + , [ (thing, got, alts) + | (_, thing, got, alts) <- g + ] + ) + ) + . groupBy ((==) `on` (\(x, _, _, _) -> x)) + . sortBy (compare `on` (\(x, _, _, _) -> x)) + ] + where + mungeThing "file" = "file target" + mungeThing thing = thing + TargetSelectorAmbiguousErr targets -> + unlines + [ "Ambiguous target '" + ++ target + ++ "'. It could be:\n " + ++ unlines + [ " " + ++ ut + ++ " (" + ++ bt + ++ ")" + | (ut, bt) <- amb + ] + | (target, amb) <- targets + ] + TargetSelectorNoCurrentPackageErr target -> + "The target '" + ++ target + ++ "' refers to the " + ++ "components in the package in the current directory, but there " + ++ "is no package in the current directory (or at least not listed " + ++ "as part of the project)." + TargetSelectorNoTargetsInCwdTrue -> + "No targets given and there is no package in the current " + ++ "directory. Use the target 'all' for all packages in the " + ++ "project or specify packages or components by name or location. " + ++ "See 'cabal build --help' for more details on target options." + TargetSelectorNoTargetsInCwdFalse -> + "No targets given and there is no package in the current " + ++ "directory. Specify packages or components by name or location. " + ++ "See 'cabal build --help' for more details on target options." + TargetSelectorNoTargetsInProjectErr -> + "There is no .cabal package file or cabal.project file. " + ++ "To build packages locally you need at minimum a .cabal " + ++ "file. You can use 'cabal init' to create one.\n" + ++ "\n" + ++ "For non-trivial projects you will also want a cabal.project " + ++ "file in the root directory of your project. This file lists the " + ++ "packages in your project and all other build configuration. " + ++ "See the Cabal user guide for full details." + TargetSelectorNoScriptErr target -> + "The script '" + ++ target + ++ "' does not exist, " + ++ "and only script targets may contain whitespace characters or end " + ++ "with ':'" + MatchingInternalErrorErr t s sKind renderingsAndMatches -> + "Internal error in target matching: could not make an " + ++ "unambiguous fully qualified target selector for '" + ++ t + ++ "'.\n" + ++ "We made the target '" + ++ s + ++ "' (" + ++ sKind + ++ ") that was expected to " + ++ "be unambiguous but matches the following targets:\n" + ++ unlines + [ "'" + ++ rendering + ++ "', matching:" + ++ concatMap + ("\n - " ++) + matches + | (rendering, matches) <- renderingsAndMatches + ] + ++ "\nNote: Cabal expects to be able to make a single fully " + ++ "qualified name for a target or provide a more specific error. " + ++ "Our failure to do so is a bug in cabal. " + ++ "Tracking issue: https://github.com/haskell/cabal/issues/8684" + ++ "\n\nHint: this may be caused by trying to build a package that " + ++ "exists in the project directory but is missing from " + ++ "the 'packages' stanza in your cabal project file." + ReportPlanningFailure message -> message + Can'tDownloadPackagesOffline notFetched -> + "Can't download packages in offline mode. " + ++ "Must download the following packages to proceed:\n" + ++ intercalate ", " notFetched + ++ "\nTry using 'cabal fetch'." + SomePackagesFailedToInstall failed -> + unlines $ + "Some packages failed to install:" + : [ pkgid ++ reason + | (pkgid, reason) <- failed + ] + PackageDotCabalFileNotFound descFilePath -> "Package .cabal file not found: " ++ show descFilePath + PkgConfParsedFailed perror -> + "Couldn't parse the output of 'setup register --gen-pkg-config':" + ++ show perror + BrokenException errorStr -> errorStr + WithoutProject str1 str2 -> + concat $ + [ "Unknown package \"" + , str1 + , "\". " + ] + ++ str2 + PackagesAlreadyExistInEnvfile envFile name -> + "Packages requested to install already exist in environment file at " + ++ envFile + ++ ". Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: " + ++ intercalate ", " name + ConfigTests -> + "--enable-tests was specified, but tests can't " + ++ "be enabled in a remote package" + ConfigBenchmarks -> + "--enable-benchmarks was specified, but benchmarks can't " + ++ "be enabled in a remote package" + UnknownPackage hn name -> + concat $ + [ "Unknown package \"" + , hn + , "\". " + , "Did you mean any of the following?\n" + , unlines name + ] + InstallUnitExes errorMessage -> errorMessage + SelectComponentTargetError render -> render + SdistActionException errs -> unlines errs + Can'tWriteMultipleTarballs -> "Can't write multiple tarballs to standard output!" + ImpossibleHappened pkg -> "The impossible happened: a local package isn't local" <> pkg + CannotConvertTarballPackage format -> "cannot convert tarball package to " ++ format + Win32SelfUpgradeNotNeeded -> "win32selfupgrade not needed except on win32" + FreezeException errs -> errs + PkgSpecifierException errorStr -> unlines errorStr + CorruptedIndexCache str -> str instance Exception (VerboseException CabalInstallException) where displayException :: VerboseException CabalInstallException -> [Char] diff --git a/cabal-install/src/Distribution/Client/Freeze.hs b/cabal-install/src/Distribution/Client/Freeze.hs index 2402d5dd9e4..9bc4e3234b5 100644 --- a/cabal-install/src/Distribution/Client/Freeze.hs +++ b/cabal-install/src/Distribution/Client/Freeze.hs @@ -76,7 +76,6 @@ import Distribution.Simple.Setup ) import Distribution.Simple.Utils ( debug - , die' , dieWithException , notice , toUTF8LBS @@ -215,7 +214,7 @@ planPackages notice verbosity "Resolving dependencies..." installPlan <- - foldProgress logMsg (die' verbosity) return $ + foldProgress logMsg (dieWithException verbosity . FreezeException) return $ resolveDependencies platform (compilerInfo comp) diff --git a/cabal-install/src/Distribution/Client/Get.hs b/cabal-install/src/Distribution/Client/Get.hs index c0ed0083474..99ebe749161 100644 --- a/cabal-install/src/Distribution/Client/Get.hs +++ b/cabal-install/src/Distribution/Client/Get.hs @@ -45,8 +45,7 @@ import Distribution.Simple.Setup , fromFlagOrDefault ) import Distribution.Simple.Utils - ( die' - , dieWithException + ( dieWithException , info , notice , warn @@ -124,7 +123,7 @@ get verbosity repoCtxt _ getFlags userTargets = do userTargets pkgs <- - either (die' verbosity . unlines . map show) return $ + either (dieWithException verbosity . PkgSpecifierException . map show) return $ resolveWithoutDependencies (resolverParams sourcePkgDb pkgSpecifiers) diff --git a/cabal-install/src/Distribution/Client/HttpUtils.hs b/cabal-install/src/Distribution/Client/HttpUtils.hs index 5b470a8f80f..39251039a36 100644 --- a/cabal-install/src/Distribution/Client/HttpUtils.hs +++ b/cabal-install/src/Distribution/Client/HttpUtils.hs @@ -60,7 +60,7 @@ import Distribution.Simple.Utils ( IOData (..) , copyFileVerbose , debug - , die' + , dieWithException , info , notice , warn @@ -127,6 +127,7 @@ import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy.Char8 as LBS8 import qualified Data.Char as Char +import Distribution.Client.Errors import qualified Distribution.Compat.CharParsing as P ------------------------------------------------------------------------------ @@ -180,8 +181,7 @@ downloadURI transport verbosity uri path = do Right expected -> return (NeedsDownload (Just expected)) -- we failed to parse uriFragment Left err -> - die' verbosity $ - "Cannot parse URI fragment " ++ uriFrag ++ " " ++ err + dieWithException verbosity $ CannotParseURIFragment uriFrag err else -- if there are no uri fragment, use ETag do etagPathExists <- doesFileExist etagPath @@ -216,15 +216,8 @@ downloadURI transport verbosity uri path = do contents <- LBS.readFile tmpFile let actual = SHA256.hashlazy contents unless (actual == expected) $ - die' verbosity $ - unwords - [ "Failed to download" - , show uri - , ": SHA256 don't match; expected:" - , BS8.unpack (Base16.encode expected) - , "actual:" - , BS8.unpack (Base16.encode actual) - ] + dieWithException verbosity $ + MakeDownload uri expected actual (200, Just newEtag) -> writeFile etagPath newEtag _ -> return () @@ -237,11 +230,7 @@ downloadURI transport verbosity uri path = do notice verbosity "Skipping download: local and remote files match." return FileAlreadyInCache errCode -> - die' verbosity $ - "failed to download " - ++ show uri - ++ " : HTTP code " - ++ show errCode + dieWithException verbosity $ FailedToDownloadURI uri (show errCode) etagPath = path <.> "etag" uriFrag = uriFragment uri @@ -267,22 +256,14 @@ remoteRepoCheckHttps :: Verbosity -> HttpTransport -> RemoteRepo -> IO () remoteRepoCheckHttps verbosity transport repo | uriScheme (remoteRepoURI repo) == "https:" , not (transportSupportsHttps transport) = - die' verbosity $ - "The remote repository '" - ++ unRepoName (remoteRepoName repo) - ++ "' specifies a URL that " - ++ requiresHttpsErrorMessage + dieWithException verbosity $ RemoteRepoCheckHttps (unRepoName (remoteRepoName repo)) requiresHttpsErrorMessage | otherwise = return () transportCheckHttps :: Verbosity -> HttpTransport -> URI -> IO () transportCheckHttps verbosity transport uri | uriScheme uri == "https:" , not (transportSupportsHttps transport) = - die' verbosity $ - "The URL " - ++ show uri - ++ " " - ++ requiresHttpsErrorMessage + dieWithException verbosity $ TransportCheckHttps uri requiresHttpsErrorMessage | otherwise = return () requiresHttpsErrorMessage :: String @@ -303,17 +284,7 @@ remoteRepoTryUpgradeToHttps verbosity transport repo , uriScheme (remoteRepoURI repo) == "http:" , not (transportSupportsHttps transport) , not (transportManuallySelected transport) = - die' verbosity $ - "The builtin HTTP implementation does not support HTTPS, but using " - ++ "HTTPS for authenticated uploads is recommended. " - ++ "The transport implementations with HTTPS support are " - ++ intercalate ", " [name | (name, _, True, _) <- supportedTransports] - ++ "but they require the corresponding external program to be " - ++ "available. You can either make one available or use plain HTTP by " - ++ "using the global flag --http-transport=plain-http (or putting the " - ++ "equivalent in the config file). With plain HTTP, your password " - ++ "is sent using HTTP digest authentication so it cannot be easily " - ++ "intercepted, but it is not as secure as using HTTPS." + dieWithException verbosity $ TryUpgradeToHttps [name | (name, _, True, _) <- supportedTransports] | remoteRepoShouldTryHttps repo , uriScheme (remoteRepoURI repo) == "http:" , transportSupportsHttps transport = @@ -395,7 +366,7 @@ noPostYet -> String -> Maybe Auth -> IO (Int, String) -noPostYet verbosity _ _ _ = die' verbosity "Posting (for report upload) is not implemented yet" +noPostYet verbosity _ _ _ = dieWithException verbosity NoPostYet supportedTransports :: [ ( String @@ -447,13 +418,7 @@ configureTransport verbosity extraPath (Just name) = let transport = fromMaybe (error "configureTransport: failed to make transport") $ mkTrans progdb return transport{transportManuallySelected = True} Nothing -> - die' verbosity $ - "Unknown HTTP transport specified: " - ++ name - ++ ". The supported transports are " - ++ intercalate - ", " - [name' | (name', _, _, _) <- supportedTransports] + dieWithException verbosity $ UnknownHttpTransportSpecified name [name' | (name', _, _, _) <- supportedTransports] configureTransport verbosity extraPath Nothing = do -- the user hasn't selected a transport, so we'll pick the first one we -- can configure successfully, provided that it supports tls @@ -767,12 +732,7 @@ wgetTransport prog = -- wget returns exit code 8 for server "errors" like "304 not modified" if exitCode == ExitSuccess || exitCode == ExitFailure 8 then return resp - else - die' verbosity $ - "'" - ++ programPath prog - ++ "' exited with an error:\n" - ++ resp + else dieWithException verbosity $ WGetServerError (programPath prog) resp -- With the --server-response flag, wget produces output with the full -- http server response with all headers, we want to find a line like @@ -1081,9 +1041,7 @@ plainHttpTransport = p <- fixupEmptyProxy <$> fetchProxy True Exception.handleJust (guard . isDoesNotExistError) - ( const . die' verbosity $ - "Couldn't establish HTTP connection. " - ++ "Possible cause: HTTP proxy server is down." + ( const . dieWithException verbosity $ Couldn'tEstablishHttpConnection ) $ browse $ do @@ -1121,12 +1079,7 @@ userAgent = statusParseFail :: Verbosity -> URI -> String -> IO a statusParseFail verbosity uri r = - die' verbosity $ - "Failed to download " - ++ show uri - ++ " : " - ++ "No Status Code could be parsed from response: " - ++ r + dieWithException verbosity $ StatusParseFail uri r ------------------------------------------------------------------------------ -- Multipart stuff partially taken from cgi package. diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index c1d6a7068ef..e2ea4486426 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -95,7 +95,6 @@ import Distribution.Simple.Program ) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose - , die' , dieWithException , fromUTF8LBS , info @@ -1092,7 +1091,7 @@ packageListFromCache verbosity mkPkg hnd Cache{..} = accum mempty [] mempty cach -- -- If a corrupted index cache is detected this function regenerates -- the index cache and then reattempt to read the index once (and --- 'die's if it fails again). +-- 'dieWithException's if it fails again). readIndexCache :: Verbosity -> Index -> IO Cache readIndexCache verbosity index = do cacheOrFail <- readIndexCache' index @@ -1108,7 +1107,7 @@ readIndexCache verbosity index = do updatePackageIndexCacheFile verbosity index - either (die' verbosity) (return . hashConsCache) =<< readIndexCache' index + either (dieWithException verbosity . CorruptedIndexCache) (return . hashConsCache) =<< readIndexCache' index Right res -> return (hashConsCache res) readNoIndexCache :: Verbosity -> Index -> IO NoIndexCache @@ -1126,7 +1125,7 @@ readNoIndexCache verbosity index = do updatePackageIndexCacheFile verbosity index - either (die' verbosity) return =<< readNoIndexCache' index + either (dieWithException verbosity . CorruptedIndexCache) return =<< readNoIndexCache' index -- we don't hash cons local repository cache, they are hopefully small Right res -> return res diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs index 578faf5a16e..e1f855cdafe 100644 --- a/cabal-install/src/Distribution/Client/Install.hs +++ b/cabal-install/src/Distribution/Client/Install.hs @@ -225,7 +225,7 @@ import Distribution.Simple.Utils import Distribution.Simple.Utils as Utils ( debug , debugNoWrap - , die' + , dieWithException , info , notice , warn @@ -266,6 +266,7 @@ import Distribution.Version ) import qualified Data.ByteString as BS +import Distribution.Client.Errors -- TODO: @@ -342,7 +343,7 @@ install case planResult of Left message -> do reportPlanningFailure verbosity args installContext message - die'' message + die'' $ ReportPlanningFailure message Right installPlan -> processInstallPlan verbosity args installContext installPlan where @@ -362,7 +363,7 @@ install , benchmarkFlags ) - die'' = die' verbosity + die'' = dieWithException verbosity logMsg message rest = debugNoWrap verbosity message >> rest @@ -794,9 +795,7 @@ checkPrintPlan -- particular, if we can see that packages are likely to be broken, we even -- bail out (unless installation has been forced with --force-reinstalls). when containsReinstalls $ do - if breaksPkgs - then do - (if dryRun || overrideReinstall then warn else die') verbosity $ + let errorStr = unlines $ "The following packages are likely to be broken by the reinstalls:" : map (prettyShow . mungedId) newBrokenPkgs @@ -809,6 +808,12 @@ checkPrintPlan ++ "the plan contains dangerous reinstalls." ] else ["Use --force-reinstalls if you want to install anyway."] + if breaksPkgs + then do + ( if dryRun || overrideReinstall + then warn verbosity errorStr + else dieWithException verbosity $ BrokenException errorStr + ) else unless dryRun $ warn @@ -828,11 +833,8 @@ checkPrintPlan . filterM (fmap isNothing . checkFetched . srcpkgSource) $ pkgs unless (null notFetched) $ - die' verbosity $ - "Can't download packages in offline mode. " - ++ "Must download the following packages to proceed:\n" - ++ intercalate ", " (map prettyShow notFetched) - ++ "\nTry using 'cabal fetch'." + dieWithException verbosity $ + Can'tDownloadPackagesOffline (map prettyShow notFetched) where nothingToInstall = null (fst (InstallPlan.ready installPlan)) @@ -1346,11 +1348,9 @@ printBuildFailures verbosity buildOutcomes = ] of [] -> return () failed -> - die' verbosity . unlines $ - "Some packages failed to install:" - : [ prettyShow pkgid ++ printFailureReason reason - | (pkgid, reason) <- failed - ] + dieWithException verbosity $ + SomePackagesFailedToInstall $ + map (\(pkgid, reason) -> (prettyShow pkgid, printFailureReason reason)) failed where printFailureReason reason = case reason of GracefulFailure msg -> msg @@ -1760,8 +1760,8 @@ installLocalTarballPackage extractTarGzFile tmpDirPath relUnpackedPath tarballPath exists <- doesFileExist descFilePath unless exists $ - die' verbosity $ - "Package .cabal file not found: " ++ show descFilePath + dieWithException verbosity $ + PackageDotCabalFileNotFound descFilePath maybeRenameDistDir absUnpackedPath installPkg (Just absUnpackedPath) where @@ -2042,9 +2042,7 @@ installUnpackedPackage pkgConfParseFailed :: String -> IO a pkgConfParseFailed perror = - die' verbosity $ - "Couldn't parse the output of 'setup register --gen-pkg-config':" - ++ show perror + dieWithException verbosity $ PkgConfParsedFailed perror maybeLogPath :: IO (Maybe FilePath) maybeLogPath = diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index 450ac9d7a37..fdf01b90708 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -193,7 +193,7 @@ import qualified Distribution.Simple.Setup as Setup import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose , debugNoWrap - , die' + , dieWithException , notice , noticeNoWrap , ordNub @@ -221,6 +221,7 @@ import qualified Data.Map as Map import qualified Data.Set as Set #ifdef MIN_VERSION_unix import System.Posix.Signals (sigKILL, sigSEGV) +import Distribution.Client.Errors #endif -- | Tracks what command is being executed, because we need to hide this somewhere @@ -1219,10 +1220,10 @@ dieOnBuildFailures verbosity currentCommand plan buildOutcomes ] dieIfNotHaddockFailure :: Verbosity -> String -> IO () - dieIfNotHaddockFailure - | currentCommand == HaddockCommand = die' - | all isHaddockFailure failuresClassification = warn - | otherwise = die' + dieIfNotHaddockFailure verb str + | currentCommand == HaddockCommand = dieWithException verb $ DieIfNotHaddockFailure str + | all isHaddockFailure failuresClassification = warn verb str + | otherwise = dieWithException verb $ DieIfNotHaddockFailure str where isHaddockFailure (_, ShowBuildSummaryOnly (HaddocksFailed _)) = True diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 1b92a8aa54b..44372967fdb 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -190,6 +190,7 @@ import Data.List (deleteBy, groupBy) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set +import Distribution.Client.Errors import System.FilePath import Text.PrettyPrint (colon, comma, fsep, hang, punctuate, quotes, text, vcat, ($$)) import qualified Text.PrettyPrint as Disp @@ -748,7 +749,7 @@ rebuildInstallPlan case planOrError of Left msg -> do reportPlanningFailure projectConfig compiler platform localPackages - die' verbosity msg + dieWithException verbosity $ PhaseRunSolverErr msg Right plan -> return (plan, pkgConfigDB, tis, ar) where corePackageDbs :: [PackageDB] diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index f25ab462b53..eacf9cd5afe 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -129,7 +129,7 @@ import Distribution.Simple.Setup import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose , createTempDirectory - , die' + , dieWithException , handleDoesNotExist , readUTF8File , warn @@ -192,6 +192,7 @@ import Control.Exception import qualified Data.ByteString.Char8 as BS import Data.ByteString.Lazy () import qualified Data.Set as S +import Distribution.Client.Errors import System.Directory ( canonicalizePath , doesFileExist @@ -488,7 +489,7 @@ readScriptBlock verbosity = parseString parseScriptBlock verbosity "script block readExecutableBlockFromScript :: Verbosity -> BS.ByteString -> IO Executable readExecutableBlockFromScript verbosity str = do str' <- case extractScriptBlock "cabal" str of - Left e -> die' verbosity $ "Failed extracting script block: " ++ e + Left e -> dieWithException verbosity $ FailedExtractingScriptBlock e Right x -> return x when (BS.all isSpace str') $ warn verbosity "Empty script block" readScriptBlock verbosity str' diff --git a/cabal-install/src/Distribution/Client/TargetSelector.hs b/cabal-install/src/Distribution/Client/TargetSelector.hs index 342a8f09d2e..d29413642de 100644 --- a/cabal-install/src/Distribution/Client/TargetSelector.hs +++ b/cabal-install/src/Distribution/Client/TargetSelector.hs @@ -97,27 +97,21 @@ import Distribution.Solver.Types.SourcePackage ) import Distribution.Types.ForeignLib -import Distribution.Client.Utils - ( makeRelativeCanonical - ) -import Distribution.Simple.Utils - ( die' - , lowercase - , ordNub - ) - import Control.Arrow ((&&&)) import Control.Monad hiding ( mfilter ) import Data.List - ( groupBy - , stripPrefix + ( stripPrefix ) import qualified Data.List.NonEmpty as NE import qualified Data.Map.Lazy as Map.Lazy import qualified Data.Map.Strict as Map import qualified Data.Set as Set +import Distribution.Client.Errors +import Distribution.Client.Utils + ( makeRelativeCanonical + ) import Distribution.Deprecated.ParseUtils ( readPToMaybe ) @@ -126,6 +120,11 @@ import Distribution.Deprecated.ReadP , (<++) ) import qualified Distribution.Deprecated.ReadP as Parse +import Distribution.Simple.Utils + ( dieWithException + , lowercase + , ordNub + ) import Distribution.Utils.Path import qualified System.Directory as IO ( canonicalizePath @@ -151,7 +150,6 @@ import Text.EditDistance ( defaultEditCosts , restrictedDamerauLevenshteinDistance ) - import qualified Prelude (foldr1) -- ------------------------------------------------------------ @@ -791,190 +789,78 @@ reportTargetSelectorProblems :: Verbosity -> [TargetSelectorProblem] -> IO a reportTargetSelectorProblems verbosity problems = do case [str | TargetSelectorUnrecognised str <- problems] of [] -> return () - targets -> - die' verbosity $ - unlines - [ "Unrecognised target syntax for '" ++ name ++ "'." - | name <- targets - ] + targets -> dieWithException verbosity $ ReportTargetSelectorProblems targets case [(t, m, ms) | MatchingInternalError t m ms <- problems] of [] -> return () ((target, originalMatch, renderingsAndMatches) : _) -> - die' verbosity $ - "Internal error in target matching: could not make an " - ++ "unambiguous fully qualified target selector for '" - ++ showTargetString target - ++ "'.\n" - ++ "We made the target '" - ++ showTargetSelector originalMatch - ++ "' (" - ++ showTargetSelectorKind originalMatch - ++ ") that was expected to " - ++ "be unambiguous but matches the following targets:\n" - ++ unlines - [ "'" - ++ showTargetString rendering - ++ "', matching:" - ++ concatMap - ("\n - " ++) - [ showTargetSelector match - ++ " (" - ++ showTargetSelectorKind match - ++ ")" - | match <- matches - ] - | (rendering, matches) <- renderingsAndMatches - ] - ++ "\nNote: Cabal expects to be able to make a single fully " - ++ "qualified name for a target or provide a more specific error. " - ++ "Our failure to do so is a bug in cabal. " - ++ "Tracking issue: https://github.com/haskell/cabal/issues/8684" - ++ "\n\nHint: this may be caused by trying to build a package that " - ++ "exists in the project directory but is missing from " - ++ "the 'packages' stanza in your cabal project file." + dieWithException verbosity + $ MatchingInternalErrorErr + (showTargetString target) + (showTargetSelector originalMatch) + (showTargetSelectorKind originalMatch) + $ map + ( \(rendering, matches) -> + ( showTargetString rendering + , (map (\match -> showTargetSelector match ++ " (" ++ showTargetSelectorKind match ++ ")") matches) + ) + ) + renderingsAndMatches case [(t, e, g) | TargetSelectorExpected t e g <- problems] of [] -> return () targets -> - die' verbosity $ - unlines - [ "Unrecognised target '" - ++ showTargetString target - ++ "'.\n" - ++ "Expected a " - ++ intercalate " or " expected - ++ ", rather than '" - ++ got - ++ "'." - | (target, expected, got) <- targets - ] + dieWithException verbosity $ + UnrecognisedTarget $ + map (\(target, expected, got) -> (showTargetString target, expected, got)) targets case [(t, e) | TargetSelectorNoSuch t e <- problems] of [] -> return () targets -> - die' verbosity $ - unlines - [ "Unknown target '" - ++ showTargetString target - ++ "'.\n" - ++ unlines - [ ( case inside of - Just (kind, "") -> - "The " ++ kind ++ " has no " - Just (kind, thing) -> - "The " ++ kind ++ " " ++ thing ++ " has no " - Nothing -> "There is no " - ) - ++ intercalate - " or " - [ mungeThing thing ++ " '" ++ got ++ "'" - | (thing, got, _alts) <- nosuch' - ] - ++ "." - ++ if null alternatives - then "" - else - "\nPerhaps you meant " - ++ intercalate - ";\nor " - [ "the " ++ thing ++ " '" ++ intercalate "' or '" alts ++ "'?" - | (thing, alts) <- alternatives - ] - | (inside, nosuch') <- groupByContainer nosuch - , let alternatives = - [ (thing, alts) - | (thing, _got, alts@(_ : _)) <- nosuch' - ] - ] - | (target, nosuch) <- targets - , let groupByContainer = - map - ( \g@((inside, _, _, _) : _) -> - ( inside - , [ (thing, got, alts) - | (_, thing, got, alts) <- g - ] - ) - ) - . groupBy ((==) `on` (\(x, _, _, _) -> x)) - . sortBy (compare `on` (\(x, _, _, _) -> x)) - ] - where - mungeThing "file" = "file target" - mungeThing thing = thing + dieWithException verbosity $ + NoSuchTargetSelectorErr $ + map (\(target, nosuch) -> (showTargetString target, nosuch)) targets case [(t, ts) | TargetSelectorAmbiguous t ts <- problems] of [] -> return () targets -> - die' verbosity $ - unlines - [ "Ambiguous target '" - ++ showTargetString target - ++ "'. It could be:\n " - ++ unlines - [ " " - ++ showTargetString ut - ++ " (" - ++ showTargetSelectorKind bt - ++ ")" - | (ut, bt) <- amb - ] - | (target, amb) <- targets - ] + dieWithException verbosity $ + TargetSelectorAmbiguousErr $ + map + ( \(target, amb) -> + ( showTargetString target + , (map (\(ut, bt) -> (showTargetString ut, showTargetSelectorKind bt)) amb) + ) + ) + targets case [t | TargetSelectorNoCurrentPackage t <- problems] of [] -> return () target : _ -> - die' verbosity $ - "The target '" - ++ showTargetString target - ++ "' refers to the " - ++ "components in the package in the current directory, but there " - ++ "is no package in the current directory (or at least not listed " - ++ "as part of the project)." + dieWithException verbosity $ TargetSelectorNoCurrentPackageErr (showTargetString target) + -- TODO: report a different error if there is a .cabal file but it's -- not a member of the project case [() | TargetSelectorNoTargetsInCwd True <- problems] of [] -> return () _ : _ -> - die' verbosity $ - "No targets given and there is no package in the current " - ++ "directory. Use the target 'all' for all packages in the " - ++ "project or specify packages or components by name or location. " - ++ "See 'cabal build --help' for more details on target options." + dieWithException verbosity TargetSelectorNoTargetsInCwdTrue case [() | TargetSelectorNoTargetsInCwd False <- problems] of [] -> return () _ : _ -> - die' verbosity $ - "No targets given and there is no package in the current " - ++ "directory. Specify packages or components by name or location. " - ++ "See 'cabal build --help' for more details on target options." + dieWithException verbosity TargetSelectorNoTargetsInCwdFalse case [() | TargetSelectorNoTargetsInProject <- problems] of [] -> return () _ : _ -> - die' verbosity $ - "There is no .cabal package file or cabal.project file. " - ++ "To build packages locally you need at minimum a .cabal " - ++ "file. You can use 'cabal init' to create one.\n" - ++ "\n" - ++ "For non-trivial projects you will also want a cabal.project " - ++ "file in the root directory of your project. This file lists the " - ++ "packages in your project and all other build configuration. " - ++ "See the Cabal user guide for full details." + dieWithException verbosity TargetSelectorNoTargetsInProjectErr case [t | TargetSelectorNoScript t <- problems] of [] -> return () target : _ -> - die' verbosity $ - "The script '" - ++ showTargetString target - ++ "' does not exist, " - ++ "and only script targets may contain whitespace characters or end " - ++ "with ':'" + dieWithException verbosity $ TargetSelectorNoScriptErr (showTargetString target) fail "reportTargetSelectorProblems: internal error" diff --git a/cabal-install/src/Distribution/Client/Utils.hs b/cabal-install/src/Distribution/Client/Utils.hs index 6a744fca3be..59158ffd2a5 100644 --- a/cabal-install/src/Distribution/Client/Utils.hs +++ b/cabal-install/src/Distribution/Client/Utils.hs @@ -68,7 +68,7 @@ import Data.List import Distribution.Compat.Environment import Distribution.Compat.Time (getModTime) import Distribution.Simple.Setup (Flag (..)) -import Distribution.Simple.Utils (die', findPackageDesc, noticeNoWrap) +import Distribution.Simple.Utils (dieWithException, findPackageDesc, noticeNoWrap) import Distribution.System (OS (..), Platform (..)) import Distribution.Version import System.Directory @@ -109,6 +109,7 @@ import qualified System.Directory as Dir import qualified System.IO.Error as IOError #endif import qualified Data.Set as Set +import Distribution.Client.Errors -- | Generic merging utility. For sorted input lists this is a full outer join. mergeBy :: forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b] @@ -394,7 +395,7 @@ tryFindPackageDesc verbosity depPath err = do errOrCabalFile <- findPackageDesc depPath case errOrCabalFile of Right file -> return file - Left _ -> die' verbosity err + Left _ -> dieWithException verbosity $ TryFindPackageDescErr err findOpenProgramLocation :: Platform -> IO (Either String FilePath) findOpenProgramLocation (Platform _ os) = diff --git a/cabal-install/src/Distribution/Client/Win32SelfUpgrade.hs b/cabal-install/src/Distribution/Client/Win32SelfUpgrade.hs index 516cbdb63b3..3e7ceefac63 100644 --- a/cabal-install/src/Distribution/Client/Win32SelfUpgrade.hs +++ b/cabal-install/src/Distribution/Client/Win32SelfUpgrade.hs @@ -218,7 +218,8 @@ setEvent handle = #else -import Distribution.Simple.Utils (die') +import Distribution.Simple.Utils (dieWithException) +import Distribution.Client.Errors possibleSelfUpgrade :: Verbosity -> [FilePath] @@ -226,7 +227,7 @@ possibleSelfUpgrade :: Verbosity possibleSelfUpgrade _ _ action = action deleteOldExeFile :: Verbosity -> Int -> FilePath -> IO () -deleteOldExeFile verbosity _ _ = die' verbosity "win32selfupgrade not needed except on win32" +deleteOldExeFile verbosity _ _ = dieWithException verbosity Win32SelfUpgradeNotNeeded #endif {- FOURMOLU_ENABLE -} From 50aab75cc1c77378f1a4be275699e77bd27694b1 Mon Sep 17 00:00:00 2001 From: SuganyaAK Date: Thu, 12 Oct 2023 10:58:53 -0400 Subject: [PATCH 05/47] Repositioning "import Distribution.Client.Errors" --- cabal-install/src/Distribution/Client/Errors.hs | 6 +++--- .../Distribution/Client/ProjectOrchestration.hs | 16 ++++++++-------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index 1b690ec3ef4..5db31ba5d3b 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -145,7 +145,7 @@ data CabalInstallException | FailedExtractingScriptBlock String | FreezeAction [String] | TryFindPackageDescErr String - | DieIfNotHaddockFailure String + | DieIfNotHaddockFailureException String | ConfigureInstallInternalError | CmdErrorMessages [String] | ReportTargetSelectorProblems [String] @@ -293,7 +293,7 @@ exceptionCodeCabalInstall e = case e of FailedExtractingScriptBlock{} -> 7121 FreezeAction{} -> 7122 TryFindPackageDescErr{} -> 7124 - DieIfNotHaddockFailure{} -> 7125 + DieIfNotHaddockFailureException{} -> 7125 ConfigureInstallInternalError{} -> 7126 CmdErrorMessages{} -> 7127 ReportTargetSelectorProblems{} -> 7128 @@ -630,7 +630,7 @@ exceptionMessageCabalInstall e = case e of "'freeze' doesn't take any extra arguments: " ++ unwords extraArgs TryFindPackageDescErr err -> err - DieIfNotHaddockFailure errorStr -> errorStr + DieIfNotHaddockFailureException errorStr -> errorStr ConfigureInstallInternalError -> "internal error: configure install plan should have exactly " ++ "one local ready package." diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index fdf01b90708..18ea8cf826c 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -170,6 +170,11 @@ import Distribution.Types.UnqualComponentName import Distribution.Solver.Types.OptionalStanza +import Control.Exception (assert) +import qualified Data.List.NonEmpty as NE +import qualified Data.Map as Map +import qualified Data.Set as Set +import Distribution.Client.Errors import Distribution.Package import Distribution.Simple.Command (commandShowOptions) import Distribution.Simple.Compiler @@ -214,14 +219,9 @@ import Distribution.Verbosity import Distribution.Version ( mkVersion ) - -import Control.Exception (assert) -import qualified Data.List.NonEmpty as NE -import qualified Data.Map as Map -import qualified Data.Set as Set #ifdef MIN_VERSION_unix import System.Posix.Signals (sigKILL, sigSEGV) -import Distribution.Client.Errors + #endif -- | Tracks what command is being executed, because we need to hide this somewhere @@ -1221,9 +1221,9 @@ dieOnBuildFailures verbosity currentCommand plan buildOutcomes dieIfNotHaddockFailure :: Verbosity -> String -> IO () dieIfNotHaddockFailure verb str - | currentCommand == HaddockCommand = dieWithException verb $ DieIfNotHaddockFailure str + | currentCommand == HaddockCommand = dieWithException verb $ DieIfNotHaddockFailureException str | all isHaddockFailure failuresClassification = warn verb str - | otherwise = dieWithException verb $ DieIfNotHaddockFailure str + | otherwise = dieWithException verb $ DieIfNotHaddockFailureException str where isHaddockFailure (_, ShowBuildSummaryOnly (HaddocksFailed _)) = True From 6b38770d04455fe960f054a7f4342bf6029f31d8 Mon Sep 17 00:00:00 2001 From: SuganyaAK Date: Fri, 13 Oct 2023 10:20:45 -0400 Subject: [PATCH 06/47] Accepting new error outputs --- .../UseLocalPackage/use-local-version-of-package.out | 3 ++- .../use-local-package-as-setup-dep.out | 3 ++- cabal-testsuite/PackageTests/CustomSegfault/cabal.out | 3 ++- .../PackageTests/CustomWithoutCabal/cabal.out | 3 ++- .../PackageTests/CustomWithoutCabalDefaultMain/cabal.out | 3 ++- cabal-testsuite/PackageTests/ExtraProgPath/setup.out | 3 ++- .../PackageTests/MultiRepl/CabalTooOld/cabal.out | 3 ++- .../PackageTests/MultipleLibraries/Failing/cabal.out | 3 ++- .../NewBuild/CmdRun/MultiplePackages/cabal.out | 9 ++++++--- .../PackageTests/NewBuild/CmdRun/ScriptBad/cabal.out | 3 ++- .../PackageTests/NewBuild/MonitorCabalFiles/cabal.out | 3 ++- cabal-testsuite/PackageTests/NewBuild/T3978/cabal.out | 3 ++- cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out | 6 ++++-- .../PackageTests/NewSdist/MultiTarget/all-test-sute.out | 3 ++- .../NewSdist/MultiTarget/multi-archive-to-stdout.out | 3 ++- .../NewSdist/MultiTarget/target-remote-package.out | 3 ++- .../NewSdist/MultiTarget/valid-and-test-suite.out | 3 ++- cabal-testsuite/PackageTests/OfflineFlag/offlineFlag.out | 3 ++- .../PackageTests/PackageDB/cabal-fail-no-base.out | 3 ++- .../PackageTests/PackageDB/cabal-fail-no-p.out | 3 ++- .../PackageTests/Regression/T6961/DepInternal/cabal.out | 3 ++- .../PackageTests/Regression/T7234/Fail/cabal.out | 3 ++- ...cabal.single-repl-options-multiple-flags-negative.out | 3 ++- .../ShowBuildInfo/CompileFail/compile-fail.out | 6 ++++-- 24 files changed, 56 insertions(+), 28 deletions(-) diff --git a/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.out b/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.out index 34cd406b7e1..a1636d8cbff 100644 --- a/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.out +++ b/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackage/use-local-version-of-package.out @@ -12,7 +12,8 @@ Building executable 'my-exe' for pkg-1.0... local pkg-1.0 # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] next goal: pkg (user goal) [__0] rejecting: pkg-2.0 (constraint from user target requires ==1.0) [__0] rejecting: pkg-1.0 (constraint from command line flag requires ==2.0) diff --git a/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.out b/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.out index 2f2efe78a01..482ff118031 100644 --- a/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.out +++ b/cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/use-local-package-as-setup-dep.out @@ -2,7 +2,8 @@ Downloading the latest package list from test-local-repo # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: pkg-1.0 (user goal) [__1] next goal: setup-dep (user goal) [__1] rejecting: setup-dep-2.0 (conflict: pkg => setup-dep>=1 && <2) diff --git a/cabal-testsuite/PackageTests/CustomSegfault/cabal.out b/cabal-testsuite/PackageTests/CustomSegfault/cabal.out index 14a01a7e1ea..80f27e69b58 100644 --- a/cabal-testsuite/PackageTests/CustomSegfault/cabal.out +++ b/cabal-testsuite/PackageTests/CustomSegfault/cabal.out @@ -3,4 +3,5 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - plain-0.1.0.0 (lib:plain) (first run) -Error: cabal: Failed to build plain-0.1.0.0-inplace. The failure occurred during the configure step. The build process segfaulted (i.e. SIGSEGV). +Error: [Cabal-7125] +Failed to build plain-0.1.0.0-inplace. The failure occurred during the configure step. The build process segfaulted (i.e. SIGSEGV). diff --git a/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.out b/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.out index 76b53a86051..74d7f6adf31 100644 --- a/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.out +++ b/cabal-testsuite/PackageTests/CustomWithoutCabal/cabal.out @@ -3,4 +3,5 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - custom-setup-without-cabal-1.0 (lib:custom-setup-without-cabal) (first run) -Error: cabal: Failed to build custom-setup-without-cabal-1.0-inplace. The failure occurred during the configure step. +Error: [Cabal-7125] +Failed to build custom-setup-without-cabal-1.0-inplace. The failure occurred during the configure step. diff --git a/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.out b/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.out index 047919ab3c0..0e26184375c 100644 --- a/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.out +++ b/cabal-testsuite/PackageTests/CustomWithoutCabalDefaultMain/cabal.out @@ -3,4 +3,5 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - custom-setup-without-cabal-defaultMain-1.0 (lib:custom-setup-without-cabal-defaultMain) (first run) -Error: cabal: Failed to build custom-setup-without-cabal-defaultMain-1.0-inplace. The failure occurred during the configure step. +Error: [Cabal-7125] +Failed to build custom-setup-without-cabal-defaultMain-1.0-inplace. The failure occurred during the configure step. diff --git a/cabal-testsuite/PackageTests/ExtraProgPath/setup.out b/cabal-testsuite/PackageTests/ExtraProgPath/setup.out index b0edde0184f..ea86cfd0f9d 100644 --- a/cabal-testsuite/PackageTests/ExtraProgPath/setup.out +++ b/cabal-testsuite/PackageTests/ExtraProgPath/setup.out @@ -4,7 +4,8 @@ Warning: cannot determine version of /./pkg-config : Warning: cannot determine version of /./pkg-config : "" Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] next goal: CheckExtraProgPath (user goal) [__0] rejecting: CheckExtraProgPath-0.1 (conflict: pkg-config package zlib-any, not found in the pkg-config database) [__0] fail (backjumping, conflict set: CheckExtraProgPath) diff --git a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out index 9ad696f6e06..f2253c67190 100644 --- a/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out +++ b/cabal-testsuite/PackageTests/MultiRepl/CabalTooOld/cabal.out @@ -2,7 +2,8 @@ Downloading the latest package list from test-local-repo # cabal v2-repl Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: pkg-a-0 (user goal) [__1] next goal: pkg-a:setup.Cabal (dependency of pkg-a) [__1] rejecting: pkg-a:setup.Cabal-/installed-, pkg-a:setup.Cabal-3.8.0.0 (constraint from --enable-multi-repl requires >=3.11) diff --git a/cabal-testsuite/PackageTests/MultipleLibraries/Failing/cabal.out b/cabal-testsuite/PackageTests/MultipleLibraries/Failing/cabal.out index 70a8f67c60c..5dee45c63bd 100644 --- a/cabal-testsuite/PackageTests/MultipleLibraries/Failing/cabal.out +++ b/cabal-testsuite/PackageTests/MultipleLibraries/Failing/cabal.out @@ -1,6 +1,7 @@ # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: d-0.1.0.0 (user goal) [__1] next goal: p (user goal) [__1] rejecting: p-0.1.0.0 (requires library 'privatelib' from d, but the component is private) diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.out index ea267330ab0..7f851dca6a8 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/MultiplePackages/cabal.out @@ -22,18 +22,21 @@ Configuring executable 'foo-exe' for bar-1.0... Preprocessing executable 'foo-exe' for bar-1.0... Building executable 'foo-exe' for bar-1.0... # cabal v2-run -Error: cabal: No targets given and there is no package in the current directory. Specify packages or components by name or location. See 'cabal build --help' for more details on target options. +Error: [Cabal-7135] +No targets given and there is no package in the current directory. Specify packages or components by name or location. See 'cabal build --help' for more details on target options. # cabal v2-run Error: [Cabal-7070] The run command is for running a single executable at once. The target 'bar' refers to the package bar-1.0 which includes - executables: bar-exe and foo-exe # cabal v2-run -Error: cabal: Ambiguous target 'foo-exe'. It could be: +Error: [Cabal-7132] +Ambiguous target 'foo-exe'. It could be: bar:foo-exe (component) foo:foo-exe (component) # cabal v2-run -Error: cabal: Unknown target 'foo:bar-exe'. +Error: [Cabal-7131] +Unknown target 'foo:bar-exe'. The package foo has no component 'bar-exe'. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.out index a86629db957..be36f8398e0 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.out @@ -1,2 +1,3 @@ # cabal v2-run -Error: cabal: Failed extracting script block: `{- cabal:` start marker not found +Error: [Cabal-7121] +Failed extracting script block: `{- cabal:` start marker not found diff --git a/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.out b/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.out index 4d477d75ead..93f0fd7f938 100644 --- a/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/MonitorCabalFiles/cabal.out @@ -6,7 +6,8 @@ In order, the following will be built: Configuring executable 'q' for q-0.1.0.0... Preprocessing executable 'q' for q-0.1.0.0... Building executable 'q' for q-0.1.0.0... -Error: cabal: Failed to build q-0.1.0.0-inplace-q. +Error: [Cabal-7125] +Failed to build q-0.1.0.0-inplace-q. # cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 diff --git a/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.out b/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.out index d7eab819ced..bb8adff32b7 100644 --- a/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/T3978/cabal.out @@ -1,6 +1,7 @@ # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: p-1.0 (user goal) [__1] next goal: q (user goal) [__1] rejecting: q-1.0 (requires library from p, but the component is not buildable in the current environment) diff --git a/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out b/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out index 85f6c8b8d46..b1bcf12d3fa 100644 --- a/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out +++ b/cabal-testsuite/PackageTests/NewHaddock/Fails/cabal.out @@ -6,11 +6,13 @@ In order, the following will be built: Configuring library for example-1.0... Preprocessing library for example-1.0... Building library for example-1.0... -Error: cabal: Failed to build example-1.0-inplace. +Error: [Cabal-7125] +Failed to build example-1.0-inplace. # cabal v2-haddock Build profile: -w ghc- -O1 In order, the following will be built: - example-1.0 (lib) (first run) Preprocessing library for example-1.0... Running Haddock on library for example-1.0... -Error: cabal: Failed to build documentation for example-1.0-inplace. +Error: [Cabal-7125] +Failed to build documentation for example-1.0-inplace. diff --git a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.out b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.out index ba0ecc3744a..83628c9a8e2 100644 --- a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.out +++ b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/all-test-sute.out @@ -1,2 +1,3 @@ # cabal v2-sdist -Error: cabal: It is not possible to package only the test suites from a package for distribution. Only entire packages may be packaged for distribution. +Error: [Cabal-7151] +It is not possible to package only the test suites from a package for distribution. Only entire packages may be packaged for distribution. diff --git a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.out b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.out index 9efe2ff9aa7..e8bc3312c87 100644 --- a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.out +++ b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/multi-archive-to-stdout.out @@ -1,2 +1,3 @@ # cabal v2-sdist -Error: cabal: Can't write multiple tarballs to standard output! +Error: [Cabal-7152] +Can't write multiple tarballs to standard output! diff --git a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.out b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.out index 0be39008046..386eaff9b13 100644 --- a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.out +++ b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/target-remote-package.out @@ -1,2 +1,3 @@ # cabal v2-sdist -Error: cabal: The package base cannot be packaged for distribution, because it is not local to this project. +Error: [Cabal-7151] +The package base cannot be packaged for distribution, because it is not local to this project. diff --git a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.out b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.out index 84893e64795..6c1e881f806 100644 --- a/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.out +++ b/cabal-testsuite/PackageTests/NewSdist/MultiTarget/valid-and-test-suite.out @@ -1,2 +1,3 @@ # cabal v2-sdist -Error: cabal: The component test suite 'a-tests' cannot be packaged for distribution on its own. Only entire packages may be packaged for distribution. +Error: [Cabal-7151] +The component test suite 'a-tests' cannot be packaged for distribution on its own. Only entire packages may be packaged for distribution. diff --git a/cabal-testsuite/PackageTests/OfflineFlag/offlineFlag.out b/cabal-testsuite/PackageTests/OfflineFlag/offlineFlag.out index 63fafdab661..a7b18a253a6 100644 --- a/cabal-testsuite/PackageTests/OfflineFlag/offlineFlag.out +++ b/cabal-testsuite/PackageTests/OfflineFlag/offlineFlag.out @@ -6,7 +6,8 @@ Build profile: -w ghc- -O1 In order, the following will be built: - remote-0.1.0.0 (lib) (requires build) - current-0.1.0.0 (exe:current) (first run) -Error: cabal: --offline was specified, hence refusing to download the package: remote version 0.1.0.0. +Error: [Cabal-7125] +--offline was specified, hence refusing to download the package: remote version 0.1.0.0. # cabal v2-build Build profile: -w ghc- -O1 In order, the following will be built: diff --git a/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-base.out b/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-base.out index 933a6476350..506ac48f14e 100644 --- a/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-base.out +++ b/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-base.out @@ -9,7 +9,8 @@ Installing library in Registering library for p-1.0... # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: q-1.0 (user goal) [__1] unknown package: base (dependency of q) [__1] fail (backjumping, conflict set: base, q) diff --git a/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-p.out b/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-p.out index 93d0d0c3f8c..2235fc32f50 100644 --- a/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-p.out +++ b/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-p.out @@ -9,7 +9,8 @@ Installing library in Registering library for p-1.0... # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: q-1.0 (user goal) [__1] unknown package: p (dependency of q) [__1] fail (backjumping, conflict set: p, q) diff --git a/cabal-testsuite/PackageTests/Regression/T6961/DepInternal/cabal.out b/cabal-testsuite/PackageTests/Regression/T6961/DepInternal/cabal.out index 9e4c288b45e..cda3c265371 100644 --- a/cabal-testsuite/PackageTests/Regression/T6961/DepInternal/cabal.out +++ b/cabal-testsuite/PackageTests/Regression/T6961/DepInternal/cabal.out @@ -1,6 +1,7 @@ # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] trying: pkg-bar-0 (user goal) [__1] next goal: pkg-foo (user goal) [__1] rejecting: pkg-foo-0 (library 'internal-lib' is private, but it is required by pkg-bar) diff --git a/cabal-testsuite/PackageTests/Regression/T7234/Fail/cabal.out b/cabal-testsuite/PackageTests/Regression/T7234/Fail/cabal.out index 4ae907f41f3..5c8ed7ba2c5 100644 --- a/cabal-testsuite/PackageTests/Regression/T7234/Fail/cabal.out +++ b/cabal-testsuite/PackageTests/Regression/T7234/Fail/cabal.out @@ -1,6 +1,7 @@ # cabal v2-build Resolving dependencies... -Error: cabal: Could not resolve dependencies: +Error: [Cabal-7107] +Could not resolve dependencies: [__0] next goal: issue7234 (user goal) [__0] rejecting: issue7234-0 (conflict: requires unknown extension HopefullyThisExtensionWontOccur) [__0] fail (backjumping, conflict set: issue7234) diff --git a/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags-negative.out b/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags-negative.out index 667ffe5ae2f..ba1bbef88db 100644 --- a/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags-negative.out +++ b/cabal-testsuite/PackageTests/ReplOptions/cabal.single-repl-options-multiple-flags-negative.out @@ -6,4 +6,5 @@ In order, the following will be built: - cabal-repl-options-0.1 (interactive) (lib) (first run) Configuring library for cabal-repl-options-0.1... Preprocessing library for cabal-repl-options-0.1... -Error: cabal: repl failed for cabal-repl-options-0.1-inplace. +Error: [Cabal-7125] +repl failed for cabal-repl-options-0.1-inplace. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/CompileFail/compile-fail.out b/cabal-testsuite/PackageTests/ShowBuildInfo/CompileFail/compile-fail.out index 5017f4b5c09..b0cae576cd6 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/CompileFail/compile-fail.out +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/CompileFail/compile-fail.out @@ -10,7 +10,8 @@ Building library for CompileFail-0.1.0.0... Configuring test suite 'CompileFail-test' for CompileFail-0.1.0.0... Preprocessing test suite 'CompileFail-test' for CompileFail-0.1.0.0... Building test suite 'CompileFail-test' for CompileFail-0.1.0.0... -Error: cabal: Failed to build CompileFail-0.1.0.0-inplace-CompileFail-test. +Error: [Cabal-7125] +Failed to build CompileFail-0.1.0.0-inplace-CompileFail-test. # cabal build Build profile: -w ghc- -O1 In order, the following will be built: @@ -19,5 +20,6 @@ In order, the following will be built: Configuring library 'failing' for CompileFail-0.1.0.0... Preprocessing library 'failing' for CompileFail-0.1.0.0... Building library 'failing' for CompileFail-0.1.0.0... -Error: cabal: Failed to build CompileFail-0.1.0.0 because it depends on CompileFail-0.1.0.0 which itself failed to build. +Error: [Cabal-7125] +Failed to build CompileFail-0.1.0.0 because it depends on CompileFail-0.1.0.0 which itself failed to build. Failed to build CompileFail-0.1.0.0-inplace-failing. From 74b34987c932253e67eea1e278eae1a5034b0f1d Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Wed, 18 Oct 2023 20:39:17 +0100 Subject: [PATCH 07/47] Add instance Foldable1 for Field, FieldLine, SectionArg and Name --- Cabal-syntax/src/Distribution/Fields/Field.hs | 31 +++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index 7f5b85809aa..c119ca5f1c0 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} @@ -36,6 +37,9 @@ import Distribution.Compat.Prelude import Distribution.Pretty (showTokenStr) import Distribution.Utils.Generic (fromUTF8BS) import Prelude () +#if MIN_VERSION_base(4,18,0) +import qualified Data.Foldable1 as F1 +#endif ------------------------------------------------------------------------------- -- Cabal file @@ -141,3 +145,30 @@ fieldLinesToString = intercalate "\n" . map toStr where toStr (FieldLine _ bs) = fromUTF8BS bs + +------------------------------------------------------------------------------- +-- Foldable1 +------------------------------------------------------------------------------- + +#if MIN_VERSION_base(4,18,0) + +-- | @since 3.12.0.0 +instance F1.Foldable1 Field where + foldMap1 f (Field x ys) = + F1.fold1 (F1.foldMap1 f x :| map (F1.foldMap1 f) ys) + foldMap1 f (Section x ys zs) = + F1.fold1 (F1.foldMap1 f x :| map (F1.foldMap1 f) ys ++ map (F1.foldMap1 f) zs) + +-- | @since 3.12.0.0 +instance F1.Foldable1 FieldLine where + foldMap1 = (. fieldLineAnn) + +-- | @since 3.12.0.0 +instance F1.Foldable1 SectionArg where + foldMap1 = (. sectionArgAnn) + +-- | @since 3.12.0.0 +instance F1.Foldable1 Name where + foldMap1 = (. nameAnn) + +#endif From 6d52922bcd803bedd445e320757cb1b99ee458e7 Mon Sep 17 00:00:00 2001 From: liamzee Date: Sun, 22 Oct 2023 01:14:14 +0800 Subject: [PATCH 08/47] Add 9 and revise 6 comments. As part of improving DX for new contributors, I have added or revised comments to the Cabal/Distribution.Simple.Flag file, giving it 100% comment coverage, as well as pointing out its isomorphism to Maybe, and adding markdown for internal links. Cabal/Distribution.Utils.IOData received a comment on withIOData, and had the comment on IODataMode expanded. It is still missing a comment on KnownIODataMode. Cabal/Distribution.Lex received a comment on its sole function, so its writer won't get annoyed by newbies unfamiliar with its lexing pattern in the future. Recent comments on Cabal/Distribution.Simple.defaultMainHelper and cabal-install/Distribution.Client.Main.main were amended for clarity, and to note the "--" behavior on Distribution.Client.Main.main's expandResponse. --- Cabal/src/Distribution/Lex.hs | 8 ++++++ Cabal/src/Distribution/Simple.hs | 11 +++++--- Cabal/src/Distribution/Simple/Flag.hs | 25 ++++++++++++++----- Cabal/src/Distribution/Utils/IOData.hs | 6 ++++- cabal-install/src/Distribution/Client/Main.hs | 14 ++++++----- 5 files changed, 47 insertions(+), 17 deletions(-) diff --git a/Cabal/src/Distribution/Lex.hs b/Cabal/src/Distribution/Lex.hs index 4ca1f512ce5..aec37667832 100644 --- a/Cabal/src/Distribution/Lex.hs +++ b/Cabal/src/Distribution/Lex.hs @@ -16,6 +16,14 @@ import Distribution.Compat.DList import Distribution.Compat.Prelude import Prelude () +-- | A simple parser supporting quoted strings. +-- +-- Please be aware that this will only split strings when seeing whitespace +-- outside of quotation marks, i.e, @"foo\"bar baz\"qux quux"@ will be +-- converted to @["foobar bazqux", "quux"]@. +-- +-- This behavior can be useful when parsing text like +-- @"ghc-options: -Wl,\"some option with spaces\""@, for instance. tokenizeQuotedWords :: String -> [String] tokenizeQuotedWords = filter (not . null) . go False mempty where diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs index 0f200922928..024a445f1dc 100644 --- a/Cabal/src/Distribution/Simple.hs +++ b/Cabal/src/Distribution/Simple.hs @@ -155,13 +155,16 @@ defaultMainWithHooksNoReadArgs :: UserHooks -> GenericPackageDescription -> [Str defaultMainWithHooksNoReadArgs hooks pkg_descr = defaultMainHelper hooks{readDesc = return (Just pkg_descr)} --- | Less the helper, and more the central command chooser of --- the Simple build system, with other defaultMain functions acting as --- exposed callers. +-- | The central command chooser of the Simple build system, +-- with other defaultMain functions acting as exposed callers, +-- and with 'topHandler' operating as an exceptions handler. +-- +-- This uses 'expandResponse' to read response files, preprocessing +-- response files given by "@" prefixes. -- -- Given hooks and args, this runs 'commandsRun' onto the args, -- getting 'CommandParse' data back, which is then pattern-matched into --- IO actions for execution. +-- IO actions for execution, with arguments applied by the parser. defaultMainHelper :: UserHooks -> Args -> IO () defaultMainHelper hooks args = topHandler $ do args' <- expandResponse args diff --git a/Cabal/src/Distribution/Simple/Flag.hs b/Cabal/src/Distribution/Simple/Flag.hs index aa35c904c4f..095fe7b9dde 100644 --- a/Cabal/src/Distribution/Simple/Flag.hs +++ b/Cabal/src/Distribution/Simple/Flag.hs @@ -46,18 +46,21 @@ import Prelude () -- -- 1. list flags eg -- --- > --ghc-option=foo --ghc-option=bar +-- > --ghc-option=foo --ghc-option=bar -- --- gives us all the values ["foo", "bar"] +-- gives us all the values ["foo", "bar"] -- -- 2. singular value flags, eg: -- --- > --enable-foo --disable-foo +-- > --enable-foo --disable-foo -- --- gives us Just False --- So this Flag type is for the latter singular kind of flag. +-- gives us Just False +-- +-- So, this 'Flag' type is for the latter singular kind of flag. -- Its monoid instance gives us the behaviour where it starts out as -- 'NoFlag' and later flags override earlier ones. +-- +-- Isomorphic to 'Maybe' a. data Flag a = Flag a | NoFlag deriving (Eq, Generic, Show, Read, Typeable, Foldable, Traversable) instance Binary a => Binary (Flag a) @@ -96,36 +99,46 @@ instance Enum a => Enum (Flag a) where enumFromThenTo (Flag a) (Flag b) (Flag c) = toFlag `map` enumFromThenTo a b c enumFromThenTo _ _ _ = [] +-- | Wraps a value in 'Flag'. toFlag :: a -> Flag a toFlag = Flag +-- | Extracts a value from a 'Flag', and throws an exception on 'NoFlag'. fromFlag :: WithCallStack (Flag a -> a) fromFlag (Flag x) = x fromFlag NoFlag = error "fromFlag NoFlag. Use fromFlagOrDefault" +-- | Extracts a value from a 'Flag', and returns the default value on 'NoFlag'. fromFlagOrDefault :: a -> Flag a -> a fromFlagOrDefault _ (Flag x) = x fromFlagOrDefault def NoFlag = def +-- | Converts a 'Flag' value to a 'Maybe' value. flagToMaybe :: Flag a -> Maybe a flagToMaybe (Flag x) = Just x flagToMaybe NoFlag = Nothing --- | @since 3.4.0.0 +-- | Pushes a function through a 'Flag' value, and returns a default +-- if the 'Flag' value is 'NoFlag'. +-- +-- @since 3.4.0.0 flagElim :: b -> (a -> b) -> Flag a -> b flagElim n _ NoFlag = n flagElim _ f (Flag x) = f x +-- | Converts a 'Flag' value to a list. flagToList :: Flag a -> [a] flagToList (Flag x) = [x] flagToList NoFlag = [] +-- | Returns 'True' only if every 'Flag' 'Bool' value is Flag True, else 'False'. allFlags :: [Flag Bool] -> Flag Bool allFlags flags = if all (\f -> fromFlagOrDefault False f) flags then Flag True else NoFlag +-- | Converts a 'Maybe' value to a 'Flag' value. maybeToFlag :: Maybe a -> Flag a maybeToFlag Nothing = NoFlag maybeToFlag (Just x) = Flag x diff --git a/Cabal/src/Distribution/Utils/IOData.hs b/Cabal/src/Distribution/Utils/IOData.hs index 074576ceaf9..73e86493d1f 100644 --- a/Cabal/src/Distribution/Utils/IOData.hs +++ b/Cabal/src/Distribution/Utils/IOData.hs @@ -28,6 +28,7 @@ data IOData | -- | Raw binary which gets read/written in binary mode. IODataBinary LBS.ByteString +-- | Applies a function polymorphic over 'IODataMode' to an 'IOData' value. withIOData :: IOData -> (forall mode. IODataMode mode -> mode -> r) -> r withIOData (IODataText str) k = k IODataModeText str withIOData (IODataBinary lbs) k = k IODataModeBinary lbs @@ -53,7 +54,10 @@ class NFData mode => KnownIODataMode mode where toIOData :: mode -> IOData iodataMode :: IODataMode mode --- | @since 3.2 +-- | Phantom-typed GADT representation of the mode of 'IOData', containing no +-- other data. +-- +-- @since 3.2 data IODataMode mode where IODataModeText :: IODataMode String IODataModeBinary :: IODataMode LBS.ByteString diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 4c9269fe271..6d8c0e187aa 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -274,10 +274,13 @@ import System.IO -- signals, preparing console linebuffering, and relaxing encoding errors. -- -- Two, it processes (via an IO action) response --- files, calling expandResponse in Cabal/Distribution.Compat.ResponseFile +-- files, calling 'expandResponse' in Cabal/Distribution.Compat.ResponseFile -- --- Three, it calls the mainWorker, which calls the argument parser, --- producing CommandParse data, which mainWorker pattern-matches +-- Note that here, it splits the arguments on a strict match to +-- "--", and won't parse response files after the split. +-- +-- Three, it calls the 'mainWorker', which calls the argument parser, +-- producing 'CommandParse' data, which mainWorker pattern-matches -- into IO actions for execution. main :: [String] -> IO () main args = do @@ -293,8 +296,7 @@ main args = do relaxEncodingErrors stderr -- Response files support. - -- See expandResponse documentation in - -- Cabal/Distribution.Compat.ResponseFile + -- See 'expandResponse' documentation in Cabal/Distribution.Compat.ResponseFile -- for more information. let (args0, args1) = break (== "--") args @@ -313,7 +315,7 @@ warnIfAssertionsAreEnabled = assertionsEnabledMsg = "Warning: this is a debug build of cabal-install with assertions enabled." --- | Core worker, similar to defaultMainHelper in Cabal/Distribution.Simple +-- | Core worker, similar to 'defaultMainHelper' in Cabal/Distribution.Simple -- -- With an exception-handler @topHandler@, mainWorker calls commandsRun -- to parse arguments, then pattern-matches the CommandParse data From bc7e8fc53d0c55d0c00c216eb28a5b0d7c3bb831 Mon Sep 17 00:00:00 2001 From: malteneuss Date: Tue, 24 Oct 2023 16:29:44 +0200 Subject: [PATCH 09/47] Restructure Getting Started documentation to be more compact and beginner friendly (#9212) * Rewrite installation section of getting-started.rst * Rephrase creating a package documentation section * Length align titles in getting-started.rst * Fix length alignment in getting-started.rst * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update getting-started.rst * Update doc/getting-started.rst Co-authored-by: brandon s allbery kf8nh * Align package and script example in getting-started.rst * Align example package versions in getting-started.rst * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Added review suggestions * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update doc/getting-started.rst Co-authored-by: Artem Pelenitsyn * Update getting-started.rst Reflow sentence to trigger CI * Update getting-started.rst * Update doc/getting-started.rst --------- Co-authored-by: Artem Pelenitsyn Co-authored-by: brandon s allbery kf8nh Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> --- doc/getting-started.rst | 175 ++++++++++++++++++++++------------------ 1 file changed, 96 insertions(+), 79 deletions(-) diff --git a/doc/getting-started.rst b/doc/getting-started.rst index 416a5dd77ae..4d5ebfe810f 100644 --- a/doc/getting-started.rst +++ b/doc/getting-started.rst @@ -1,90 +1,104 @@ -Getting Started with Haskell and Cabal -====================================== +Getting Started +=============== -Installing the Haskell toolchain --------------------------------- - -To install the Haskell toolchain follow the `ghcup instructions -`__. +Installing Cabal +---------------- +The easiest and recommended way to install the ``cabal`` command-line tool +on Linux, macOS, FreeBSD or Windows is through `ghcup `__. +It installs the “Haskell toolchain”, which includes Cabal, +the Haskell compiler `GHC `__ +and optionally other useful Haskell tools. Creating a new application -------------------------- -Let's start by creating a simple Haskell application from scratch where we'll -learn about a Haskell package's directory structure, how to run the executable, -and how to add external dependencies. +We create a minimal Haskell application to get a quick overview +of the ``cabal`` command-line tool: +1. How to initialize a Haskell package. +2. How files are organized inside a package. +3. How to compile Haskell files and run a resulting executable. +4. How to manage external dependencies. -Initializing the application -^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Initializing an application +^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Start by initialising our ``myfirstapp`` project, these instructions work in -unix shells and PowerShell (if you're on Windows). +To initialize a new Haskell application, run .. code-block:: console - $ cabal init myfirstapp -n - -.. note:: ``myfirstapp`` stands for the directory (or path) where the project - will reside in, if omitted, ``cabal init`` will do its proceedings - in the directory it's called in. + $ cabal init myapp --non-interactive -.. note:: ``-n`` stands for ``--non-interactive``, which means that cabal will try to guess - how to set up the project for you and use the default settings, which will serve us - well for the purpose of this tutorial. - When setting up your projects in the future, you will likely want to omit ``-n`` - and do just ``cabal init``, so that cabal will interactively ask you - for the details on how the project should be set up - (while still offering reasonable defaults on every step). - Also, you can run ``cabal init --help`` to get more info on how ``cabal init`` can be used. - -This will generate the following files: +in a terminal. This generates the following files in a new ``myapp`` directory: .. code-block:: console $ tree . - └── myfirstapp + └── myapp ├── app │   └── Main.hs ├── CHANGELOG.md - └── myfirstapp.cabal + └── myapp.cabal -``app/Main.hs`` is where your package's code lives. +The ``myapp.cabal`` file is a package description file, commonly referred to as a “Cabal file”: -``myfirstapp.cabal`` is Cabal's metadata file which describes your package, -how it is built and its dependencies. We'll be updating this file in a -little bit when we add an external dependency to our package. +.. code-block:: cabal + cabal-version: 3.0 + name: myapp + version: 0.1.0.0 + -- ... -Running the application -^^^^^^^^^^^^^^^^^^^^^^^ + executable myapp + import: warnings + main-is: Main.hs + build-depends: base ^>=4.19.0.0 + hs-source-dirs: app + default-language: Haskell2010 -When we ran ``cabal init myfirstapp -n`` above, it generated a package with a single -executable named same as the package (in this case ``myfirstapp``) that prints -``"Hello, Haskell!"`` to the terminal. To run the executable enter the project's -directory and run it, by inputting the following commands: +It contains metadata (package name and version, author name, license, etc.) and sections +to define package components. Components can be used to split large codebases into smaller, +more managable building blocks. +A component can be of one of several types (executable, library, etc.) and describes, +among other things, the location of source files and its dependencies. +The ``myapp.cabal`` file above defines a single component named ``myapp`` of the executable type. +Inside the ``executable`` section, the ``build-depends`` field lists the dependencies of this component. -.. code-block:: console - cd myfirstapp - cabal run myfirstapp +The ``app/Main.hs`` file is where your executable's code lives: + +.. code-block:: haskell -You should see the following output in the terminal: + module Main where + + main :: IO () + main = putStrLn "Hello, Haskell!" + + +To run the executable, switch into the application directory with ``cd myapp`` and run .. code-block:: console - $ cabal run myfirstapp + $ cabal run myapp ... Hello, Haskell! -Notice that we didn't need to run a `build` command before we ran ``cabal run``. -This is because ``cabal run`` automatically determines if the code needs to be (re)built -before running the executable. -If you just want to build a target without running it, you can do so with ``cabal build``: +This command automatically determines if the executable needs to be (re)built +before running the executable. With only one executable component in the package, +``cabal run`` (without a component name) is smart enough to infer it, so the name can be omitted. + +If you just want to build the executable without running it, run: + +.. code-block:: console -``cabal build myfirstapp`` + $ cabal build + Resolving dependencies... + ... + Building executable 'myapp' for myapp-0.1.0.0.. + [1 of 1] Compiling Main ( app/Main.hs, /home/.../myapp/dist-newstyle/build/.../myapp-tmp/Main.o ) + Linking /home/.../myapp/dist-newstyle/build/.../myapp Adding dependencies @@ -103,16 +117,16 @@ terminal with some embellishment. need to update the package index, you can do this by running ``cabal update``. -In our ``myfirstapp.cabal`` file we'll update the ``build-depends`` attribute of -the ``executable myfirstapp`` section to include ``haskell-say``: +In our ``myapp.cabal`` file, we will update the ``build-depends`` field of +the executable section to include ``haskell-say``: .. code-block:: cabal - executable myfirstapp + executable myapp import: warnings main-is: Main.hs build-depends: - base ^>=4.14.3.0, + base ^>=4.19.0.0, haskell-say ^>=1.0.0.0 hs-source-dirs: app default-language: Haskell2010 @@ -132,8 +146,7 @@ Next we'll update ``app/Main.hs`` to use the ``HaskellSay`` library: import HaskellSay (haskellSay) main :: IO () - main = - haskellSay "Hello, Haskell! You're using a function from another package!" + main = haskellSay "Hello, Haskell!" ``import HaskellSay (haskellSay)`` brings the ``haskellSay`` function from the module named ``HaskellSay`` into scope. The ``HaskellSay`` module is defined in @@ -143,11 +156,10 @@ Now you can build and re-run your code to see the new output: .. code-block:: console - $ cabal run + $ cabal run myapp ________________________________________________________ / \ - | Hello, Haskell! You're using a function from another | - | package! | + | Hello, Haskell! | \____ _____________________________________________/ \ / \ / @@ -166,42 +178,47 @@ Now you can build and re-run your code to see the new output: / / / / \ \ /____/ /____/ \____\ -Run a single-file Haskell script --------------------------------- +Running a single-file Haskell script +------------------------------------ -Cabal also enables us to run single-file Haskell scripts -without creating a project directory or ``.cabal`` file. -The cabal directives are placed in the file within a comment. +Cabal also supports running single-file Haskell scripts like +the following file named ``myscript``: .. code-block:: haskell - + #!/usr/bin/env cabal {- cabal: - build-depends: base, split + build-depends: + base ^>=4.19.0.0, + haskell-say ^>=1.0.0.0 -} - import Data.List.Split (chunksOf) + import HaskellSay (haskellSay) main :: IO () - main = getLine >>= print . chunksOf 3 + main = haskellSay "Hello, Haskell!" -This can be run using ``cabal run myscript``. -On Unix-like systems this can be run directly with execute permission. +The necessary sections of a ``.cabal`` file are placed +directly into the script as a comment. + +Use the familiar ``cabal run`` command to execute this script: .. code-block:: console $ cabal run myscript - $ chmod +x myscript - $ ./myscript - -Project metadata can also be included: +On Unix-like systems, a Haskell script starting with ``#!/usr/bin/env cabal``, like the one above, +can be run directly after setting the execute permission (+x): -.. code-block:: haskell +.. code-block:: console - {- project: - with-compiler: ghc-8.10.7 - -} + $ chmod +x myscript + $ ./myscript + ________________________________________________________ + / \ + | Hello, Haskell! | + \____ ____________________________________________/ + \ ... / See more in the documentation for :ref:`cabal run`. From 0bab7cb924e39c2aea47b8c78416d4b4a1f10c2b Mon Sep 17 00:00:00 2001 From: Shae Erisson Date: Wed, 25 Oct 2023 14:12:59 -0400 Subject: [PATCH 10/47] Use ProjectFlags to define CleanCmd (#9356) * Use ProjectFlags to define CleanCmd The nearly identical PR for #7439 was used as a guide for this PR. The point of this PR is to reduce the duplication of project flag handling. Co-authored-by: Jean-Paul Calderone * remove duplicate support for project-dir * switch use of NamedFieldPuns to RecordWildCards --------- Co-authored-by: Jean-Paul Calderone Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> --- .../src/Distribution/Client/CmdClean.hs | 83 +++++++++---------- 1 file changed, 41 insertions(+), 42 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdClean.hs b/cabal-install/src/Distribution/Client/CmdClean.hs index 0554d632aed..ef481300ef7 100644 --- a/cabal-install/src/Distribution/Client/CmdClean.hs +++ b/cabal-install/src/Distribution/Client/CmdClean.hs @@ -16,19 +16,29 @@ import Distribution.Client.Errors import Distribution.Client.ProjectConfig ( findProjectRoot ) +import Distribution.Client.ProjectFlags + ( ProjectFlags (..) + , defaultProjectFlags + , projectFlagsOptions + , removeIgnoreProjectOption + ) import Distribution.Client.Setup ( GlobalFlags ) -import Distribution.ReadE (succeedReadE) +import Distribution.Compat.Lens + ( _1 + , _2 + ) import Distribution.Simple.Command ( CommandUI (..) + , OptionField + , ShowOrParseArgs + , liftOptionL , option - , reqArg ) import Distribution.Simple.Setup ( Flag (..) , falseArg - , flagToList , flagToMaybe , fromFlagOrDefault , optionDistPref @@ -68,8 +78,6 @@ data CleanFlags = CleanFlags { cleanSaveConfig :: Flag Bool , cleanVerbosity :: Flag Verbosity , cleanDistDir :: Flag FilePath - , cleanProjectDir :: Flag FilePath - , cleanProjectFile :: Flag FilePath } deriving (Eq) @@ -79,11 +87,9 @@ defaultCleanFlags = { cleanSaveConfig = toFlag False , cleanVerbosity = toFlag normal , cleanDistDir = NoFlag - , cleanProjectDir = mempty - , cleanProjectFile = mempty } -cleanCommand :: CommandUI CleanFlags +cleanCommand :: CommandUI (ProjectFlags, CleanFlags) cleanCommand = CommandUI { commandName = "v2-clean" @@ -96,46 +102,39 @@ cleanCommand = ++ "(.hi, .o, preprocessed sources, etc.) and also empties out the " ++ "local caches (by default).\n\n" , commandNotes = Nothing - , commandDefaultFlags = defaultCleanFlags + , commandDefaultFlags = (defaultProjectFlags, defaultCleanFlags) , commandOptions = \showOrParseArgs -> - [ optionVerbosity - cleanVerbosity - (\v flags -> flags{cleanVerbosity = v}) - , optionDistPref - cleanDistDir - (\dd flags -> flags{cleanDistDir = dd}) - showOrParseArgs - , option - [] - ["project-dir"] - "Set the path of the project directory" - cleanProjectDir - (\path flags -> flags{cleanProjectDir = path}) - (reqArg "DIR" (succeedReadE Flag) flagToList) - , option - [] - ["project-file"] - "Set the path of the cabal.project file (relative to the project directory when relative)" - cleanProjectFile - (\pf flags -> flags{cleanProjectFile = pf}) - (reqArg "FILE" (succeedReadE Flag) flagToList) - , option - ['s'] - ["save-config"] - "Save configuration, only remove build artifacts" - cleanSaveConfig - (\sc flags -> flags{cleanSaveConfig = sc}) - falseArg - ] + map + (liftOptionL _1) + (removeIgnoreProjectOption (projectFlagsOptions showOrParseArgs)) + ++ map (liftOptionL _2) (cleanOptions showOrParseArgs) } -cleanAction :: CleanFlags -> [String] -> GlobalFlags -> IO () -cleanAction CleanFlags{..} extraArgs _ = do +cleanOptions :: ShowOrParseArgs -> [OptionField CleanFlags] +cleanOptions showOrParseArgs = + [ optionVerbosity + cleanVerbosity + (\v flags -> flags{cleanVerbosity = v}) + , optionDistPref + cleanDistDir + (\dd flags -> flags{cleanDistDir = dd}) + showOrParseArgs + , option + ['s'] + ["save-config"] + "Save configuration, only remove build artifacts" + cleanSaveConfig + (\sc flags -> flags{cleanSaveConfig = sc}) + falseArg + ] + +cleanAction :: (ProjectFlags, CleanFlags) -> [String] -> GlobalFlags -> IO () +cleanAction (ProjectFlags{..}, CleanFlags{..}) extraArgs _ = do let verbosity = fromFlagOrDefault normal cleanVerbosity saveConfig = fromFlagOrDefault False cleanSaveConfig mdistDirectory = flagToMaybe cleanDistDir - mprojectDir = flagToMaybe cleanProjectDir - mprojectFile = flagToMaybe cleanProjectFile + mprojectDir = flagToMaybe flagProjectDir + mprojectFile = flagToMaybe flagProjectFile -- TODO interpret extraArgs as targets and clean those targets only (issue #7506) -- From d29e487b285d053cd11cbeb3fcc8c6127359971a Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Wed, 25 Oct 2023 21:32:53 +0200 Subject: [PATCH 11/47] =?UTF-8?q?Make=20=E2=80=9Csublibrary=E2=80=9D=20sta?= =?UTF-8?q?ndard=20terminology=20in=20docs?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Substitute “internal library” occourrences with “sublibrary”. --- doc/cabal-package.rst | 24 ++++++++++++------------ doc/file-format-changelog.rst | 6 +++--- doc/setup-commands.rst | 6 +++--- 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/doc/cabal-package.rst b/doc/cabal-package.rst index 9b0e970dbd7..75ec9ff40ed 100644 --- a/doc/cabal-package.rst +++ b/doc/cabal-package.rst @@ -184,7 +184,7 @@ Example: A package containing a library and executable programs executable program2 -- A different main.hs because of hs-source-dirs. main-is: main.hs - -- No bound on internal libraries. + -- No bound on a library provided by the same package. build-depends: TestPackage hs-source-dirs: prog2 other-modules: Utils @@ -806,7 +806,7 @@ Library Starting with Cabal 2.0, sub-library components can be defined by setting the ``name`` field to a name different from the current package's name; see - section on :ref:`Internal Libraries ` for more information. By + section on :ref:`Sublibraries ` for more information. By default, these sub-libraries are private and internal. Since Cabal 3.0, these sub-libraries can also be exposed and used by other packages. See the :pkg-field:`library:visibility` field and :ref:`Multiple Public Libraries @@ -852,7 +852,7 @@ The library section should contain the following fields: :since: 3.0 :default: - ``private`` for internal libraries. Cannot be set for main + ``private`` for sublibraries. Cannot be set for main (unnamed) library, which is always public. Can be ``public`` or ``private``. @@ -861,7 +861,7 @@ The library section should contain the following fields: allowed. If set to ``private``, depending on this library is allowed only from the same package. - See section on :ref:`Internal Libraries ` for examples and more + See section on :ref:`Sublibraries ` for examples and more information. .. pkg-field:: reexported-modules: exportlist @@ -903,13 +903,13 @@ section on `build information`_). .. _sublibs: -**Internal Libraries** +**Sublibraries** -Cabal 2.0 and later support "internal libraries", which are extra named +Cabal 2.0 and later support "sublibraries", which are extra named libraries (as opposed to the usual unnamed library section). For example, suppose that your test suite needs access to some internal modules in your library, which you do not otherwise want to export. You -could put these modules in an internal library, which the main library +could put these modules in a sublibrary, which the main library and the test suite :pkg-field:`build-depends` upon. Then your Cabal file might look something like this: @@ -942,11 +942,11 @@ look something like this: build-depends: foo-internal, base default-language: Haskell2010 -Internal libraries are also useful for packages that define multiple +Sublibraries are also useful for packages that define multiple executables, but do not define a publicly accessible library. Internal libraries are only visible internally in the package (so they can only be added to the :pkg-field:`build-depends` of same-package libraries, -executables, test suites, etc.) Internal libraries locally shadow any +executables, test suites, etc.) Sublibraries locally shadow any packages which have the same name; consequently, don't name an internal library with the same name as an external dependency if you need to be able to refer to the external dependency in a @@ -1003,7 +1003,7 @@ a real-world use case: .. note:: For packages using ``cabal-version: 3.4`` or higher, the syntax to - specify an internal library in a ``build-depends:`` section is + specify a sublibrary in a ``build-depends:`` section is ``package-name:internal-library-name``. .. _publicsublibs: @@ -3370,7 +3370,7 @@ just depending on both ``str-impl`` and ``parametrized``: Note that due to technical limitations, you cannot directly define ``Str`` in the ``combined`` library; it must be placed in its own -library (you can use :ref:`Internal Libraries ` to conveniently +library (you can use :ref:`Sublibraries ` to conveniently define a sub-library). However, a more common situation is that your names don't match up @@ -3402,7 +3402,7 @@ the requirements and provided modules renamed to be distinct. parametrized (MyModule as MyModule.BS) requires (Str as Data.ByteString) Intensive use of Backpack sometimes involves creating lots of small -parametrized libraries; :ref:`Internal Libraries ` can be used +parametrized libraries; :ref:`Sublibraries ` can be used to define all of these libraries in a single package without having to create many separate Cabal packages. You may also find it useful to use :pkg-field:`library:reexported-modules` to reexport instantiated diff --git a/doc/file-format-changelog.rst b/doc/file-format-changelog.rst index 4aba3ce6dcd..c3d9aa2dfc8 100644 --- a/doc/file-format-changelog.rst +++ b/doc/file-format-changelog.rst @@ -72,8 +72,8 @@ relative to the respective preceding *published* version. * Dependencies to sublibraries must be specified explicitly, even for current package. - For example: ``build-depends: mypackage:internal-lib`` - This way you can have an internal library with the same + For example: ``build-depends: mypackage:my-sublib`` + This way you can have a sublibrary with the same name as some external dependency. * Remove ``-any`` and ``-none`` syntax for version ranges @@ -218,7 +218,7 @@ relative to the respective preceding *published* version. * Add support for new :pkg-section:`foreign-library` stanza. -* Add support for :ref:`internal library stanzas `. +* Add support for :ref:`sublibrary stanzas `. * New CPP Macro ``CURRENT_PACKAGE_VERSION``. diff --git a/doc/setup-commands.rst b/doc/setup-commands.rst index 0d326e73830..2762b8dcb18 100644 --- a/doc/setup-commands.rst +++ b/doc/setup-commands.rst @@ -144,7 +144,7 @@ This has the following effects: the set of databases via :option:`--package-db` (and related flags): these dependencies are assumed to be up-to-date. A dependency can be explicitly specified using :option:`--dependency` simply by giving the name - of the internal library; e.g., the dependency for an internal library + of the sublibrary; e.g., the dependency for a sublibrary named ``foo`` is given as ``--dependency=pkg-internal=pkg-1.0-internal-abcd``. @@ -612,8 +612,8 @@ Miscellaneous options built; this identifier is passed on to GHC and serves as the basis for linker symbols and the ``id`` field in a ``ghc-pkg`` registration. When a package has multiple components, the actual - component identifiers are derived off of this identifier. E.g., an - internal library ``foo`` from package ``p-0.1-abcd`` will get the + component identifiers are derived off of this identifier. E.g., a + sublibrary ``foo`` from package ``p-0.1-abcd`` will get the identifier ``p-0.1-abcd-foo``. .. option:: --cid=CID From af0d57a2b984e3ded54a5c8c69ae7cb786d85fbe Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Thu, 26 Oct 2023 15:48:41 +0200 Subject: [PATCH 12/47] Fix Setup.hs `--dependency` example --- doc/setup-commands.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/setup-commands.rst b/doc/setup-commands.rst index 2762b8dcb18..28cd9e988be 100644 --- a/doc/setup-commands.rst +++ b/doc/setup-commands.rst @@ -146,7 +146,7 @@ This has the following effects: explicitly specified using :option:`--dependency` simply by giving the name of the sublibrary; e.g., the dependency for a sublibrary named ``foo`` is given as - ``--dependency=pkg-internal=pkg-1.0-internal-abcd``. + ``--dependency=Lib:foo=foo-0.1-abc``. - Only the dependencies needed for the requested component are required. Similarly, when :option:`--exact-configuration` is specified, From 3ecab3987c8b0af23d7dd71ec8f47f57dac36da7 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Tue, 24 Oct 2023 18:39:40 +0000 Subject: [PATCH 13/47] Bump urllib3 from 2.0.6 to 2.0.7 in /doc Bumps [urllib3](https://github.com/urllib3/urllib3) from 2.0.6 to 2.0.7. - [Release notes](https://github.com/urllib3/urllib3/releases) - [Changelog](https://github.com/urllib3/urllib3/blob/main/CHANGES.rst) - [Commits](https://github.com/urllib3/urllib3/compare/2.0.6...2.0.7) --- updated-dependencies: - dependency-name: urllib3 dependency-type: direct:production ... Signed-off-by: dependabot[bot] --- doc/requirements.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/requirements.txt b/doc/requirements.txt index 290dcd024d4..55019a68dc9 100644 --- a/doc/requirements.txt +++ b/doc/requirements.txt @@ -69,7 +69,7 @@ sphinxcontrib-serializinghtml==1.1.5 # via sphinx sphinxnotes-strike==1.2 # via -r requirements.in -urllib3==2.0.6 +urllib3==2.0.7 # via # -r requirements.in # requests From 34377ea7d24377429f7a2e877794c14233e7ff83 Mon Sep 17 00:00:00 2001 From: brandon s allbery kf8nh Date: Tue, 24 Oct 2023 14:46:29 -0400 Subject: [PATCH 14/47] also update .in file --- doc/requirements.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/requirements.in b/doc/requirements.in index 0a8bc49fecc..38e365cce5d 100644 --- a/doc/requirements.in +++ b/doc/requirements.in @@ -7,4 +7,4 @@ Pygments >= 2.7.4 # CVE-2023-37920 certifi >= 2023.07.22 # CVE-2023-43804 -urllib3 >= 2.0.6 +urllib3 >= 2.0.7 From bad0925c1053286f3edc0cfeddc0a0c457d730f2 Mon Sep 17 00:00:00 2001 From: brandon s allbery kf8nh Date: Tue, 24 Oct 2023 15:00:11 -0400 Subject: [PATCH 15/47] update CVE number, this is a new CVE Not a mistake in fixing the old --- doc/requirements.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/requirements.in b/doc/requirements.in index 38e365cce5d..d8de16ca602 100644 --- a/doc/requirements.in +++ b/doc/requirements.in @@ -6,5 +6,5 @@ sphinxnotes-strike Pygments >= 2.7.4 # CVE-2023-37920 certifi >= 2023.07.22 -# CVE-2023-43804 +# CVE-2023-45803 urllib3 >= 2.0.7 From d9e54fd8fb4bcb6a3476f0f92c957a39e7e8fba0 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Wed, 25 Oct 2023 12:46:37 +0800 Subject: [PATCH 16/47] Update format.yml Bump haskell-actions/run-fourmolu to v9 and fix fourmolu version to 0.12.0.0. This makes explicit which version is used and avoids unexpected changes later on. The current version v8 of run-fourmolu uses fourmolu-0.12.0.0 so this should not produce any change in formatting now. --- .github/workflows/format.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/format.yml b/.github/workflows/format.yml index ba5f85c9b82..84e639e7d1c 100644 --- a/.github/workflows/format.yml +++ b/.github/workflows/format.yml @@ -10,8 +10,9 @@ jobs: runs-on: ubuntu-latest steps: - uses: actions/checkout@v4 - - uses: haskell-actions/run-fourmolu@v8 + - uses: haskell-actions/run-fourmolu@v9 with: + version: "0.12.0.0" pattern: | Cabal/**/*.hs Cabal-syntax/**/*.hs From f9d21b6d508c70d65c6f633a55306060a92aaaee Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sat, 28 Oct 2023 15:35:49 -0400 Subject: [PATCH 17/47] Avoid double space in "Executing install plan ..." --- cabal-install/src/Distribution/Client/ProjectBuilding.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs index fa917b9f1bf..e0c97aca924 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs @@ -672,9 +672,9 @@ rebuildTargets info verbosity $ "Executing install plan " ++ case buildSettingNumJobs of - NumJobs n -> " in parallel using " ++ show n ++ " threads." - UseSem n -> " in parallel using a semaphore with " ++ show n ++ " slots." - Serial -> " serially." + NumJobs n -> "in parallel using " ++ show n ++ " threads." + UseSem n -> "in parallel using a semaphore with " ++ show n ++ " slots." + Serial -> "serially." createDirectoryIfMissingVerbose verbosity True distBuildRootDirectory createDirectoryIfMissingVerbose verbosity True distTempDirectory From 78618b60f24aa9a97a420902e93517476197eaae Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 30 Oct 2023 14:31:13 -0400 Subject: [PATCH 18/47] Add a change log entry for double space avoidance --- changelog.d/pr-9376 | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 changelog.d/pr-9376 diff --git a/changelog.d/pr-9376 b/changelog.d/pr-9376 new file mode 100644 index 00000000000..d85dc9bf49a --- /dev/null +++ b/changelog.d/pr-9376 @@ -0,0 +1,6 @@ +synopsis: Avoid a double space in "Executing install plan ..." +description: + The "Executing·install·plan··serially" and other similar "Executing install + plan··..." outputs no longer contain double spaces. +packages: cabal-install +prs: #9376 \ No newline at end of file From 2bbed44a9833870de8080ec1538a788681909c79 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 21 Aug 2023 07:41:51 -0400 Subject: [PATCH 19/47] Ignore CmmSourcesExe Demo Ignore because it warns about missing MachDeps.h --- .hlint.yaml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.hlint.yaml b/.hlint.yaml index f425ae527a8..e38cc7be72e 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -94,9 +94,10 @@ - ignore: {name: "Use when"} # 1 hint - arguments: + - --ignore-glob=Cabal-syntax/src/Distribution/Fields/Lexer.hs - --ignore-glob=cabal-testsuite/PackageTests/CmmSources/src/Demo.hs - --ignore-glob=cabal-testsuite/PackageTests/CmmSourcesDyn/src/Demo.hs - - --ignore-glob=Cabal-syntax/src/Distribution/Fields/Lexer.hs + - --ignore-glob=cabal-testsuite/PackageTests/CmmSourcesExe/src/Demo.hs - --ignore-glob=templates/Paths_pkg.template.hs - --ignore-glob=templates/SPDX.LicenseExceptionId.template.hs - --ignore-glob=templates/SPDX.LicenseId.template.hs From f39392711cf9775f4d31078d9026dc1879f462c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?H=C3=A9cate=20Moonlight?= Date: Mon, 30 Oct 2023 20:25:58 +0100 Subject: [PATCH 20/47] Create Cabal-3.10.2.1 release notes --- release-notes/Cabal-3.10.2.1.md | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 release-notes/Cabal-3.10.2.1.md diff --git a/release-notes/Cabal-3.10.2.1.md b/release-notes/Cabal-3.10.2.1.md new file mode 100644 index 00000000000..bfa8fa750b5 --- /dev/null +++ b/release-notes/Cabal-3.10.2.1.md @@ -0,0 +1,9 @@ +Cabal and Cabal-syntax 3.10.2.1 changelog and release notes +--- + +## Release 3.10.2.1 is strictly a bug-fix release, with the fixes listed below + +- Relax extension .c requirement for c-sources [#9285](https://github.com/haskell/cabal/pull/9285) + +We will be tightening the behaviour of Cabal in the future, when users list files ending with extensions other than `.c` in the `c-sources` field of their cabal file. These files were never processed properly. +This PR displays more warnings and prepares the transition. From ef17619bd99a23051bec0711cee5d57052884bf2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?H=C3=A9cate=20Moonlight?= Date: Mon, 30 Oct 2023 22:45:04 +0100 Subject: [PATCH 21/47] Fix markdown syntax in changelog --- Cabal/ChangeLog.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Cabal/ChangeLog.md b/Cabal/ChangeLog.md index fd928c4de23..34d046cc098 100644 --- a/Cabal/ChangeLog.md +++ b/Cabal/ChangeLog.md @@ -1,3 +1,6 @@ +# 3.10.2.1 [Hécate](mailto:hecate+github@glitchbra.in) October 2023 +* See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.10.2.1.md + # 3.10.2.0 [Hécate](mailto:hecate+github@glitchbra.in) August 2023 * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.10.2.0.md From d1344d934dc5f37f9192c4eaa7bb697bf7bf62ae Mon Sep 17 00:00:00 2001 From: Artem Pelenitsyn Date: Wed, 1 Nov 2023 13:25:18 -0400 Subject: [PATCH 22/47] doc: render math with HTML to make it selectable (fix #8453) (#9361) * doc: render math with HTML to make it selectable (fix #8453) * Update doc/conf.py Co-authored-by: Bryan Richter --------- Co-authored-by: Bryan Richter Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> --- doc/conf.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/conf.py b/doc/conf.py index 51ab333f80e..84ea8de0f2d 100644 --- a/doc/conf.py +++ b/doc/conf.py @@ -102,8 +102,8 @@ # Output file base name for HTML help builder. htmlhelp_basename = 'CabalUsersGuide' -# MathJax to use SVG rendering by default -mathjax_path = 'https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/latest.js?config=TeX-AMS-MML_SVG' +# MathJax to use HTML rendering by default (makes the text selectable, see #8453) +mathjax_path = 'https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/latest.js?config=TeX-AMS_CHTML' # -- Options for LaTeX output --------------------------------------------- From b27fd21d17c229fb8b4bc6a6fef0f79207b90dce Mon Sep 17 00:00:00 2001 From: Yvan Sraka Date: Wed, 21 Jun 2023 15:40:43 +0200 Subject: [PATCH 23/47] [cabal-7825] Implement external command system Fix #2349 and #7825 --- Cabal/src/Distribution/Make.hs | 7 ++-- Cabal/src/Distribution/Simple.hs | 5 ++- Cabal/src/Distribution/Simple/Command.hs | 35 ++++++++++++++----- cabal-install/src/Distribution/Client/Main.hs | 7 ++-- .../src/Distribution/Client/SavedFlags.hs | 1 + doc/external-commands.rst | 8 +++++ doc/index.rst | 1 + 7 files changed, 51 insertions(+), 13 deletions(-) create mode 100644 doc/external-commands.rst diff --git a/Cabal/src/Distribution/Make.hs b/Cabal/src/Distribution/Make.hs index 716033e42a3..aaa63a94bdb 100644 --- a/Cabal/src/Distribution/Make.hs +++ b/Cabal/src/Distribution/Make.hs @@ -88,8 +88,10 @@ defaultMainArgs :: [String] -> IO () defaultMainArgs = defaultMainHelper defaultMainHelper :: [String] -> IO () -defaultMainHelper args = - case commandsRun (globalCommand commands) commands args of +defaultMainHelper args = do + command <- commandsRun (globalCommand commands) commands args + case command of + CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -98,6 +100,7 @@ defaultMainHelper args = _ | fromFlag (globalVersion flags) -> printVersion | fromFlag (globalNumericVersion flags) -> printNumericVersion + CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs index 024a445f1dc..0649a085260 100644 --- a/Cabal/src/Distribution/Simple.hs +++ b/Cabal/src/Distribution/Simple.hs @@ -168,7 +168,9 @@ defaultMainWithHooksNoReadArgs hooks pkg_descr = defaultMainHelper :: UserHooks -> Args -> IO () defaultMainHelper hooks args = topHandler $ do args' <- expandResponse args - case commandsRun (globalCommand commands) commands args' of + command <- commandsRun (globalCommand commands) commands args' + case command of + CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -177,6 +179,7 @@ defaultMainHelper hooks args = topHandler $ do _ | fromFlag (globalVersion flags) -> printVersion | fromFlag (globalNumericVersion flags) -> printNumericVersion + CommandDelegate -> pure () CommandHelp help -> printHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs diff --git a/Cabal/src/Distribution/Simple/Command.hs b/Cabal/src/Distribution/Simple/Command.hs index f55a510c8bd..dc2be1a698b 100644 --- a/Cabal/src/Distribution/Simple/Command.hs +++ b/Cabal/src/Distribution/Simple/Command.hs @@ -85,12 +85,15 @@ module Distribution.Simple.Command import Distribution.Compat.Prelude hiding (get) import Prelude () +import Control.Exception (try) import qualified Data.Array as Array import qualified Data.List as List import Distribution.Compat.Lens (ALens', (#~), (^#)) import qualified Distribution.GetOpt as GetOpt import Distribution.ReadE import Distribution.Simple.Utils +import System.Directory (findExecutable) +import System.Process (callProcess) data CommandUI flags = CommandUI { commandName :: String @@ -596,11 +599,13 @@ data CommandParse flags | CommandList [String] | CommandErrors [String] | CommandReadyToGo flags + | CommandDelegate instance Functor CommandParse where fmap _ (CommandHelp help) = CommandHelp help fmap _ (CommandList opts) = CommandList opts fmap _ (CommandErrors errs) = CommandErrors errs fmap f (CommandReadyToGo flags) = CommandReadyToGo (f flags) + fmap _ CommandDelegate = CommandDelegate data CommandType = NormalCommand | HiddenCommand data Command action @@ -631,25 +636,38 @@ commandsRun :: CommandUI a -> [Command action] -> [String] - -> CommandParse (a, CommandParse action) + -> IO (CommandParse (a, CommandParse action)) commandsRun globalCommand commands args = case commandParseArgs globalCommand True args of - CommandHelp help -> CommandHelp help - CommandList opts -> CommandList (opts ++ commandNames) - CommandErrors errs -> CommandErrors errs + CommandDelegate -> pure CommandDelegate + CommandHelp help -> pure $ CommandHelp help + CommandList opts -> pure $ CommandList (opts ++ commandNames) + CommandErrors errs -> pure $ CommandErrors errs CommandReadyToGo (mkflags, args') -> case args' of - ("help" : cmdArgs) -> handleHelpCommand cmdArgs + ("help" : cmdArgs) -> pure $ handleHelpCommand cmdArgs (name : cmdArgs) -> case lookupCommand name of [Command _ _ action _] -> - CommandReadyToGo (flags, action cmdArgs) - _ -> CommandReadyToGo (flags, badCommand name) - [] -> CommandReadyToGo (flags, noCommand) + pure $ CommandReadyToGo (flags, action cmdArgs) + _ -> do + mCommand <- findExecutable $ "cabal-" <> name + case mCommand of + Just exec -> callExternal flags exec cmdArgs + Nothing -> pure $ CommandReadyToGo (flags, badCommand name) + [] -> pure $ CommandReadyToGo (flags, noCommand) where flags = mkflags (commandDefaultFlags globalCommand) where lookupCommand cname = [ cmd | cmd@(Command cname' _ _ _) <- commands', cname' == cname ] + + callExternal :: a -> String -> [String] -> IO (CommandParse (a, CommandParse action)) + callExternal flags exec cmdArgs = do + result <- try $ callProcess exec cmdArgs + case result of + Left ex -> pure $ CommandErrors ["Error executing external command: " ++ show (ex :: SomeException)] + Right _ -> pure $ CommandReadyToGo (flags, CommandDelegate) + noCommand = CommandErrors ["no command given (try --help)\n"] -- Print suggested command if edit distance is < 5 @@ -679,6 +697,7 @@ commandsRun globalCommand commands args = -- furthermore, support "prog help command" as "prog command --help" handleHelpCommand cmdArgs = case commandParseArgs helpCommandUI True cmdArgs of + CommandDelegate -> CommandDelegate CommandHelp help -> CommandHelp help CommandList list -> CommandList (list ++ commandNames) CommandErrors _ -> CommandHelp globalHelp diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 6d8c0e187aa..c7772434060 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -322,8 +322,10 @@ warnIfAssertionsAreEnabled = -- into IO actions for execution. mainWorker :: [String] -> IO () mainWorker args = do - topHandler $ - case commandsRun (globalCommand commands) commands args of + topHandler $ do + command <- commandsRun (globalCommand commands) commands args + case command of + CommandDelegate -> pure () CommandHelp help -> printGlobalHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> printErrors errs @@ -334,6 +336,7 @@ mainWorker args = do printVersion | fromFlagOrDefault False (globalNumericVersion globalFlags) -> printNumericVersion + CommandDelegate -> pure () CommandHelp help -> printCommandHelp help CommandList opts -> printOptionsList opts CommandErrors errs -> do diff --git a/cabal-install/src/Distribution/Client/SavedFlags.hs b/cabal-install/src/Distribution/Client/SavedFlags.hs index 1a598a58fd7..5fa417a8578 100644 --- a/cabal-install/src/Distribution/Client/SavedFlags.hs +++ b/cabal-install/src/Distribution/Client/SavedFlags.hs @@ -51,6 +51,7 @@ readCommandFlags :: FilePath -> CommandUI flags -> IO flags readCommandFlags path command = do savedArgs <- fmap (fromMaybe []) (readSavedArgs path) case (commandParseArgs command True savedArgs) of + CommandDelegate -> error "CommandDelegate Flags evaluated, this should never occur" CommandHelp _ -> throwIO (SavedArgsErrorHelp savedArgs) CommandList _ -> throwIO (SavedArgsErrorList savedArgs) CommandErrors errs -> throwIO (SavedArgsErrorOther savedArgs errs) diff --git a/doc/external-commands.rst b/doc/external-commands.rst new file mode 100644 index 00000000000..047d8f4dca0 --- /dev/null +++ b/doc/external-commands.rst @@ -0,0 +1,8 @@ +External Commands +================= + +Cabal provides a system for external commands, akin to the ones used by tools like ``git`` or ``cargo``. + +If you execute ``cabal my-custom-command``, Cabal will search the path for an executable named ``cabal-my-custom-command`` and execute it, passing any remaining arguments to this external command. An error will be thrown in case the custom command is not found. + +For ideas or existing external commands, visit `this Discourse thread `_. diff --git a/doc/index.rst b/doc/index.rst index b97dd245346..faaa3bac628 100644 --- a/doc/index.rst +++ b/doc/index.rst @@ -18,3 +18,4 @@ Welcome to the Cabal User Guide buildinfo-fields-reference bugs-and-stability nix-integration + external-commands From 775a44e7de77118e38495192b4d860d9487a7b88 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Wed, 25 Oct 2023 22:32:29 +0200 Subject: [PATCH 24/47] Bump to latest dependencies for GHC 9.8.1 --- Cabal-tests/Cabal-tests.cabal | 24 +++++++++---------- cabal-benchmarks/cabal-benchmarks.cabal | 2 +- .../cabal-install-solver.cabal | 6 ++--- cabal-install/cabal-install.cabal | 6 ++--- cabal-testsuite/cabal-testsuite.cabal | 8 +++---- 5 files changed, 23 insertions(+), 23 deletions(-) diff --git a/Cabal-tests/Cabal-tests.cabal b/Cabal-tests/Cabal-tests.cabal index bb42abc7fc7..f6a8c2c1481 100644 --- a/Cabal-tests/Cabal-tests.cabal +++ b/Cabal-tests/Cabal-tests.cabal @@ -60,7 +60,7 @@ test-suite unit-tests , Cabal-QuickCheck , containers , deepseq - , Diff >=0.4 && <0.5 + , Diff >=0.4 && <0.6 , directory , filepath , integer-logarithms >=1.0.2 && <1.1 @@ -68,7 +68,7 @@ test-suite unit-tests , QuickCheck >=2.14 && <2.15 , rere >=0.1 && <0.3 , tagged - , tasty >=1.2.3 && <1.5 + , tasty >=1.2.3 && <1.6 , tasty-hunit , tasty-quickcheck , temporary @@ -84,14 +84,14 @@ test-suite parser-tests main-is: ParserTests.hs build-depends: base - , base-compat >=0.11.0 && <0.13 + , base-compat >=0.11.0 && <0.14 , bytestring , Cabal-syntax , Cabal-tree-diff - , Diff >=0.4 && <0.5 + , Diff >=0.4 && <0.6 , directory , filepath - , tasty >=1.2.3 && <1.5 + , tasty >=1.2.3 && <1.6 , tasty-golden >=2.3.1.1 && <2.4 , tasty-hunit , tasty-quickcheck @@ -109,10 +109,10 @@ test-suite check-tests , bytestring , Cabal , Cabal-syntax - , Diff >=0.4 && <0.5 + , Diff >=0.4 && <0.6 , directory , filepath - , tasty >=1.2.3 && <1.5 + , tasty >=1.2.3 && <1.6 , tasty-expected-failure , tasty-golden >=2.3.1.1 && <2.4 @@ -155,10 +155,10 @@ test-suite hackage-tests , filepath build-depends: - base-compat >=0.11.0 && <0.13 - , base-orphans >=0.6 && <0.9 + base-compat >=0.11.0 && <0.14 + , base-orphans >=0.6 && <0.10 , clock >=0.8 && <0.9 - , optparse-applicative >=0.13.2.0 && <0.17 + , optparse-applicative >=0.13.2.0 && <0.19 , stm >=2.4.5.0 && <2.6 , tar >=0.5.0.3 && <0.6 , tree-diff >=0.1 && <0.4 @@ -178,7 +178,7 @@ test-suite rpmvercmp build-depends: QuickCheck - , tasty >=1.2.3 && <1.5 + , tasty >=1.2.3 && <1.6 , tasty-hunit , tasty-quickcheck @@ -197,7 +197,7 @@ test-suite no-thunks-test base , bytestring , Cabal-syntax - , tasty >=1.2.3 && <1.5 + , tasty >=1.2.3 && <1.6 , tasty-hunit -- this is test is buildable on old GHCs diff --git a/cabal-benchmarks/cabal-benchmarks.cabal b/cabal-benchmarks/cabal-benchmarks.cabal index 4e911918321..d2e9cb328b2 100644 --- a/cabal-benchmarks/cabal-benchmarks.cabal +++ b/cabal-benchmarks/cabal-benchmarks.cabal @@ -31,4 +31,4 @@ test-suite cabal-benchmarks base , bytestring , Cabal-syntax - , criterion >=1.5.6.2 && <1.6 + , criterion >=1.5.6.2 && <1.7 diff --git a/cabal-install-solver/cabal-install-solver.cabal b/cabal-install-solver/cabal-install-solver.cabal index 98f8253b102..4157d98283b 100644 --- a/cabal-install-solver/cabal-install-solver.cabal +++ b/cabal-install-solver/cabal-install-solver.cabal @@ -105,7 +105,7 @@ library build-depends: , array >=0.4 && <0.6 - , base >=4.10 && <4.19 + , base >=4.10 && <4.20 , bytestring >=0.10.6.0 && <0.13 , Cabal ^>=3.11 , Cabal-syntax ^>=3.11 @@ -138,10 +138,10 @@ Test-Suite unit-tests UnitTests.Distribution.Solver.Modular.MessageUtils build-depends: - , base >= 4.10 && <4.19 + , base >= 4.10 && <4.20 , Cabal , Cabal-syntax , cabal-install-solver - , tasty >= 1.2.3 && <1.5 + , tasty >= 1.2.3 && <1.6 , tasty-quickcheck , tasty-hunit >= 0.10 diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index d47f5494c2c..e45dc58a408 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -46,7 +46,7 @@ common warnings ghc-options: -Wunused-packages common base-dep - build-depends: base >=4.10 && <4.19 + build-depends: base >=4.10 && <4.20 common cabal-dep build-depends: Cabal ^>=3.11 @@ -229,7 +229,7 @@ library time >= 1.5.0.1 && < 1.13, zlib >= 0.5.3 && < 0.7, hackage-security >= 0.6.2.0 && < 0.7, - text >= 1.2.3 && < 1.3 || >= 2.0 && < 2.1, + text >= 1.2.3 && < 1.3 || >= 2.0 && < 2.2, parsec >= 3.1.13.0 && < 3.2, regex-base >= 0.94.0.0 && <0.95, regex-posix >= 0.96.0.0 && <0.97, @@ -332,7 +332,7 @@ test-suite unit-tests tar, time, zlib, - tasty >= 1.2.3 && <1.5, + tasty >= 1.2.3 && <1.6, tasty-golden >=2.3.1.1 && <2.4, tasty-quickcheck, tasty-hunit >= 0.10, diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 125ba5ecd55..d4206163210 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -26,7 +26,7 @@ common shared default-language: Haskell2010 build-depends: - , base >= 4.9 && <4.19 + , base >= 4.9 && <4.20 -- this needs to match the in-tree lib:Cabal version , Cabal ^>= 3.11.0.0 , Cabal-syntax ^>= 3.11.0.0 @@ -57,7 +57,7 @@ library Test.Cabal.ScriptEnv0 build-depends: - , aeson ^>= 1.4.2.0 || ^>=1.5.0.0 || ^>= 2.0.0.0 || ^>= 2.1.0.0 + , aeson ^>= 1.4.2.0 || ^>=1.5.0.0 || ^>= 2.0.0.0 || ^>= 2.1.0.0 || ^>= 2.2.1.0 , async ^>= 2.2.1 , attoparsec ^>= 0.13.2.2 || ^>=0.14.1 , base64-bytestring ^>= 1.0.0.0 || ^>= 1.1.0.0 || ^>= 1.2.0.0 @@ -68,14 +68,14 @@ library , exceptions ^>= 0.10.0 , filepath ^>= 1.3.0.1 || ^>= 1.4.0.0 , network-wait ^>= 0.1.2.0 || ^>= 0.2.0.0 - , optparse-applicative ^>= 0.14.3.0 || ^>=0.15.1.0 || ^>=0.16.0.0 || ^>= 0.17.0.0 + , optparse-applicative ^>= 0.14.3.0 || ^>=0.15.1.0 || ^>=0.16.0.0 || ^>= 0.17.0.0 || ^>= 0.18.1.0 , process ^>= 1.2.1.0 || ^>= 1.4.2.0 || ^>= 1.6.1.0 , regex-base ^>= 0.94.0.1 , regex-tdfa ^>= 1.2.3.1 || ^>=1.3.1.0 , retry ^>= 0.9.1.0 , array ^>= 0.4.0.1 || ^>= 0.5.0.0 , temporary ^>= 1.3 - , text ^>= 1.2.3.1 || ^>= 2.0.1 + , text ^>= 1.2.3.1 || ^>= 2.0.1 || ^>= 2.1 , transformers ^>= 0.3.0.0 || ^>= 0.4.2.0 || ^>= 0.5.2.0 || ^>= 0.6.0.2 if !os(windows) From cb311fd9914f7c966284af1fc7a1472057facfb4 Mon Sep 17 00:00:00 2001 From: Andreas Abel Date: Tue, 31 Oct 2023 20:08:20 +0100 Subject: [PATCH 25/47] cabal.project: clean out obsolete `allow-newer`s --- cabal.project | 8 -------- 1 file changed, 8 deletions(-) diff --git a/cabal.project b/cabal.project index f98fec9889b..d0b2fbabc1f 100644 --- a/cabal.project +++ b/cabal.project @@ -15,17 +15,9 @@ packages: cabal-benchmarks/ optional-packages: ./vendored/*/*.cabal -allow-newer: - hackage-security:Cabal - -- avoiding extra dependencies constraints: rere -rere-cfg constraints: these -assoc --- Andreas, 2022-08-19, https://github.com/haskell/cabal/issues/8377 --- Force latest dependencies in the development version: -constraints: text >= 2.0 -constraints: time >= 1.12 - program-options ghc-options: -fno-ignore-asserts From 004d6d70eb6c4bf2a973faaf2e50d48f072f2006 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 30 Oct 2023 14:57:03 -0400 Subject: [PATCH 26/47] Use the newer haskell-actions organisation --- .github/workflows/lint.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/lint.yml b/.github/workflows/lint.yml index fa12e98b878..5e8e95c2c8b 100644 --- a/.github/workflows/lint.yml +++ b/.github/workflows/lint.yml @@ -9,10 +9,10 @@ jobs: runs-on: ubuntu-latest steps: - uses: actions/checkout@v4 - - uses: haskell/actions/hlint-setup@v2 + - uses: haskell-actions/hlint-setup@v2 with: version: "3.5" - - uses: haskell/actions/hlint-run@v2 + - uses: haskell-actions/hlint-run@v2 with: path: "." fail-on: suggestion \ No newline at end of file From 0cada43f04a957d6f946197724c22edb52089d6b Mon Sep 17 00:00:00 2001 From: Jens Petersen Date: Fri, 3 Nov 2023 17:57:04 +0800 Subject: [PATCH 27/47] update GH validate workflow to ghc 9.2.8, 9.4.7, 9.6.3 --- .github/workflows/validate.yml | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/.github/workflows/validate.yml b/.github/workflows/validate.yml index b1fc53a2352..3f44655fd58 100644 --- a/.github/workflows/validate.yml +++ b/.github/workflows/validate.yml @@ -23,10 +23,10 @@ on: env: # We choose a stable ghc version across all os's # which will be used to do the next release - GHC_FOR_RELEASE: '9.2.7' + GHC_FOR_RELEASE: '9.2.8' # Ideally we should use the version about to be released for hackage tests and benchmarks - GHC_FOR_SOLVER_BENCHMARKS: '9.2.7' - GHC_FOR_COMPLETE_HACKAGE_TESTS: '9.2.7' + GHC_FOR_SOLVER_BENCHMARKS: '9.2.8' + GHC_FOR_COMPLETE_HACKAGE_TESTS: '9.2.8' COMMON_FLAGS: '-j 2 -v' jobs: @@ -38,7 +38,7 @@ jobs: strategy: matrix: os: ["ubuntu-latest", "macos-latest", "windows-latest"] - ghc: ["9.6.1", "9.4.4", "9.2.7", "9.0.2", "8.10.7", "8.8.4", "8.6.5", "8.4.4"] + ghc: ["9.6.3", "9.4.7", "9.2.8", "9.0.2", "8.10.7", "8.8.4", "8.6.5", "8.4.4"] exclude: # corrupts GHA cache or the fabric of reality itself, see https://github.com/haskell/cabal/issues/8356 - os: "windows-latest" @@ -107,7 +107,7 @@ jobs: echo "FLAGS=$FLAGS" >> $GITHUB_ENV - name: Allow newer dependencies when built with latest GHC - if: ${{ matrix.ghc }} == '9.6.1' + if: ${{ matrix.ghc }} == '9.6.3' run: | echo "allow-newer: rere:base, rere:transformers" >> cabal.project.validate @@ -161,7 +161,7 @@ jobs: # Have to disable *-suite validation: # - the Windows@9.6.1 problem is tracked at https://github.com/haskell/cabal/issues/8858 # - but curently can't run it with GHC 9.6, tracking: https://github.com/haskell/cabal/issues/8883 - if: (runner.os != 'Windows') || (matrix.ghc != '9.6.1') + if: (runner.os != 'Windows') || (matrix.ghc != '9.6.3') run: sh validate.sh $FLAGS -s lib-suite - name: Validate cli-tests @@ -169,7 +169,7 @@ jobs: - name: Validate cli-suite # Have to disable *-suite validation, see above the comment for lib-suite - if: (runner.os != 'Windows') || (matrix.ghc != '9.6.1') + if: (runner.os != 'Windows') || (matrix.ghc != '9.6.3') run: sh validate.sh $FLAGS -s cli-suite validate-old-ghcs: From 01cfac0e6608f7962e80e7cca67dd1b2b9285ecc Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Sat, 4 Nov 2023 14:59:20 +0800 Subject: [PATCH 28/47] Revert #3639 (Don't pass -package-db and -package flags to --abi-hash) (#9384) * Revert #3639 (Don't pass -package-db and -package flags to --abi-hash) With ghc>=9.6 `ghc --abi-hash` initialises the plugins so it will fail if a cabal file specifies `ghc-options: -fplugin=Foo`. Closes: #9375 * Also revert in GHC.hs --------- Co-authored-by: Hamish Mackenzie Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> --- Cabal/src/Distribution/Simple/GHC.hs | 10 +--------- Cabal/src/Distribution/Simple/GHCJS.hs | 10 +--------- 2 files changed, 2 insertions(+), 18 deletions(-) diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 3c380a41a86..f218d7c117a 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -2052,20 +2052,12 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do libBi = libBuildInfo lib comp = compiler lbi platform = hostPlatform lbi - vanillaArgs0 = + vanillaArgs = (componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi)) `mappend` mempty { ghcOptMode = toFlag GhcModeAbiHash , ghcOptInputModules = toNubListR $ exposedModules lib } - vanillaArgs = - -- Package DBs unnecessary, and break ghc-cabal. See #3633 - -- BUT, put at least the global database so that 7.4 doesn't - -- break. - vanillaArgs0 - { ghcOptPackageDBs = [GlobalPackageDB] - , ghcOptPackages = mempty - } sharedArgs = vanillaArgs `mappend` mempty diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index 58194f5ffa3..5ed2d9327e9 100644 --- a/Cabal/src/Distribution/Simple/GHCJS.hs +++ b/Cabal/src/Distribution/Simple/GHCJS.hs @@ -1739,20 +1739,12 @@ libAbiHash verbosity _pkg_descr lbi lib clbi = do libBi = libBuildInfo lib comp = compiler lbi platform = hostPlatform lbi - vanillaArgs0 = + vanillaArgs = (componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi)) `mappend` mempty { ghcOptMode = toFlag GhcModeAbiHash , ghcOptInputModules = toNubListR $ exposedModules lib } - vanillaArgs = - -- Package DBs unnecessary, and break ghc-cabal. See #3633 - -- BUT, put at least the global database so that 7.4 doesn't - -- break. - vanillaArgs0 - { ghcOptPackageDBs = [GlobalPackageDB] - , ghcOptPackages = mempty - } sharedArgs = vanillaArgs `mappend` mempty From 8c954ec2ec1f5060301e8884204447873cec4c4e Mon Sep 17 00:00:00 2001 From: Malte Neuss Date: Sat, 28 Oct 2023 23:04:37 +0200 Subject: [PATCH 29/47] Restructure Cabal documentation top-level parts The goal is for users to easier find pages for typical problems through search engines and page navigation. - The top-level layout is based on the popular documentation structure by https://documentation.divio.com/ to give a clear structure to users and future documentation contributors: * Guides: Present a solution to a single, atomic, typical user problem. * Reference: Describe user API (CLI fields, syntax etc) with technical rigour and completeness. * Explanation: Discuss background information, scope, design decisions etc. - Move existing documentation roughly into these categories with minimal editing as the basis for further editing. - Rename guide titles to mention how-to for improving SEO. - Rename some files to improve SEO since that name becomes part of the URL (often called slug). Important page keywords should appear in the slug as well to make pages rank higher in search engines. --- .gitignore | 2 + doc/_templates/layout.html | 5 +- doc/bugs-and-stability.rst | 6 - doc/{intro.rst => cabal-context.rst} | 6 +- ...misc.rst => cabal-interface-stability.rst} | 10 - ...rst => cabal-package-description-file.rst} | 6 +- ...rst => cabal-project-description-file.rst} | 4 +- doc/cabaldomain.py | 6 +- doc/concepts-and-development.rst | 7 - doc/getting-started.rst | 2 +- ...overview.rst => how-to-build-like-nix.rst} | 4 +- doc/how-to-package-haskell-code.rst | 291 +++++++++++++++++ doc/how-to-report-bugs.rst | 9 + doc/index.rst | 39 ++- doc/nix-integration.rst | 64 ---- doc/nix-local-build.rst | 2 +- ...ping-packages.rst => package-concepts.rst} | 305 ------------------ 17 files changed, 349 insertions(+), 419 deletions(-) delete mode 100644 doc/bugs-and-stability.rst rename doc/{intro.rst => cabal-context.rst} (98%) rename doc/{misc.rst => cabal-interface-stability.rst} (89%) rename doc/{cabal-package.rst => cabal-package-description-file.rst} (99%) rename doc/{cabal-project.rst => cabal-project-description-file.rst} (99%) delete mode 100644 doc/concepts-and-development.rst rename doc/{nix-local-build-overview.rst => how-to-build-like-nix.rst} (97%) create mode 100644 doc/how-to-package-haskell-code.rst create mode 100644 doc/how-to-report-bugs.rst delete mode 100644 doc/nix-integration.rst rename doc/{developing-packages.rst => package-concepts.rst} (56%) diff --git a/.gitignore b/.gitignore index e9ec3b6322f..72a16455c82 100644 --- a/.gitignore +++ b/.gitignore @@ -73,6 +73,8 @@ cabal-testsuite/**/haddocks # python artifacts from documentation builds *.pyc .python-sphinx-virtualenv/ +venv +.venv /doc/.skjold_cache/ # macOS folder metadata diff --git a/doc/_templates/layout.html b/doc/_templates/layout.html index d8ced7f65a4..7add67b61eb 100644 --- a/doc/_templates/layout.html +++ b/doc/_templates/layout.html @@ -1,8 +1,7 @@ {% extends "!layout.html" %} {% block menu %} - {{ super() }} - Reference +{{ super() }} + Cabal Syntax Quicklinks Index {% endblock %} - diff --git a/doc/bugs-and-stability.rst b/doc/bugs-and-stability.rst deleted file mode 100644 index 81d27d3dd1a..00000000000 --- a/doc/bugs-and-stability.rst +++ /dev/null @@ -1,6 +0,0 @@ -Reporting Bugs and Stability of Cabal Interfaces -================================================ - -.. toctree:: - misc - diff --git a/doc/intro.rst b/doc/cabal-context.rst similarity index 98% rename from doc/intro.rst rename to doc/cabal-context.rst index d2219ab32d1..ce152cca713 100644 --- a/doc/intro.rst +++ b/doc/cabal-context.rst @@ -14,8 +14,8 @@ use Hackage_ which is Haskell's central package archive that contains thousands of libraries and applications in the Cabal package format. -Introduction -============ +What Cabal does +=============== Cabal is a package system for Haskell software. The point of a package system is to enable software developers and users to easily distribute, @@ -122,7 +122,7 @@ the package depends on. For full details on what goes in the ``.cabal`` and ``Setup.hs`` files, and for all the other features provided by the build system, see the -section on :doc:`developing packages `. +section on :doc:`How to package Haskell code `. Cabal featureset ---------------- diff --git a/doc/misc.rst b/doc/cabal-interface-stability.rst similarity index 89% rename from doc/misc.rst rename to doc/cabal-interface-stability.rst index 5d01198f0e5..2993f8ab0ff 100644 --- a/doc/misc.rst +++ b/doc/cabal-interface-stability.rst @@ -1,13 +1,3 @@ -Reporting bugs and deficiencies -=============================== - -Please report any flaws or feature requests in the `bug -tracker `__. - -For general discussion or queries email the libraries mailing list -libraries@haskell.org. There is also a development mailing list -cabal-devel@haskell.org. - Stability of Cabal interfaces ============================= diff --git a/doc/cabal-package.rst b/doc/cabal-package-description-file.rst similarity index 99% rename from doc/cabal-package.rst rename to doc/cabal-package-description-file.rst index 75ec9ff40ed..485389a0916 100644 --- a/doc/cabal-package.rst +++ b/doc/cabal-package-description-file.rst @@ -1,6 +1,8 @@ -Package Description -=================== +Package Description — .cabal File +========================================== +The package description file, commonly known as "the Cabal file", +describes the contents of a package. The Cabal package is the unit of distribution. When installed, its purpose is to make available: diff --git a/doc/cabal-project.rst b/doc/cabal-project-description-file.rst similarity index 99% rename from doc/cabal-project.rst rename to doc/cabal-project-description-file.rst index fedf8c4e935..baac75e06f9 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project-description-file.rst @@ -1,5 +1,5 @@ -cabal.project Reference -======================= +Project Description — cabal.project File +======================================== ``cabal.project`` files support a variety of options which configure the details of your build. The general syntax of a ``cabal.project`` file is diff --git a/doc/cabaldomain.py b/doc/cabaldomain.py index 19c37dea229..2d318f8508f 100644 --- a/doc/cabaldomain.py +++ b/doc/cabaldomain.py @@ -598,9 +598,9 @@ class CabalConfigFieldXRef(CabalFieldXRef): # class ConfigFieldIndex(Index): - name = 'projectindex' - localname = "Cabal reference" - shortname = "Reference" + name = 'syntax-quicklinks' + localname = "Cabal Syntax Quicklinks" + shortname = "Quicklinks" class Entry(object): def __init__(self, typ, name, doc, anchor, meta): diff --git a/doc/concepts-and-development.rst b/doc/concepts-and-development.rst deleted file mode 100644 index c0e8b481356..00000000000 --- a/doc/concepts-and-development.rst +++ /dev/null @@ -1,7 +0,0 @@ -Package Concepts and Development -================================ - -.. toctree:: - :maxdepth: 2 - - developing-packages diff --git a/doc/getting-started.rst b/doc/getting-started.rst index 4d5ebfe810f..39a095a7453 100644 --- a/doc/getting-started.rst +++ b/doc/getting-started.rst @@ -228,4 +228,4 @@ What Next? Now that you know how to set up a simple Haskell package using Cabal, check out some of the resources on the Haskell website's `documentation page `__ or read more about packages and -Cabal on the :doc:`introduction ` page. +Cabal on the :doc:`What Cabal does ` page. diff --git a/doc/nix-local-build-overview.rst b/doc/how-to-build-like-nix.rst similarity index 97% rename from doc/nix-local-build-overview.rst rename to doc/how-to-build-like-nix.rst index 61e59b84d76..0714b4b02f1 100644 --- a/doc/nix-local-build-overview.rst +++ b/doc/how-to-build-like-nix.rst @@ -1,7 +1,7 @@ .. _nix-style-builds: -Nix-style Local Builds -====================== +How to build locally like in Nix +================================ Nix-style local builds are a new build system implementation inspired by Nix. The Nix-style local build system is commonly called "v2-build" for short diff --git a/doc/how-to-package-haskell-code.rst b/doc/how-to-package-haskell-code.rst new file mode 100644 index 00000000000..bd68681654b --- /dev/null +++ b/doc/how-to-package-haskell-code.rst @@ -0,0 +1,291 @@ +How to package Haskell code +=========================== + +.. TIP:: + If this is your first time using `cabal` you should check out the :doc:`Getting Started guide `. + +Starting from scratch, we're going to walk you through creating a simple +Haskell application. + +**TL;DR;** ``mkdir proglet && cd proglet && cabal init --simple --exe && cabal run proglet`` + + +Introduction +------------ + +Every application needs a name, we'll call ours "proglet" and start by +creating an empty directory. + +.. highlight:: console + +:: + + $ mkdir proglet + $ cd proglet/ + + +.. _init quickstart: + +Using ``cabal init`` +-------------------- + +The ``cabal init`` command creates the necessary files for a Cabal package, +it has both an ``--interactive`` (default) and ``--non-interactive`` +mode. The interactive mode will walk you through many of the package +options and metadata, the non-interactive mode will simply pick reasonable +defaults which is sufficient if you're just trying something out. + +.. highlight:: console + +:: + + $ cabal init --non-interactive + # You can also use -n which is the short version of --non-interactive + +If you want, you can also try out the interactive mode, for now chose +"Executable" when asked what type of package you want to build. + +.. highlight:: console + +:: + + $ cabal init + ... + What does the package build: + 1) Executable + 2) Library + 3) Library and Executable + 4) Test suite + Your choice? + +One of the important questions is whether the package contains a library +and/or an executable. Libraries are collections of Haskell modules that +can be re-used by other Haskell libraries and programs, while executables +are standalone programs. Test suites can both depend on a library or be +standalone. + +For the moment these are the only choices. For more complex packages +(e.g. a library and multiple executables) the ``.cabal`` +file can be edited afterwards. + +After you make your selection (executable; library; library +and executable; or: test suite) cabal asks us a number of questions starting with +which version of the cabal specification to use, our package's name +(for example, "proglet"), and our package's version. + +:: + + Generating CHANGELOG.md... + Generating Main.hs... + Generating proglet.cabal... + +Use the ``ls`` command to see the created files: + +:: + + $ ls + CHANGELOG.md Main.hs proglet.cabal + + +Running the program +------------------- + +Now that we have our Haskell code and the extra files that Cabal needs, we +can build and run our application. + +:: + + $ cabal build + Resolving dependencies... + ... + Linking /path/to/proglet ... + + $ cabal run proglet + ... + Hello, Haskell! + +Since we have an executable we can use ``cabal run proglet`` which will build +our executable (and re-build it if we've made any changes) and then run the +binary. The ``cabal run`` command works for any ``component-name`` (tests for +example), not just the main executable. + + +About the Cabal package structure +--------------------------------- + +It is assumed that all the files that make up a package live under a common +root directory (apart from external dependencies). This simple example has +all the package files in one directory, but most packages use one or more +subdirectories. + +Cabal needs one extra file in the package's root directory: + +- ``proglet.cabal``: contains package metadata and build information. + + +Editing the .cabal file +----------------------- + +.. highlight:: cabal + +Load up the ``.cabal`` file in a text editor. The first part of the +``.cabal`` file has the package metadata and towards the end of the file +you will find the :pkg-section:`executable` or :pkg-section:`library` +section. + +You will see that the fields that have yet to be filled in are commented +out. Cabal files use "``--``" Haskell-style comment syntax. + +.. NOTE:: + Comments are only allowed on lines on their own. Trailing comments on + other lines are not allowed because they could be confused with program + options. + + +:: + + executable proglet + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.11 && <4.12 + -- hs-source-dirs: + default-language: Haskell2010 + + +If you selected earlier to create a library package then your ``.cabal`` +file will have a section that looks like this: + +:: + + library + exposed-modules: MyLib + -- other-modules: + -- build-depends: + build-depends: base >=4.11 && <4.12 + -- hs-source-dirs: + default-language: Haskell2010 + + +The build information fields listed (but commented out) are just the few +most important and common fields. There are many others that are covered +later in this chapter. + +Most of the build information fields are the same between libraries and +executables. The difference is that libraries have a number of "exposed" +modules that make up the public interface of the library, while +executables have a file containing a ``Main`` module. + +The name of a library always matches the name of the package, so it is +not specified in the library section. Executables often follow the name +of the package too, but this is not required and the name is given +explicitly. + + +Modules included in the package +------------------------------- + +For an executable, ``cabal init`` creates the ``Main.hs`` file which +contains your program's ``Main`` module. It will also fill in the +:pkg-field:`executable:main-is` field with the file name of your program's +``Main`` module, including the ``.hs`` (or ``.lhs``) extension. Other +modules included in the executable should be listed in the +:pkg-field:`other-modules` field. + +For a library, ``cabal init`` looks in the project directory for files +that look like Haskell modules and adds all the modules to the +:pkg-field:`library:exposed-modules` field. For modules that do not form part +of your package's public interface, you can move those modules to the +:pkg-field:`other-modules` field. Either way, all modules in the library need +to be listed. + + +Modules imported from other packages +------------------------------------ + +While your library or executable may include a number of modules, it +almost certainly also imports a number of external modules from the +standard libraries or other pre-packaged libraries. (These other +libraries are of course just Cabal packages that contain one or more libraries.) + +You have to list all of the library packages that your library or +executable imports modules from. Or to put it another way: you have to +list all the other packages that your package depends on. + +For example, suppose the example ``Proglet`` module imports the module +``Data.Map``. The ``Data.Map`` module comes from the ``containers`` +package, so we must list it: + +:: + + library + exposed-modules: Proglet + other-modules: + build-depends: containers, base >=4.11 && <4.12 + +In addition, almost every package also depends on the ``base`` library +package because it exports the standard ``Prelude`` module plus other +basic modules like ``Data.List``. + +You will notice that we have listed ``base >=4.11 && <4.12``. This gives a +constraint on the version of the base package that our package will work +with. The most common kinds of constraints are: + +- ``pkgname >=n`` +- ``pkgname ^>=n`` +- ``pkgname >=n && =4 && <5``. Please refer to the documentation +on the :pkg-field:`build-depends` field for more information. + +Also, you can factor out shared ``build-depends`` (and other fields such +as ``ghc-options``) into a ``common`` stanza which you can ``import`` in +your libraries and executable sections. For example: + +:: + + common shared-properties + default-language: Haskell2010 + build-depends: + base == 4.* + ghc-options: + -Wall + + library + import: shared-properties + exposed-modules: + Proglet + +Note that the ``import`` **must** be the first thing in the stanza. For more +information see the :ref:`common-stanzas` section. + +.. _building-packages: + +Building the package +-------------------- + +For simple packages that's it! We can now try building the package, +which also downloads and builds all required dependencies: + +.. code-block:: console + + $ cabal build + +If the package contains an executable, you can run it with: + +.. code-block:: console + + $ cabal run + +and the executable can also be installed for convenience: + +.. code-block:: console + + $ cabal install + +When installed, the executable program lands in a special directory +for binaries that may or may not already be on your system's ``PATH``. +If it is, the executable can be run by typing its filename on commandline. +For installing libraries see the :ref:`adding-libraries` section. diff --git a/doc/how-to-report-bugs.rst b/doc/how-to-report-bugs.rst new file mode 100644 index 00000000000..20910cdf1a3 --- /dev/null +++ b/doc/how-to-report-bugs.rst @@ -0,0 +1,9 @@ +How to report Cabal bugs and feature requests +============================================= + +Please report any flaws or feature requests in the `bug +tracker `__. + +For general discussion or queries email the libraries mailing list +libraries@haskell.org. There is also a development mailing list +cabal-devel@haskell.org. diff --git a/doc/index.rst b/doc/index.rst index faaa3bac628..ed882247ea7 100644 --- a/doc/index.rst +++ b/doc/index.rst @@ -1,21 +1,40 @@ - Welcome to the Cabal User Guide =============================== .. toctree:: - :maxdepth: 2 + :caption: Getting Started :numbered: + :maxdepth: 2 getting-started - intro - concepts-and-development - nix-local-build-overview + +.. toctree:: + :caption: Cabal Guide + :numbered: + :maxdepth: 2 + + how-to-package-haskell-code + how-to-build-like-nix + how-to-report-bugs + +.. toctree:: + :caption: Cabal Reference + :numbered: + :maxdepth: 2 + + cabal-package-description-file + cabal-project-description-file cabal-config-and-commands - cabal-package - cabal-project + external-commands setup-commands file-format-changelog buildinfo-fields-reference - bugs-and-stability - nix-integration - external-commands + +.. toctree:: + :caption: Cabal Explanation + :numbered: + :maxdepth: 2 + + cabal-context + package-concepts + cabal-interface-stability diff --git a/doc/nix-integration.rst b/doc/nix-integration.rst deleted file mode 100644 index 5d4fa695cd4..00000000000 --- a/doc/nix-integration.rst +++ /dev/null @@ -1,64 +0,0 @@ -Nix Integration -=============== - -.. warning:: - - Nix integration has been deprecated and will be removed in a future release. - - The original mechanism can still be easily replicated with the following commands: - - - for a ``shell.nix``: ``nix-shell --run "cabal ..."`` - - for a ``flake.nix``: ``nix develop -c cabal ...`` - -.. note:: - - This functionality doesn't work with nix-style builds. - Nix-style builds are not related to Nix integration. - -`Nix `_ is a package manager popular with some Haskell developers due to its focus on reliability and reproducibility. ``cabal`` now has the ability to integrate with Nix for dependency management during local package development. - -Enabling Nix Integration ------------------------- - -To enable Nix integration, simply pass the ``--enable-nix`` global option when you call ``cabal`` (eg. ``cabal --enable-nix v1-build``). -To use this option everywhere, edit your :ref:`global configuration file` (default: ``~/.config/cabal/config``) to include: - -.. code-block:: cabal - - nix: True - -If the package (which must be locally unpacked) provides a ``shell.nix`` or ``default.nix`` file, this flag will cause ``cabal`` to run most commands through ``nix-shell``. If both expressions are present, ``shell.nix`` is preferred. The following commands are affected: - -- ``cabal v1-configure`` -- ``cabal v1-build`` -- ``cabal v1-repl`` -- ``cabal v1-install`` (only if installing into a sandbox) -- ``cabal v1-haddock`` -- ``cabal v1-freeze`` -- ``cabal v1-gen-bounds`` -- ``cabal v1-run`` - -If the package does not provide a Nix expression, ``cabal`` runs normally. - -Creating Nix Expressions ------------------------- - -The Nix package manager is based on a lazy, pure, functional programming language; packages are defined by expressions in this language. The fastest way to create a Nix expression for a Cabal package is with the `cabal2nix `_ tool. To create a ``shell.nix`` expression for the package in the current directory, run this command: - -.. code-block:: console - - $ cabal2nix --shell ./. >shell.nix - -Nix Expression Evaluation -------------------------- - -(This section describes for advanced users how Nix expressions are evaluated.) - -First, the Nix expression (``shell.nix`` or ``default.nix``) is instantiated with ``nix-instantiate``. The ``--add-root`` and ``--indirect`` options are used to create an indirect root in the Cabal build directory, preventing Nix from garbage collecting the derivation while in use. The ``IN_NIX_SHELL`` environment variable is set so that ``builtins.getEnv`` works as it would in ``nix-shell``. - -Next, the commands above are run through ``nix-shell`` using the instantiated derivation. Again, ``--add-root`` and ``--indirect`` are used to prevent Nix from garbage collecting the packages in the environment. The child ``cabal`` process reads the ``CABAL_IN_NIX_SHELL`` environment variable to prevent it from spawning additional child shells. - -Further Reading ----------------- - -The `Nix manual `_ provides further instructions for writing Nix expressions. The `Nixpkgs manual `_ describes the infrastructure provided for Haskell packages. diff --git a/doc/nix-local-build.rst b/doc/nix-local-build.rst index c086f642d24..7a47dacc923 100644 --- a/doc/nix-local-build.rst +++ b/doc/nix-local-build.rst @@ -5,7 +5,7 @@ Quickstart Suppose that you are in a directory containing a single Cabal package which you wish to build (if you haven't set up a package yet check -out :doc:`developing packages ` for +out :doc:`How to package Haskell code ` for instructions). You can configure and build it using Nix-style local builds with this command (configuring is not necessary): diff --git a/doc/developing-packages.rst b/doc/package-concepts.rst similarity index 56% rename from doc/developing-packages.rst rename to doc/package-concepts.rst index 28f2c7847df..25cfeb13fba 100644 --- a/doc/developing-packages.rst +++ b/doc/package-concepts.rst @@ -1,308 +1,3 @@ -Quickstart -========== - -.. TIP:: - If this is your first time using `cabal` you should check out the :doc:`Getting Started guide `. - -Starting from scratch, we're going to walk you through creating a simple -Haskell application. - -**TL;DR;** ``mkdir proglet && cd proglet && cabal init --simple --exe && cabal run proglet`` - - -Introduction ------------- - -Every application needs a name, we'll call ours "proglet" and start by -creating an empty directory. - -.. highlight:: console - -:: - - $ mkdir proglet - $ cd proglet/ - - -.. _init quickstart: - -Using ``cabal init`` --------------------- - -The ``cabal init`` command creates the necessary files for a Cabal package, -it has both an ``--interactive`` (default) and ``--non-interactive`` -mode. The interactive mode will walk you through many of the package -options and metadata, the non-interactive mode will simply pick reasonable -defaults which is sufficient if you're just trying something out. - -.. highlight:: console - -:: - - $ cabal init --non-interactive - # You can also use -n which is the short version of --non-interactive - -If you want, you can also try out the interactive mode, for now chose -"Executable" when asked what type of package you want to build. - -.. highlight:: console - -:: - - $ cabal init - ... - What does the package build: - 1) Executable - 2) Library - 3) Library and Executable - 4) Test suite - Your choice? - -One of the important questions is whether the package contains a library -and/or an executable. Libraries are collections of Haskell modules that -can be re-used by other Haskell libraries and programs, while executables -are standalone programs. Test suites can both depend on a library or be -standalonely generated. - -For the moment these are the only choices. For more complex packages -(e.g. a library and multiple executables) the ``.cabal`` -file can be edited afterwards. - -After you make your selection (executable; library; library -and executable; or: test suite) cabal asks us a number of questions starting with -which version of the cabal specification to use, our package's name -(for example, "proglet"), and our package's version. - -:: - - Generating CHANGELOG.md... - Generating Main.hs... - Generating proglet.cabal... - -Use the ``ls`` command to see the created files: - -:: - - $ ls - CHANGELOG.md Main.hs proglet.cabal - - -Running the program -------------------- - -Now that we have our Haskell code and the extra files that Cabal needs we -can build and run our application. - -:: - - $ cabal build - Resolving dependencies... - ... - Linking /path/to/proglet ... - - $ cabal run proglet - ... - Hello, Haskell! - -Since we have an executable we can use ``cabal run proglet`` which will build -our executable (and re-build it if we've made any changes) and then run the -binary. The ``cabal run`` command works for any ``component-name`` (tests for -example), not just the main executable. - - -About the Cabal package structure ---------------------------------- - -It is assumed that all the files that make up a package live under a common -root directory (apart from external dependencies). This simple example has -all the package files in one directory, but most packages use one or more -subdirectories. - -Cabal needs one extra file in the package's root directory: - -- ``proglet.cabal``: contains package metadata and build information. - - -Editing the .cabal file ------------------------ - -.. highlight:: cabal - -Load up the ``.cabal`` file in a text editor. The first part of the -``.cabal`` file has the package metadata and towards the end of the file -you will find the :pkg-section:`executable` or :pkg-section:`library` -section. - -You will see that the fields that have yet to be filled in are commented -out. Cabal files use "``--``" Haskell-style comment syntax. - -.. NOTE:: - Comments are only allowed on lines on their own. Trailing comments on - other lines are not allowed because they could be confused with program - options. - - -:: - - executable proglet - main-is: Main.hs - -- other-modules: - -- other-extensions: - build-depends: base >=4.11 && <4.12 - -- hs-source-dirs: - default-language: Haskell2010 - - -If you selected earlier to create a library package then your ``.cabal`` -file will have a section that looks like this: - -:: - - library - exposed-modules: MyLib - -- other-modules: - -- build-depends: - build-depends: base >=4.11 && <4.12 - -- hs-source-dirs: - default-language: Haskell2010 - - -The build information fields listed (but commented out) are just the few -most important and common fields. There are many others that are covered -later in this chapter. - -Most of the build information fields are the same between libraries and -executables. The difference is that libraries have a number of "exposed" -modules that make up the public interface of the library, while -executables have a file containing a ``Main`` module. - -The name of a library always matches the name of the package, so it is -not specified in the library section. Executables often follow the name -of the package too, but this is not required and the name is given -explicitly. - - -Modules included in the package -------------------------------- - -For an executable, ``cabal init`` creates the ``Main.hs`` file which -contains your program's ``Main`` module. It will also fill in the -:pkg-field:`executable:main-is` field with the file name of your program's -``Main`` module, including the ``.hs`` (or ``.lhs``) extension. Other -modules included in the executable should be listed in the -:pkg-field:`other-modules` field. - -For a library, ``cabal init`` looks in the project directory for files -that look like Haskell modules and adds all the modules to the -:pkg-field:`library:exposed-modules` field. For modules that do not form part -of your package's public interface, you can move those modules to the -:pkg-field:`other-modules` field. Either way, all modules in the library need -to be listed. - - -Modules imported from other packages ------------------------------------- - -While your library or executable may include a number of modules, it -almost certainly also imports a number of external modules from the -standard libraries or other pre-packaged libraries. (These other -libraries are of course just Cabal packages that contain a library.) - -You have to list all of the library packages that your library or -executable imports modules from. Or to put it another way: you have to -list all the other packages that your package depends on. - -For example, suppose the example ``Proglet`` module imports the module -``Data.Map``. The ``Data.Map`` module comes from the ``containers`` -package, so we must list it: - -:: - - library - exposed-modules: Proglet - other-modules: - build-depends: containers, base >=4.11 && <4.12 - -In addition, almost every package also depends on the ``base`` library -package because it exports the standard ``Prelude`` module plus other -basic modules like ``Data.List``. - -You will notice that we have listed ``base >=4.11 && <4.12``. This gives a -constraint on the version of the base package that our package will work -with. The most common kinds of constraints are: - -- ``pkgname >=n`` -- ``pkgname ^>=n`` (since Cabal 2.0) -- ``pkgname >=n && =4 && <5``. Please refer to the documentation -on the :pkg-field:`build-depends` field for more information. - -Also, you can factor out shared ``build-depends`` (and other fields such -as ``ghc-options``) into a ``common`` stanza which you can ``import`` in -your libraries and executable sections. For example: - -:: - - common shared-properties - default-language: Haskell2010 - build-depends: - base == 4.* - ghc-options: - -Wall - - library - import: shared-properties - exposed-modules: - Proglet - -Note that the ``import`` **must** be the first thing in the stanza. For more -information see the :ref:`common-stanzas` section. - -.. _building-packages: - -Building the package --------------------- - -For simple packages that's it! We can now try building the package, -which also downloads and builds all required dependencies: - -.. code-block:: console - - $ cabal build - -If the package contains an executable, you can run it with: - -.. code-block:: console - - $ cabal run - -and the executable can also be installed for convenience: - -.. code-block:: console - - $ cabal install - -When installed, the executable program lands in a special directory -for binaries that may or may not already be on your system's ``PATH``. -If it is, the executable can be run by typing its filename on commandline. -For installing libraries see the :ref:`adding-libraries` section. - -Next steps ----------- - -What we have covered so far should be enough for very simple packages -that you use on your own system. - -The next few sections cover more details needed for more complex -packages and details needed for distributing packages to other people. - -The previous chapter covers building and installing packages -- your own -packages or ones developed by other people. - - Package concepts ================ From 759ba8e36dd29149af57b9f20fe657e6d38e1654 Mon Sep 17 00:00:00 2001 From: Malte Neuss Date: Sat, 28 Oct 2023 23:04:52 +0200 Subject: [PATCH 30/47] Rename master_doc to root_doc (changed in version 4.0 of Sphynx) --- doc/conf.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/conf.py b/doc/conf.py index 84ea8de0f2d..b630823e5fa 100644 --- a/doc/conf.py +++ b/doc/conf.py @@ -25,7 +25,7 @@ templates_path = ['_templates'] source_suffix = '.rst' source_encoding = 'utf-8-sig' -master_doc = 'index' +root_doc = 'index' # extlinks -- see http://www.sphinx-doc.org/en/stable/ext/extlinks.html extlinks = { From af0126cf081ee32db0e039b1bed3e2d04c07297c Mon Sep 17 00:00:00 2001 From: Bodigrim Date: Tue, 31 Oct 2023 23:38:37 +0000 Subject: [PATCH 31/47] Add instance Ord for Field, FieldLine, SectionArg and Name --- Cabal-syntax/src/Distribution/Fields/Field.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/Cabal-syntax/src/Distribution/Fields/Field.hs b/Cabal-syntax/src/Distribution/Fields/Field.hs index c119ca5f1c0..c7d63533e52 100644 --- a/Cabal-syntax/src/Distribution/Fields/Field.hs +++ b/Cabal-syntax/src/Distribution/Fields/Field.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE StandaloneDeriving #-} -- | Cabal-like file AST types: 'Field', 'Section' etc -- @@ -51,6 +52,9 @@ data Field ann | Section !(Name ann) [SectionArg ann] [Field ann] deriving (Eq, Show, Functor, Foldable, Traversable) +-- | @since 3.12.0.0 +deriving instance Ord ann => Ord (Field ann) + -- | Section of field name fieldName :: Field ann -> Name ann fieldName (Field n _) = n @@ -73,6 +77,9 @@ fieldUniverse f@(Field _ _) = [f] data FieldLine ann = FieldLine !ann !ByteString deriving (Eq, Show, Functor, Foldable, Traversable) +-- | @since 3.12.0.0 +deriving instance Ord ann => Ord (FieldLine ann) + -- | @since 3.0.0.0 fieldLineAnn :: FieldLine ann -> ann fieldLineAnn (FieldLine ann _) = ann @@ -91,6 +98,9 @@ data SectionArg ann SecArgOther !ann !ByteString deriving (Eq, Show, Functor, Foldable, Traversable) +-- | @since 3.12.0.0 +deriving instance Ord ann => Ord (SectionArg ann) + -- | Extract annotation from 'SectionArg'. sectionArgAnn :: SectionArg ann -> ann sectionArgAnn (SecArgName ann _) = ann @@ -109,6 +119,9 @@ type FieldName = ByteString data Name ann = Name !ann !FieldName deriving (Eq, Show, Functor, Foldable, Traversable) +-- | @since 3.12.0.0 +deriving instance Ord ann => Ord (Name ann) + mkName :: ann -> FieldName -> Name ann mkName ann bs = Name ann (B.map Char.toLower bs) From 8591d0cccf0a617e8ab1584b49ea071317a9454a Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Sun, 22 Oct 2023 16:40:50 -0400 Subject: [PATCH 32/47] Add reinstall test to LinkerOptions/NonignoredConfigs --- .../LinkerOptions/NonignoredConfigs/cabal.out | 28 +++++++++++++++++++ .../NonignoredConfigs/cabal.test.hs | 5 +++- 2 files changed, 32 insertions(+), 1 deletion(-) diff --git a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out index 242bb523282..f789801ca19 100644 --- a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out +++ b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out @@ -10,6 +10,13 @@ Building library for basic-0.1... Installing library in # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Error: [Cabal-7145] +Packages requested to install already exist in environment file at /cabal.dist/basic0.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Resolving dependencies... +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: @@ -20,7 +27,28 @@ Building library for basic-0.1... Installing library in # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Error: [Cabal-7145] +Packages requested to install already exist in environment file at /cabal.dist/basic1.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Resolving dependencies... +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Error: [Cabal-7145] +Packages requested to install already exist in environment file at /cabal.dist/basic2.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Resolving dependencies... +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Resolving dependencies... +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz +Error: [Cabal-7145] +Packages requested to install already exist in environment file at /cabal.dist/basic3.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# cabal v2-install +Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... diff --git a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs index 9da924366f4..23d88570aa1 100644 --- a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs +++ b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs @@ -70,7 +70,10 @@ main = cabalTest $ do -- (see 'testCurrentDir').) withDirectory ".." $ do packageEnv <- ( ("basic" ++ show idx ++ ".env")) . testWorkDir <$> getTestEnv - cabal "v2-install" $ ["--disable-deterministic", "--lib", "--package-env=" ++ packageEnv] ++ linkConfigFlags linking ++ ["basic"] + let installOptions = ["--disable-deterministic", "--lib", "--package-env=" ++ packageEnv] ++ linkConfigFlags linking ++ ["basic"] + cabal "v2-install" installOptions + fails $ cabal "v2-install" installOptions + cabal "v2-install" $ "--force-reinstalls" : installOptions let exIPID s = takeWhile (/= '\n') . head . filter (\t -> any (`isPrefixOf` t) ["basic-0.1-", "bsc-0.1-"]) $ tails s hashedIpid <- exIPID <$> liftIO (readFile packageEnv) return $ ((idx, linking), hashedIpid) From 6801926cf450d31dd12bd81cb9e48fe117ce6b6a Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 6 Nov 2023 10:20:28 -0500 Subject: [PATCH 33/47] Record install options --- .../LinkerOptions/NonignoredConfigs/cabal.out | 12 ++++++++++++ .../LinkerOptions/NonignoredConfigs/cabal.test.hs | 10 +++++++--- 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out index f789801ca19..34592d494be 100644 --- a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out +++ b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.out @@ -1,3 +1,4 @@ +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic0.env basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... @@ -8,13 +9,16 @@ Configuring library for basic-0.1... Preprocessing library for basic-0.1... Building library for basic-0.1... Installing library in +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic0.env basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Error: [Cabal-7145] Packages requested to install already exist in environment file at /cabal.dist/basic0.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# install options: --force-reinstalls --disable-deterministic --lib --package-env=/cabal.dist/basic0.env basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic1.env --enable-shared --enable-executable-dynamic --disable-library-vanilla basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... @@ -25,30 +29,38 @@ Configuring library for basic-0.1... Preprocessing library for basic-0.1... Building library for basic-0.1... Installing library in +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic1.env --enable-shared --enable-executable-dynamic --disable-library-vanilla basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Error: [Cabal-7145] Packages requested to install already exist in environment file at /cabal.dist/basic1.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# install options: --force-reinstalls --disable-deterministic --lib --package-env=/cabal.dist/basic1.env --enable-shared --enable-executable-dynamic --disable-library-vanilla basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic2.env basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic2.env basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Error: [Cabal-7145] Packages requested to install already exist in environment file at /cabal.dist/basic2.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# install options: --force-reinstalls --disable-deterministic --lib --package-env=/cabal.dist/basic2.env basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic3.env --enable-shared --enable-executable-dynamic --disable-library-vanilla basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... +# install options: --disable-deterministic --lib --package-env=/cabal.dist/basic3.env --enable-shared --enable-executable-dynamic --disable-library-vanilla basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Error: [Cabal-7145] Packages requested to install already exist in environment file at /cabal.dist/basic3.env. Overwriting them may break other packages. Use --force-reinstalls to proceed anyway. Packages: basic +# install options: --force-reinstalls --disable-deterministic --lib --package-env=/cabal.dist/basic3.env --enable-shared --enable-executable-dynamic --disable-library-vanilla basic # cabal v2-install Wrote tarball sdist to /cabal.dist/work/./basic/../dist/sdist/basic-0.1.tar.gz Resolving dependencies... diff --git a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs index 23d88570aa1..899bb03b430 100644 --- a/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs +++ b/cabal-testsuite/PackageTests/LinkerOptions/NonignoredConfigs/cabal.test.hs @@ -71,9 +71,13 @@ main = cabalTest $ do withDirectory ".." $ do packageEnv <- ( ("basic" ++ show idx ++ ".env")) . testWorkDir <$> getTestEnv let installOptions = ["--disable-deterministic", "--lib", "--package-env=" ++ packageEnv] ++ linkConfigFlags linking ++ ["basic"] - cabal "v2-install" installOptions - fails $ cabal "v2-install" installOptions - cabal "v2-install" $ "--force-reinstalls" : installOptions + recordMode RecordMarked $ do + recordHeader $ "install options:" : installOptions + cabal "v2-install" installOptions + recordHeader $ "install options:" : installOptions + fails $ cabal "v2-install" installOptions + recordHeader $ "install options:" : "--force-reinstalls" : installOptions + cabal "v2-install" $ "--force-reinstalls" : installOptions let exIPID s = takeWhile (/= '\n') . head . filter (\t -> any (`isPrefixOf` t) ["basic-0.1-", "bsc-0.1-"]) $ tails s hashedIpid <- exIPID <$> liftIO (readFile packageEnv) return $ ((idx, linking), hashedIpid) From 8e6961cfac4735507579a54956473636b5f1a40b Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 30 Oct 2023 09:51:33 -0400 Subject: [PATCH 34/47] Note how to do "not equal" with constraints --- doc/cabal-package-description-file.rst | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/doc/cabal-package-description-file.rst b/doc/cabal-package-description-file.rst index 485389a0916..3ad0b718686 100644 --- a/doc/cabal-package-description-file.rst +++ b/doc/cabal-package-description-file.rst @@ -1479,8 +1479,22 @@ system-dependent values for these fields. Version constraints use the operators ``==, >=, >, <, <=`` and a version number. Multiple constraints can be combined using ``&&`` or - ``||``. If no version constraint is specified, any version is - assumed to be acceptable. For example: + ``||``. + + .. Note:: + + Even though there is no ``/=`` operator, by combining operators we can + skip over one or more versions, to skip a deprecated version or to skip + versions that upset the constraint solving. + + For example, the ``time =1.12.*`` series depends on ``base >=4.13 && <5`` + but ``time-1.12.3`` bumps the lower bound on base to ``>=4.14``. If we + still want to compile with a ``ghc-8.8.*`` version of GHC that ships with + ``base-4.13`` and with later GHC versions then we can use ``time >=1.12 + && (time <1.12.3 || time >1.12.3)``. + + If no version constraint is specified, any version is assumed to be + acceptable. For example: :: From 119148e67bdb7b12899607caf8d5d6b4dc16ac3b Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 30 Oct 2023 13:25:16 -0400 Subject: [PATCH 35/47] Use comma with then Co-authored-by: Artem Pelenitsyn --- doc/cabal-package-description-file.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/cabal-package-description-file.rst b/doc/cabal-package-description-file.rst index 3ad0b718686..088dbc34137 100644 --- a/doc/cabal-package-description-file.rst +++ b/doc/cabal-package-description-file.rst @@ -1490,7 +1490,7 @@ system-dependent values for these fields. For example, the ``time =1.12.*`` series depends on ``base >=4.13 && <5`` but ``time-1.12.3`` bumps the lower bound on base to ``>=4.14``. If we still want to compile with a ``ghc-8.8.*`` version of GHC that ships with - ``base-4.13`` and with later GHC versions then we can use ``time >=1.12 + ``base-4.13`` and with later GHC versions, then we can use ``time >=1.12 && (time <1.12.3 || time >1.12.3)``. If no version constraint is specified, any version is assumed to be From 95e7cbdc82721594b0d986ee786b00c921e5defa Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 30 Oct 2023 13:34:32 -0400 Subject: [PATCH 36/47] Use narrow rather than upset --- doc/cabal-package-description-file.rst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/cabal-package-description-file.rst b/doc/cabal-package-description-file.rst index 088dbc34137..1628df418fd 100644 --- a/doc/cabal-package-description-file.rst +++ b/doc/cabal-package-description-file.rst @@ -1485,7 +1485,7 @@ system-dependent values for these fields. Even though there is no ``/=`` operator, by combining operators we can skip over one or more versions, to skip a deprecated version or to skip - versions that upset the constraint solving. + versions that narrow the constraint solving more than we'd like. For example, the ``time =1.12.*`` series depends on ``base >=4.13 && <5`` but ``time-1.12.3`` bumps the lower bound on base to ``>=4.14``. If we From 9a0505f28f0c4981ee70ba1e683785565e5c6980 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Mon, 30 Oct 2023 13:52:41 -0400 Subject: [PATCH 37/47] Say something about hackage deprecations --- doc/cabal-package-description-file.rst | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/doc/cabal-package-description-file.rst b/doc/cabal-package-description-file.rst index 1628df418fd..25bd520e9cc 100644 --- a/doc/cabal-package-description-file.rst +++ b/doc/cabal-package-description-file.rst @@ -1493,6 +1493,13 @@ system-dependent values for these fields. ``base-4.13`` and with later GHC versions, then we can use ``time >=1.12 && (time <1.12.3 || time >1.12.3)``. + Hackage shows deprecated and preferred versions for packages, such as for + `containers `_ + and `aeson `_ for + example. Deprecating package versions is not the same deprecating a + package as a whole, for which hackage keeps a `deprecated packages list + `_. + If no version constraint is specified, any version is assumed to be acceptable. For example: From da6e0fe814727f80c55be6a42abd29387d9920b9 Mon Sep 17 00:00:00 2001 From: David Binder Date: Fri, 20 Oct 2023 12:25:07 +0200 Subject: [PATCH 38/47] Do not run CI for documentation changes The github workflows are not run if the changes are completely contained within the doc/ subdirectory. The only exception is the users-guide.yml github action. --- .github/workflows/lint.yml | 2 +- .github/workflows/validate.skip.yml | 33 +++++++++++++++++++++++++++++ .github/workflows/validate.yml | 5 +++++ 3 files changed, 39 insertions(+), 1 deletion(-) create mode 100644 .github/workflows/validate.skip.yml diff --git a/.github/workflows/lint.yml b/.github/workflows/lint.yml index 5e8e95c2c8b..1bae4d3d71b 100644 --- a/.github/workflows/lint.yml +++ b/.github/workflows/lint.yml @@ -15,4 +15,4 @@ jobs: - uses: haskell-actions/hlint-run@v2 with: path: "." - fail-on: suggestion \ No newline at end of file + fail-on: suggestion diff --git a/.github/workflows/validate.skip.yml b/.github/workflows/validate.skip.yml new file mode 100644 index 00000000000..b67d41dd2c4 --- /dev/null +++ b/.github/workflows/validate.skip.yml @@ -0,0 +1,33 @@ +name: Validate Skip + +# This Workflow is special and contains a workaround for a known limitation of GitHub CI. +# +# The problem: We don't want to run the "validate" jobs on PRs which contain only changes +# to the docs, since these jobs take a long time to complete without providing any benefit. +# We therefore use path-filtering in the workflow triggers for the validate jobs, namely +# "paths_ignore: doc/**". But the "Validate post job" is a required job, therefore a PR cannot +# be merged unless the "Validate post job" completes succesfully, which it doesn't do if we +# filter it out. +# +# The solution: We use a second job with the same name which always returns the exit code 0. +# The logic implemented for "required" workflows accepts if 1) at least one job with that name +# runs through, AND 2) If multiple jobs of that name exist, then all jobs of that name have to +# finish successfully. +on: + push: + paths: 'doc/**' + branches: + - master + pull_request: + paths: 'doc/**' + release: + types: + - created + +jobs: + validate-post-job: + if: always() + name: Validate post job + runs-on: ubuntu-latest + steps: + - run: exit 0 diff --git a/.github/workflows/validate.yml b/.github/workflows/validate.yml index 3f44655fd58..259fcfdca7c 100644 --- a/.github/workflows/validate.yml +++ b/.github/workflows/validate.yml @@ -11,11 +11,16 @@ concurrency: group: ${{ github.ref }}-${{ github.workflow }} cancel-in-progress: true +# Note: This workflow file contains the required job "Validate post job". We are using path filtering +# here to ignore PRs which only change documentation. This can cause a problem, see the workflow file +# "validate.skip.yml" for a description of the problem and the solution provided in that file. on: push: + paths-ignore: 'doc/**' branches: - master pull_request: + paths-ignore: 'doc/**' release: types: - created From e8a56c2db98f467dd2b18ea419c5dfec9e6f97f4 Mon Sep 17 00:00:00 2001 From: David Binder Date: Mon, 6 Nov 2023 02:45:56 +0100 Subject: [PATCH 39/47] Move Backpack section to user guides --- doc/cabal-package-description-file.rst | 123 +------------------------ doc/how-to-use-backpack.rst | 117 +++++++++++++++++++++++ doc/index.rst | 1 + 3 files changed, 121 insertions(+), 120 deletions(-) create mode 100644 doc/how-to-use-backpack.rst diff --git a/doc/cabal-package-description-file.rst b/doc/cabal-package-description-file.rst index 485389a0916..64b347c031c 100644 --- a/doc/cabal-package-description-file.rst +++ b/doc/cabal-package-description-file.rst @@ -890,7 +890,7 @@ The library section should contain the following fields: Supported only in GHC 8.2 and later. A list of `module signatures `__ required by this package. - Module signatures are part of the Backpack_ extension to + Module signatures are part of the :ref:`Backpack` extension to the Haskell module system. Packages that do not export any modules and only export required signatures @@ -2211,7 +2211,7 @@ system-dependent values for these fields. See the :pkg-field:`library:signatures` field for more details. - Mixin packages are part of the Backpack_ extension to the + Mixin packages are part of the :ref:`Backpack` extension to the Haskell module system. The matching of the module signatures required by a @@ -2224,7 +2224,7 @@ system-dependent values for these fields. .. Warning:: - Backpack_ has the limitation that implementation modules that instantiate + :ref:`Backpack` has the limitation that implementation modules that instantiate signatures required by a :pkg-field:`build-depends` dependency can't reside in the same component that has the dependency. They must reside in a different package dependency, or at least in a separate internal @@ -3305,123 +3305,6 @@ a few options: library for all or part of the work. One option is to copy the source of ``Distribution.Simple``, and alter it for your needs. Good luck. -.. _Backpack: - -Backpack --------- - -Cabal and GHC jointly support Backpack, an extension to Haskell's module -system which makes it possible to parametrize a package over some -modules, which can be instantiated later arbitrarily by a user. This -means you can write a library to be agnostic over some data -representation, and then instantiate it several times with different -data representations. Like C++ templates, instantiated packages are -recompiled for each instantiation, which means you do not pay any -runtime cost for parametrizing packages in this way. Backpack modules -are somewhat experimental; while fully supported by cabal-install, they are currently -`not supported by Stack `__. - -A Backpack package is defined by use of the -:pkg-field:`library:signatures` field, or by (transitive) dependency on -a package that defines some requirements. To define a parametrized -package, define a signature file (file extension ``hsig``) that -specifies the signature of the module you want to parametrize over, and -add it to your Cabal file in the :pkg-field:`library:signatures` field. - -.. code-block:: haskell - :caption: .hsig - - signature Str where - - data Str - - concat :: [Str] -> Str - -.. code-block:: cabal - :caption: parametrized.cabal - - cabal-version: 2.2 - name: parametrized - - library - build-depends: base - signatures: Str - exposed-modules: MyModule - -You can define any number of regular modules (e.g., ``MyModule``) that -import signatures and use them as regular modules. - -If you are familiar with ML modules, you might now expect there to be -some way to apply the parametrized package with an implementation of -the ``Str`` module to get a concrete instantiation of the package. -Backpack operates slightly differently with a concept of *mix-in -linking*, where you provide an implementation of ``Str`` simply by -bringing another module into scope with the same name as the -requirement. For example, if you had a package ``str-impl`` that provided a -module named ``Str``, instantiating ``parametrized`` is as simple as -just depending on both ``str-impl`` and ``parametrized``: - -.. code-block:: cabal - :caption: combined.cabal - - cabal-version: 2.2 - name: combined - - library - build-depends: base, str-impl, parametrized - -Note that due to technical limitations, you cannot directly define -``Str`` in the ``combined`` library; it must be placed in its own -library (you can use :ref:`Sublibraries ` to conveniently -define a sub-library). - -However, a more common situation is that your names don't match up -exactly. The :pkg-field:`library:mixins` field can be used to rename -signatures and modules to line up names as necessary. If you have -a requirement ``Str`` and an implementation ``Data.Text``, you can -line up the names in one of two ways: - -* Rename the requirement to match the implementation: - ``mixins: parametrized requires (Str as Data.Text)`` -* Rename the implementation to match the requirement: - ``mixins: text (Data.Text as Str)`` - -The :pkg-field:`library:mixins` field can also be used to disambiguate -between multiple instantiations of the same package; for each -instantiation of the package, give it a separate entry in mixins with -the requirements and provided modules renamed to be distinct. - -.. code-block:: cabal - :caption: .cabal - - cabal-version: 2.2 - name: double-combined - - library - build-depends: base, text, bytestring, parametrized - mixins: - parametrized (MyModule as MyModule.Text) requires (Str as Data.Text), - parametrized (MyModule as MyModule.BS) requires (Str as Data.ByteString) - -Intensive use of Backpack sometimes involves creating lots of small -parametrized libraries; :ref:`Sublibraries ` can be used -to define all of these libraries in a single package without having to -create many separate Cabal packages. You may also find it useful to use -:pkg-field:`library:reexported-modules` to reexport instantiated -libraries to Backpack-unware users (e.g., Backpack can be used entirely -as an implementation detail.) - -Backpack imposes a limitation on Template Haskell that goes beyond the usual TH -stage restriction: it's not possible to splice TH code imported from a -compilation unit that is still "indefinite", that is, a unit for which some -module signatures still haven't been matched with implementations. The reason -is that indefinite units are typechecked, but not compiled, so there's no -actual TH code to run while splicing. Splicing TH code from a definite -compilation unit into an indefinite one works normally. - -For more information about Backpack, check out the -`GHC wiki page `__. - .. include:: references.inc .. rubric:: Footnotes diff --git a/doc/how-to-use-backpack.rst b/doc/how-to-use-backpack.rst new file mode 100644 index 00000000000..23d58298b2d --- /dev/null +++ b/doc/how-to-use-backpack.rst @@ -0,0 +1,117 @@ +.. _Backpack: + +How to use Backpack modules +=========================== + +Cabal and GHC jointly support Backpack, an extension to Haskell's module +system which makes it possible to parametrize a package over some +modules, which can be instantiated later arbitrarily by a user. This +means you can write a library to be agnostic over some data +representation, and then instantiate it several times with different +data representations. Like C++ templates, instantiated packages are +recompiled for each instantiation, which means you do not pay any +runtime cost for parametrizing packages in this way. Backpack modules +are somewhat experimental; while fully supported by cabal-install, they are currently +`not supported by Stack `__. + +A Backpack package is defined by use of the +:pkg-field:`library:signatures` field, or by (transitive) dependency on +a package that defines some requirements. To define a parametrized +package, define a signature file (file extension ``hsig``) that +specifies the signature of the module you want to parametrize over, and +add it to your Cabal file in the :pkg-field:`library:signatures` field. + +.. code-block:: haskell + :caption: .hsig + + signature Str where + + data Str + + concat :: [Str] -> Str + +.. code-block:: cabal + :caption: parametrized.cabal + + cabal-version: 2.2 + name: parametrized + + library + build-depends: base + signatures: Str + exposed-modules: MyModule + +You can define any number of regular modules (e.g., ``MyModule``) that +import signatures and use them as regular modules. + +If you are familiar with ML modules, you might now expect there to be +some way to apply the parametrized package with an implementation of +the ``Str`` module to get a concrete instantiation of the package. +Backpack operates slightly differently with a concept of *mix-in +linking*, where you provide an implementation of ``Str`` simply by +bringing another module into scope with the same name as the +requirement. For example, if you had a package ``str-impl`` that provided a +module named ``Str``, instantiating ``parametrized`` is as simple as +just depending on both ``str-impl`` and ``parametrized``: + +.. code-block:: cabal + :caption: combined.cabal + + cabal-version: 2.2 + name: combined + + library + build-depends: base, str-impl, parametrized + +Note that due to technical limitations, you cannot directly define +``Str`` in the ``combined`` library; it must be placed in its own +library (you can use :ref:`Sublibraries ` to conveniently +define a sub-library). + +However, a more common situation is that your names don't match up +exactly. The :pkg-field:`library:mixins` field can be used to rename +signatures and modules to line up names as necessary. If you have +a requirement ``Str`` and an implementation ``Data.Text``, you can +line up the names in one of two ways: + +* Rename the requirement to match the implementation: + ``mixins: parametrized requires (Str as Data.Text)`` +* Rename the implementation to match the requirement: + ``mixins: text (Data.Text as Str)`` + +The :pkg-field:`library:mixins` field can also be used to disambiguate +between multiple instantiations of the same package; for each +instantiation of the package, give it a separate entry in mixins with +the requirements and provided modules renamed to be distinct. + +.. code-block:: cabal + :caption: .cabal + + cabal-version: 2.2 + name: double-combined + + library + build-depends: base, text, bytestring, parametrized + mixins: + parametrized (MyModule as MyModule.Text) requires (Str as Data.Text), + parametrized (MyModule as MyModule.BS) requires (Str as Data.ByteString) + +Intensive use of Backpack sometimes involves creating lots of small +parametrized libraries; :ref:`Sublibraries ` can be used +to define all of these libraries in a single package without having to +create many separate Cabal packages. You may also find it useful to use +:pkg-field:`library:reexported-modules` to reexport instantiated +libraries to Backpack-unware users (e.g., Backpack can be used entirely +as an implementation detail.) + +Backpack imposes a limitation on Template Haskell that goes beyond the usual TH +stage restriction: it's not possible to splice TH code imported from a +compilation unit that is still "indefinite", that is, a unit for which some +module signatures still haven't been matched with implementations. The reason +is that indefinite units are typechecked, but not compiled, so there's no +actual TH code to run while splicing. Splicing TH code from a definite +compilation unit into an indefinite one works normally. + +For more information about Backpack, check out the +`GHC wiki page `__. + diff --git a/doc/index.rst b/doc/index.rst index ed882247ea7..69109a67685 100644 --- a/doc/index.rst +++ b/doc/index.rst @@ -15,6 +15,7 @@ Welcome to the Cabal User Guide how-to-package-haskell-code how-to-build-like-nix + how-to-use-backpack how-to-report-bugs .. toctree:: From e46bf27a99e02a6671acd0527cb201765fa951f8 Mon Sep 17 00:00:00 2001 From: David Binder Date: Mon, 6 Nov 2023 02:48:10 +0100 Subject: [PATCH 40/47] Remove TBW virtual modules section --- doc/buildinfo-fields-reference.rst | 2 +- doc/cabal-package-description-file.rst | 10 ---------- 2 files changed, 1 insertion(+), 11 deletions(-) diff --git a/doc/buildinfo-fields-reference.rst b/doc/buildinfo-fields-reference.rst index 910bcf6813c..9deea2ba4d3 100644 --- a/doc/buildinfo-fields-reference.rst +++ b/doc/buildinfo-fields-reference.rst @@ -504,7 +504,7 @@ pkgconfig-depends virtual-modules * Monoidal field * Available since ``cabal-version: 2.2``. - * Documentation of :pkg-field:`virtual-modules` + * Documentation of :pkg-field:`library:virtual-modules` .. math:: \mathrm{commalist}\left({\left(\mathop{\mathit{upper}}{\left\{ \mathop{\mathit{alpha\text{-}num}}\mid[\mathop{\mathord{``}\mathtt{\text{'}}\mathord{"}}\mathop{\mathord{``}\mathtt{\text{_}}\mathord{"}}] \right\}}^\ast_{}\right)}^+_{\mathop{\mathord{``}\mathtt{\text{.}}\mathord{"}}}\right) diff --git a/doc/cabal-package-description-file.rst b/doc/cabal-package-description-file.rst index 64b347c031c..10cd6e51704 100644 --- a/doc/cabal-package-description-file.rst +++ b/doc/cabal-package-description-file.rst @@ -2923,16 +2923,6 @@ Right now :pkg-field:`executable:main-is` modules are not supported on (e.g. by a ``configure`` script). Autogenerated header files are not packaged by ``sdist`` command. -Virtual modules ---------------- - -TBW - -.. pkg-field:: virtual-modules: module list - :since: 2.2 - - TBW - .. _accessing-data-files: From d608d02ca4af32855359dc5b8d634aeb5fe5f0c1 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 9 Nov 2023 10:32:45 +0100 Subject: [PATCH 41/47] Reject index-states after last known index-state (#8944) Co-authored-by: Javier Sagredo Co-authored-by: Andrea Bedini Co-authored-by: Andrea Bedini --- .gitignore | 3 + .../src/Distribution/Client/CmdUpdate.hs | 31 ++-- .../src/Distribution/Client/Errors.hs | 21 +++ .../src/Distribution/Client/IndexUtils.hs | 174 ++++++++++-------- .../Client/IndexUtils/Timestamp.hs | 62 +++---- .../Distribution/Client/ArbitraryInstances.hs | 2 +- .../Client/IndexUtils/Timestamp.hs | 27 +-- .../Get/OnlyDescription/cabal.test.hs | 1 + .../PackageTests/Get/T7248/cabal.out | 6 +- .../RejectFutureIndexStates/cabal.out.in | 13 ++ .../RejectFutureIndexStates/cabal.project | 1 + .../RejectFutureIndexStates/cabal.test.hs | 19 ++ .../RejectFutureIndexStates/fake-pkg/Main.hs | 3 + .../fake-pkg/fake-pkg.cabal | 8 + .../repo/pkg-1.0/Foo.hs | 3 + .../repo/pkg-1.0/pkg.cabal | 8 + changelog.d/die-on-missing-pkg-list | 11 ++ changelog.d/index-state-cabal-update | 14 ++ 18 files changed, 258 insertions(+), 149 deletions(-) create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.project create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/Main.hs create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/fake-pkg.cabal create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/Foo.hs create mode 100644 cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/pkg.cabal create mode 100644 changelog.d/die-on-missing-pkg-list create mode 100644 changelog.d/index-state-cabal-update diff --git a/.gitignore b/.gitignore index 72a16455c82..4ade63478ab 100644 --- a/.gitignore +++ b/.gitignore @@ -85,3 +85,6 @@ bench.html # Emacs .projectile + +# I'm unsure how to ignore these generated golden files +cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out diff --git a/cabal-install/src/Distribution/Client/CmdUpdate.hs b/cabal-install/src/Distribution/Client/CmdUpdate.hs index 8f66a33a363..c0f4e05a137 100644 --- a/cabal-install/src/Distribution/Client/CmdUpdate.hs +++ b/cabal-install/src/Distribution/Client/CmdUpdate.hs @@ -98,7 +98,7 @@ import Distribution.Simple.Command import System.FilePath (dropExtension, (<.>)) import Distribution.Client.Errors -import Distribution.Client.IndexUtils.Timestamp (nullTimestamp) +import Distribution.Client.IndexUtils.Timestamp (Timestamp (NoTimestamp)) import qualified Hackage.Security.Client as Sec updateCommand :: CommandUI (NixStyleFlags ()) @@ -257,18 +257,19 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) RepoSecure{} -> repoContextWithSecureRepo repoCtxt repo $ \repoSecure -> do let index = RepoIndex repoCtxt repo - -- NB: This may be a nullTimestamp if we've never updated before - current_ts <- currentIndexTimestamp (lessVerbose verbosity) repoCtxt repo + -- NB: This may be a NoTimestamp if we've never updated before + current_ts <- currentIndexTimestamp (lessVerbose verbosity) index -- NB: always update the timestamp, even if we didn't actually -- download anything writeIndexTimestamp index indexState - ce <- - if repoContextIgnoreExpiry repoCtxt - then Just `fmap` getCurrentTime - else return Nothing - updated <- Sec.uncheckClientErrors $ Sec.checkForUpdates repoSecure ce - -- this resolves indexState (which could be HEAD) into a timestamp - new_ts <- currentIndexTimestamp (lessVerbose verbosity) repoCtxt repo + + updated <- do + ce <- + if repoContextIgnoreExpiry repoCtxt + then Just <$> getCurrentTime + else return Nothing + Sec.uncheckClientErrors $ Sec.checkForUpdates repoSecure ce + let rname = remoteRepoName (repoRemote repo) -- Update cabal's internal index as well so that it's not out of sync @@ -277,7 +278,8 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do Sec.NoUpdates -> do now <- getCurrentTime setModificationTime (indexBaseName repo <.> "tar") now - `catchIO` (\e -> warn verbosity $ "Could not set modification time of index tarball -- " ++ displayException e) + `catchIO` \e -> + warn verbosity $ "Could not set modification time of index tarball -- " ++ displayException e noticeNoWrap verbosity $ "Package list of " ++ prettyShow rname ++ " is up to date." Sec.HasUpdates -> do @@ -285,6 +287,11 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do noticeNoWrap verbosity $ "Package list of " ++ prettyShow rname ++ " has been updated." + -- This resolves indexState (which could be HEAD) into a timestamp + -- This could be null but should not be, since the above guarantees + -- we have an updated index. + new_ts <- currentIndexTimestamp (lessVerbose verbosity) index + noticeNoWrap verbosity $ "The index-state is set to " ++ prettyShow (IndexStateTime new_ts) ++ "." @@ -294,7 +301,7 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do -- In case current_ts is a valid timestamp different from new_ts, let -- the user know how to go back to current_ts - when (current_ts /= nullTimestamp && new_ts /= current_ts) $ + when (current_ts /= NoTimestamp && new_ts /= current_ts) $ noticeNoWrap verbosity $ "To revert to previous state run:\n" ++ " cabal v2-update '" diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index 5db31ba5d3b..ada3eca5268 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -25,6 +25,9 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BS8 import Data.List (groupBy) +import Distribution.Client.IndexUtils.Timestamp +import Distribution.Client.Types.Repo +import Distribution.Client.Types.RepoName (RepoName (..)) import Distribution.Compat.Prelude import Distribution.Deprecated.ParseUtils (PWarning, showPWarning) import Distribution.Package @@ -179,6 +182,8 @@ data CabalInstallException | FreezeException String | PkgSpecifierException [String] | CorruptedIndexCache String + | UnusableIndexState RemoteRepo Timestamp Timestamp + | MissingPackageList RemoteRepo deriving (Show, Typeable) exceptionCodeCabalInstall :: CabalInstallException -> Int @@ -327,6 +332,8 @@ exceptionCodeCabalInstall e = case e of FreezeException{} -> 7156 PkgSpecifierException{} -> 7157 CorruptedIndexCache{} -> 7158 + UnusableIndexState{} -> 7159 + MissingPackageList{} -> 7160 exceptionMessageCabalInstall :: CabalInstallException -> String exceptionMessageCabalInstall e = case e of @@ -828,6 +835,20 @@ exceptionMessageCabalInstall e = case e of FreezeException errs -> errs PkgSpecifierException errorStr -> unlines errorStr CorruptedIndexCache str -> str + UnusableIndexState repoRemote maxFound requested -> + "Latest known index-state for '" + ++ unRepoName (remoteRepoName repoRemote) + ++ "' (" + ++ prettyShow maxFound + ++ ") is older than the requested index-state (" + ++ prettyShow requested + ++ ").\nRun 'cabal update' or set the index-state to a value at or before " + ++ prettyShow maxFound + ++ "." + MissingPackageList repoRemote -> + "The package list for '" + ++ unRepoName (remoteRepoName repoRemote) + ++ "' does not exist. Run 'cabal update' to download it." instance Exception (VerboseException CabalInstallException) where displayException :: VerboseException CabalInstallException -> [Char] diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index e2ea4486426..2dc7d37e29c 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -212,7 +212,7 @@ data IndexStateInfo = IndexStateInfo } emptyStateInfo :: IndexStateInfo -emptyStateInfo = IndexStateInfo nullTimestamp nullTimestamp +emptyStateInfo = IndexStateInfo NoTimestamp NoTimestamp -- | Filters a 'Cache' according to an 'IndexState' -- specification. Also returns 'IndexStateInfo' describing the @@ -318,40 +318,31 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do IndexStateHead -> do info verbosity ("index-state(" ++ unRepoName rname ++ ") = " ++ prettyShow (isiHeadTime isi)) return () - IndexStateTime ts0 -> do + IndexStateTime ts0 -> + -- isiMaxTime is the latest timestamp in the filtered view returned by + -- `readRepoIndex` above. It is always true that isiMaxTime is less or + -- equal to a requested IndexStateTime. When `isiMaxTime isi /= ts0` (or + -- equivalently `isiMaxTime isi < ts0`) it means that ts0 falls between + -- two timestamps in the index. when (isiMaxTime isi /= ts0) $ - if ts0 > isiMaxTime isi - then - warn verbosity $ - "Requested index-state " - ++ prettyShow ts0 - ++ " is newer than '" + let commonMsg = + "There is no index-state for '" ++ unRepoName rname - ++ "'!" - ++ " Falling back to older state (" - ++ prettyShow (isiMaxTime isi) - ++ ")." - else - info verbosity $ - "Requested index-state " + ++ "' exactly at the requested timestamp (" ++ prettyShow ts0 - ++ " does not exist in '" - ++ unRepoName rname - ++ "'!" - ++ " Falling back to older state (" - ++ prettyShow (isiMaxTime isi) - ++ ")." - info - verbosity - ( "index-state(" - ++ unRepoName rname - ++ ") = " - ++ prettyShow (isiMaxTime isi) - ++ " (HEAD = " - ++ prettyShow (isiHeadTime isi) - ++ ")" - ) - + ++ "). " + in if isNothing $ timestampToUTCTime (isiMaxTime isi) + then + warn verbosity $ + commonMsg + ++ "Also, there are no index-states before the one requested, so the repository '" + ++ unRepoName rname + ++ "' will be empty." + else + info verbosity $ + commonMsg + ++ "Falling back to the previous index-state that exists: " + ++ prettyShow (isiMaxTime isi) pure RepoData { rdRepoName = rname @@ -381,7 +372,7 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do [ (n, IndexStateTime ts) | (RepoData n ts _idx _prefs, _strategy) <- pkgss' , -- e.g. file+noindex have nullTimestamp as their timestamp - ts /= nullTimestamp + ts /= NoTimestamp ] let addIndex @@ -439,15 +430,16 @@ readRepoIndex -> IO (PackageIndex UnresolvedSourcePackage, [Dependency], IndexStateInfo) readRepoIndex verbosity repoCtxt repo idxState = handleNotFound $ do - when (isRepoRemote repo) $ warnIfIndexIsOld =<< getIndexFileAge repo - -- note that if this step fails due to a bad repo cache, the the procedure can still succeed by reading from the existing cache, which is updated regardless. - updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) - `catchIO` (\e -> warn verbosity $ "unable to update the repo index cache -- " ++ displayException e) - readPackageIndexCacheFile - verbosity - mkAvailablePackage - (RepoIndex repoCtxt repo) - idxState + ret@(_, _, isi) <- + readPackageIndexCacheFile + verbosity + mkAvailablePackage + (RepoIndex repoCtxt repo) + idxState + when (isRepoRemote repo) $ do + warnIfIndexIsOld =<< getIndexFileAge repo + dieIfRequestedIdxIsNewer isi + pure ret where mkAvailablePackage pkgEntry = SourcePackage @@ -468,8 +460,8 @@ readRepoIndex verbosity repoCtxt repo idxState = if isDoesNotExistError e then do case repo of - RepoRemote{..} -> warn verbosity $ errMissingPackageList repoRemote - RepoSecure{..} -> warn verbosity $ errMissingPackageList repoRemote + RepoRemote{..} -> dieWithException verbosity $ MissingPackageList repoRemote + RepoSecure{..} -> dieWithException verbosity $ MissingPackageList repoRemote RepoLocalNoIndex local _ -> warn verbosity $ "Error during construction of local+noindex " @@ -479,18 +471,25 @@ readRepoIndex verbosity repoCtxt repo idxState = return (mempty, mempty, emptyStateInfo) else ioError e + isOldThreshold :: Double isOldThreshold = 15 -- days warnIfIndexIsOld dt = do when (dt >= isOldThreshold) $ case repo of - RepoRemote{..} -> warn verbosity $ errOutdatedPackageList repoRemote dt - RepoSecure{..} -> warn verbosity $ errOutdatedPackageList repoRemote dt + RepoRemote{..} -> warn verbosity $ warnOutdatedPackageList repoRemote dt + RepoSecure{..} -> warn verbosity $ warnOutdatedPackageList repoRemote dt RepoLocalNoIndex{} -> return () - errMissingPackageList repoRemote = - "The package list for '" - ++ unRepoName (remoteRepoName repoRemote) - ++ "' does not exist. Run 'cabal update' to download it." - errOutdatedPackageList repoRemote dt = + dieIfRequestedIdxIsNewer isi = + let latestTime = isiHeadTime isi + in case idxState of + IndexStateTime t -> when (t > latestTime) $ case repo of + RepoSecure{..} -> + dieWithException verbosity $ UnusableIndexState repoRemote latestTime t + RepoRemote{} -> pure () + RepoLocalNoIndex{} -> return () + IndexStateHead -> pure () + + warnOutdatedPackageList repoRemote dt = "The package list for '" ++ unRepoName (remoteRepoName repoRemote) ++ "' is " @@ -852,9 +851,8 @@ withIndexEntries _ (RepoIndex repoCtxt repo@RepoSecure{}) callback _ = where blockNo = Sec.directoryEntryBlockNo dirEntry timestamp = - fromMaybe (error "withIndexEntries: invalid timestamp") $ - epochTimeToTimestamp $ - Sec.indexEntryTime sie + epochTimeToTimestamp $ + Sec.indexEntryTime sie withIndexEntries verbosity (RepoIndex _repoCtxt (RepoLocalNoIndex (LocalRepo name localDir _) _cacheDir)) _ callback = do dirContents <- listDirectory localDir let contentSet = Set.fromList dirContents @@ -942,10 +940,14 @@ withIndexEntries verbosity index callback _ = do callback $ map toCache (catMaybes pkgsOrPrefs) where toCache :: PackageOrDep -> IndexCacheEntry - toCache (Pkg (NormalPackage pkgid _ _ blockNo)) = CachePackageId pkgid blockNo nullTimestamp + toCache (Pkg (NormalPackage pkgid _ _ blockNo)) = CachePackageId pkgid blockNo NoTimestamp toCache (Pkg (BuildTreeRef refType _ _ _ blockNo)) = CacheBuildTreeRef refType blockNo - toCache (Dep d) = CachePreference d 0 nullTimestamp + toCache (Dep d) = CachePreference d 0 NoTimestamp +-- | Read package data from a repository. +-- Throws IOException if any arise while accessing the index +-- (unless the repo is local+no-index) and dies if the cache +-- is corrupted and cannot be regenerated correctly. readPackageIndexCacheFile :: Package pkg => Verbosity @@ -959,12 +961,18 @@ readPackageIndexCacheFile verbosity mkPkg index idxState (pkgs, prefs) <- packageNoIndexFromCache verbosity mkPkg cache0 pure (pkgs, prefs, emptyStateInfo) | otherwise = do - cache0 <- readIndexCache verbosity index + (cache, isi) <- getIndexCache verbosity index idxState indexHnd <- openFile (indexFile index) ReadMode - let (cache, isi) = filterCache idxState cache0 (pkgs, deps) <- packageIndexFromCache verbosity mkPkg indexHnd cache pure (pkgs, deps, isi) +-- | Read 'Cache' and 'IndexStateInfo' from the repository index file. +-- Throws IOException if any arise (e.g. the index or its cache are missing). +-- Dies if the index cache is corrupted and cannot be regenerated correctly. +getIndexCache :: Verbosity -> Index -> RepoIndexState -> IO (Cache, IndexStateInfo) +getIndexCache verbosity index idxState = + filterCache idxState <$> readIndexCache verbosity index + packageIndexFromCache :: Package pkg => Verbosity @@ -1087,7 +1095,7 @@ packageListFromCache verbosity mkPkg hnd Cache{..} = accum mempty [] mempty cach ------------------------------------------------------------------------ -- Index cache data structure -- --- | Read the 'Index' cache from the filesystem +-- | Read a repository cache from the filesystem -- -- If a corrupted index cache is detected this function regenerates -- the index cache and then reattempt to read the index once (and @@ -1110,6 +1118,11 @@ readIndexCache verbosity index = do either (dieWithException verbosity . CorruptedIndexCache) (return . hashConsCache) =<< readIndexCache' index Right res -> return (hashConsCache res) +-- | Read a no-index repository cache from the filesystem +-- +-- If a corrupted index cache is detected this function regenerates +-- the index cache and then reattempts to read the index once (and +-- 'dieWithException's if it fails again). Throws IOException if any arise. readNoIndexCache :: Verbosity -> Index -> IO NoIndexCache readNoIndexCache verbosity index = do cacheOrFail <- readNoIndexCache' index @@ -1130,11 +1143,12 @@ readNoIndexCache verbosity index = do -- we don't hash cons local repository cache, they are hopefully small Right res -> return res --- | Read the 'Index' cache from the filesystem without attempting to --- regenerate on parsing failures. +-- | Read the 'Index' cache from the filesystem. Throws IO exceptions +-- if any arise and returns Left on invalid input. readIndexCache' :: Index -> IO (Either String Cache) readIndexCache' index - | is01Index index = structuredDecodeFileOrFail (cacheFile index) + | is01Index index = + structuredDecodeFileOrFail (cacheFile index) | otherwise = Right . read00IndexCache <$> BSS.readFile (cacheFile index) @@ -1159,15 +1173,27 @@ writeIndexTimestamp index st = writeFile (timestampFile index) (prettyShow st) -- | Read out the "current" index timestamp, i.e., what --- timestamp you would use to revert to this version -currentIndexTimestamp :: Verbosity -> RepoContext -> Repo -> IO Timestamp -currentIndexTimestamp verbosity repoCtxt r = do - mb_is <- readIndexTimestamp verbosity (RepoIndex repoCtxt r) +-- timestamp you would use to revert to this version. +-- +-- Note: this is not the same as 'readIndexTimestamp'! +-- This resolves HEAD to the index's 'isiHeadTime', i.e. +-- the index latest known timestamp. +-- +-- Return NoTimestamp if the index has never been updated. +currentIndexTimestamp :: Verbosity -> Index -> IO Timestamp +currentIndexTimestamp verbosity index = do + mb_is <- readIndexTimestamp verbosity index case mb_is of - Just (IndexStateTime ts) -> return ts - _ -> do - (_, _, isi) <- readRepoIndex verbosity repoCtxt r IndexStateHead - return (isiHeadTime isi) + -- If the index timestamp file specifies an index state time, use that + Just (IndexStateTime ts) -> + return ts + -- Otherwise used the head time as stored in the index cache + _otherwise -> + fmap (isiHeadTime . snd) (getIndexCache verbosity index IndexStateHead) + `catchIO` \e -> + if isDoesNotExistError e + then return NoTimestamp + else ioError e -- | Read the 'IndexState' from the filesystem readIndexTimestamp :: Verbosity -> Index -> IO (Maybe RepoIndexState) @@ -1259,7 +1285,7 @@ instance NFData NoIndexCacheEntry where rnf (NoIndexCachePreference dep) = rnf dep cacheEntryTimestamp :: IndexCacheEntry -> Timestamp -cacheEntryTimestamp (CacheBuildTreeRef _ _) = nullTimestamp +cacheEntryTimestamp (CacheBuildTreeRef _ _) = NoTimestamp cacheEntryTimestamp (CachePreference _ _ ts) = ts cacheEntryTimestamp (CachePackageId _ _ ts) = ts @@ -1311,7 +1337,7 @@ preferredVersionKey = "pref-ver:" read00IndexCache :: BSS.ByteString -> Cache read00IndexCache bs = Cache - { cacheHeadTs = nullTimestamp + { cacheHeadTs = NoTimestamp , cacheEntries = mapMaybe read00IndexCacheEntry $ BSS.lines bs } @@ -1329,7 +1355,7 @@ read00IndexCacheEntry = \line -> ( CachePackageId (PackageIdentifier pkgname pkgver) blockno - nullTimestamp + NoTimestamp ) _ -> Nothing [key, typecodestr, blocknostr] | key == BSS.pack buildTreeRefKey -> @@ -1339,7 +1365,7 @@ read00IndexCacheEntry = \line -> _ -> Nothing (key : remainder) | key == BSS.pack preferredVersionKey -> do pref <- simpleParsecBS (BSS.unwords remainder) - return $ CachePreference pref 0 nullTimestamp + return $ CachePreference pref 0 NoTimestamp _ -> Nothing where parseName str diff --git a/cabal-install/src/Distribution/Client/IndexUtils/Timestamp.hs b/cabal-install/src/Distribution/Client/IndexUtils/Timestamp.hs index 3dfe2963437..10034472277 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils/Timestamp.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils/Timestamp.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -12,8 +12,7 @@ -- -- Timestamp type used in package indexes module Distribution.Client.IndexUtils.Timestamp - ( Timestamp - , nullTimestamp + ( Timestamp (NoTimestamp) , epochTimeToTimestamp , timestampToUTCTime , utcTimeToTimestamp @@ -33,38 +32,30 @@ import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp -- | UNIX timestamp (expressed in seconds since unix epoch, i.e. 1970). -newtype Timestamp = TS Int64 -- Tar.EpochTime - deriving (Eq, Ord, Enum, NFData, Show, Generic) +data Timestamp = NoTimestamp | TS Int64 -- Tar.EpochTime + deriving (Eq, Ord, NFData, Show, Generic) -epochTimeToTimestamp :: Tar.EpochTime -> Maybe Timestamp -epochTimeToTimestamp et - | ts == nullTimestamp = Nothing - | otherwise = Just ts - where - ts = TS et +epochTimeToTimestamp :: Tar.EpochTime -> Timestamp +epochTimeToTimestamp = TS timestampToUTCTime :: Timestamp -> Maybe UTCTime -timestampToUTCTime (TS t) - | t == minBound = Nothing - | otherwise = Just $ posixSecondsToUTCTime (fromIntegral t) +timestampToUTCTime NoTimestamp = Nothing +timestampToUTCTime (TS t) = Just $ posixSecondsToUTCTime (fromIntegral t) -utcTimeToTimestamp :: UTCTime -> Maybe Timestamp -utcTimeToTimestamp utct - | minTime <= t, t <= maxTime = Just (TS (fromIntegral t)) - | otherwise = Nothing - where - maxTime = toInteger (maxBound :: Int64) - minTime = toInteger (succ minBound :: Int64) - t :: Integer - t = round . utcTimeToPOSIXSeconds $ utct +utcTimeToTimestamp :: UTCTime -> Timestamp +utcTimeToTimestamp = + TS + . (fromIntegral :: Integer -> Int64) + . round + . utcTimeToPOSIXSeconds -- | Compute the maximum 'Timestamp' value -- --- Returns 'nullTimestamp' for the empty list. Also note that --- 'nullTimestamp' compares as smaller to all non-'nullTimestamp' +-- Returns 'NoTimestamp' for the empty list. Also note that +-- 'NoTimestamp' compares as smaller to all non-'NoTimestamp' -- values. maximumTimestamp :: [Timestamp] -> Timestamp -maximumTimestamp [] = nullTimestamp +maximumTimestamp [] = NoTimestamp maximumTimestamp xs@(_ : _) = maximum xs -- returns 'Nothing' if not representable as 'Timestamp' @@ -76,17 +67,11 @@ posixSecondsToTimestamp pt maxTs = toInteger (maxBound :: Int64) minTs = toInteger (succ minBound :: Int64) --- | Pretty-prints 'Timestamp' in ISO8601/RFC3339 format --- (e.g. @"2017-12-31T23:59:59Z"@) --- --- Returns empty string for 'nullTimestamp' in order for --- --- > null (display nullTimestamp) == True --- --- to hold. +-- | Pretty-prints non-null 'Timestamp' in ISO8601/RFC3339 format +-- (e.g. @"2017-12-31T23:59:59Z"@). showTimestamp :: Timestamp -> String showTimestamp ts = case timestampToUTCTime ts of - Nothing -> "" + Nothing -> "Unknown or invalid timestamp" -- Note: we don't use 'formatTime' here to avoid incurring a -- dependency on 'old-locale' for older `time` libs Just UTCTime{..} -> showGregorian utctDay ++ ('T' : showTOD utctDayTime) ++ "Z" @@ -141,7 +126,7 @@ instance Parsec Timestamp where let utc = UTCTime{..} - maybe (fail (show utc ++ " is not representable as timestamp")) return $ utcTimeToTimestamp utc + return $ utcTimeToTimestamp utc parseTwoDigits = do d1 <- P.satisfy isDigit @@ -156,8 +141,3 @@ instance Parsec Timestamp where ds <- P.munch1 isDigit when (length ds < 4) $ fail "Year should have at least 4 digits" return (read (sign : ds)) - --- | Special timestamp value to be used when 'timestamp' is --- missing/unknown/invalid -nullTimestamp :: Timestamp -nullTimestamp = TS minBound diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs index bcd6e4134d1..13e06172f80 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs @@ -184,7 +184,7 @@ instance Arbitrary Timestamp where -- >>> utcTimeToPOSIXSeconds $ UTCTime (fromGregorian 100000 01 01) 0 -- >>> 3093527980800s -- - arbitrary = maybe (toEnum 0) id . epochTimeToTimestamp . (`mod` 3093527980800) . abs <$> arbitrary + arbitrary = epochTimeToTimestamp . (`mod` 3093527980800) . abs <$> arbitrary instance Arbitrary RepoIndexState where arbitrary = diff --git a/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs index 3b53e66c219..29c9fe587e0 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs @@ -23,23 +23,19 @@ tests = prop_timestamp1 :: NonNegative Int -> Bool prop_timestamp1 (NonNegative t0) = Just t == simpleParsec ('@' : show t0) where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp -- test prettyShow/simpleParse roundtrip prop_timestamp2 :: Int -> Bool -prop_timestamp2 t0 - | t /= nullTimestamp = simpleParsec (prettyShow t) == Just t - | otherwise = prettyShow t == "" +prop_timestamp2 t0 = simpleParsec (prettyShow t) == Just t where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp -- test prettyShow against reference impl prop_timestamp3 :: Int -> Bool -prop_timestamp3 t0 - | t /= nullTimestamp = refDisp t == prettyShow t - | otherwise = prettyShow t == "" +prop_timestamp3 t0 = refDisp t == prettyShow t where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp refDisp = maybe undefined (formatTime undefined "%FT%TZ") @@ -47,16 +43,13 @@ prop_timestamp3 t0 -- test utcTimeToTimestamp/timestampToUTCTime roundtrip prop_timestamp4 :: Int -> Bool -prop_timestamp4 t0 - | t /= nullTimestamp = (utcTimeToTimestamp =<< timestampToUTCTime t) == Just t - | otherwise = timestampToUTCTime t == Nothing +prop_timestamp4 t0 = + (utcTimeToTimestamp <$> timestampToUTCTime t) == Just t where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp prop_timestamp5 :: Int -> Bool -prop_timestamp5 t0 - | t /= nullTimestamp = timestampToUTCTime t == Just ut - | otherwise = timestampToUTCTime t == Nothing +prop_timestamp5 t0 = timestampToUTCTime t == Just ut where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp ut = posixSecondsToUTCTime (fromIntegral t0) diff --git a/cabal-testsuite/PackageTests/Get/OnlyDescription/cabal.test.hs b/cabal-testsuite/PackageTests/Get/OnlyDescription/cabal.test.hs index 3b4a36553c7..359d29a33de 100644 --- a/cabal-testsuite/PackageTests/Get/OnlyDescription/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Get/OnlyDescription/cabal.test.hs @@ -9,3 +9,4 @@ main = cabalTest $ withRepo "repo" $ do cabal "get" [ "criterion", "--only-package-description" ] + void (shell "rm" ["criterion-1.1.4.0.cabal"]) diff --git a/cabal-testsuite/PackageTests/Get/T7248/cabal.out b/cabal-testsuite/PackageTests/Get/T7248/cabal.out index 0c6e3ce035c..a172b425d4d 100644 --- a/cabal-testsuite/PackageTests/Get/T7248/cabal.out +++ b/cabal-testsuite/PackageTests/Get/T7248/cabal.out @@ -1,6 +1,4 @@ # cabal get Warning: /cabal.config: Unrecognized stanza on line 3 -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. +Error: [Cabal-7160] +The package list for 'repo.invalid' does not exist. Run 'cabal update' to download it. diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in new file mode 100644 index 00000000000..969b189c7b8 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in @@ -0,0 +1,13 @@ +# cabal build +Error: [Cabal-7159] +Latest known index-state for 'repository.localhost' (REPLACEME) is older than the requested index-state (4000-01-01T00:00:00Z). +Run 'cabal update' or set the index-state to a value at or before REPLACEME. +# cabal build +Warning: There is no index-state for 'repository.localhost' exactly at the requested timestamp (2023-01-01T00:00:00Z). Also, there are no index-states before the one requested, so the repository 'repository.localhost' will be empty. +Resolving dependencies... +Error: [Cabal-7107] +Could not resolve dependencies: +[__0] trying: fake-pkg-1.0 (user goal) +[__1] unknown package: pkg (dependency of fake-pkg) +[__1] fail (backjumping, conflict set: fake-pkg, pkg) +After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: fake-pkg (2), pkg (1) diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.project b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.project new file mode 100644 index 00000000000..a6de7296b36 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.project @@ -0,0 +1 @@ +packages: fake-pkg diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs new file mode 100644 index 00000000000..ca26a482d16 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs @@ -0,0 +1,19 @@ +import Test.Cabal.Prelude +import Data.List (isPrefixOf) + +main = cabalTest $ withProjectFile "cabal.project" $ withRemoteRepo "repo" $ do + output <- last + . words + . head + . filter ("Index cache updated to index-state " `isPrefixOf`) + . lines + . resultOutput + <$> recordMode DoNotRecord (cabal' "update" []) + -- update golden output with actual timestamp + shell "cp" ["cabal.out.in", "cabal.out"] + shell "sed" ["-i''", "-e", "s/REPLACEME/" <> output <> "/g", "cabal.out"] + -- This shall fail with an error message as specified in `cabal.out` + fails $ cabal "build" ["--index-state=4000-01-01T00:00:00Z", "fake-pkg"] + -- This shall fail by not finding the package, what indicates that it + -- accepted an older index-state. + fails $ cabal "build" ["--index-state=2023-01-01T00:00:00Z", "fake-pkg"] diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/Main.hs b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/Main.hs new file mode 100644 index 00000000000..e5f1c882aeb --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/Main.hs @@ -0,0 +1,3 @@ +module Main where + +main = print "hello" diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/fake-pkg.cabal b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/fake-pkg.cabal new file mode 100644 index 00000000000..813542d87f3 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/fake-pkg.cabal @@ -0,0 +1,8 @@ +version: 1.0 +name: fake-pkg +build-type: Simple +cabal-version: >= 1.2 + +executable my-exe + main-is: Main.hs + build-depends: base, pkg diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/Foo.hs b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/Foo.hs new file mode 100644 index 00000000000..9bb6374ab6c --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/Foo.hs @@ -0,0 +1,3 @@ +module Foo (someFunc) where + +someFunc = "hello" diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/pkg.cabal b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/pkg.cabal new file mode 100644 index 00000000000..b046359bf55 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/pkg.cabal @@ -0,0 +1,8 @@ +name: pkg +version: 1.0 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: Foo + build-depends: base diff --git a/changelog.d/die-on-missing-pkg-list b/changelog.d/die-on-missing-pkg-list new file mode 100644 index 00000000000..78e25843197 --- /dev/null +++ b/changelog.d/die-on-missing-pkg-list @@ -0,0 +1,11 @@ +synopsis: Die if package list is missing +packages: cabal-install +prs: #8944 + +description: { + +If a package list is missing, `cabal` will now die and suggest the user to run +`cabal update` instead of continuing into not being able to find packages coming +from the remote package server. + +} diff --git a/changelog.d/index-state-cabal-update b/changelog.d/index-state-cabal-update new file mode 100644 index 00000000000..f40ae672709 --- /dev/null +++ b/changelog.d/index-state-cabal-update @@ -0,0 +1,14 @@ +synopsis: Reject index-state younger than cached index file +packages: cabal-install +prs: #8944 + +description: { + +Requesting to use an index-state younger than the cached version will now fail, +telling the user to use an index-state older or equal to the cached file, or to +run `cabal update`. + +The warning for a non-existing index-state has been also demoted to appear only +on verbose logging. + +} From 9d3a7c72c759a5de6cfcf80a4757919ac7ee4541 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Mon, 6 Nov 2023 11:46:20 +0000 Subject: [PATCH 42/47] Fix AutogenModulesToggling test By converting this to a setupTest we use the in-tree Cabal library rather than relying on a proxy of the GHC version to provide the right Cabal library version. Supersedes #9398 --- .../AutogenModulesToggling/cabal.out | 22 ------------------- .../AutogenModulesToggling/cabal.test.hs | 13 +++++++---- 2 files changed, 9 insertions(+), 26 deletions(-) delete mode 100644 cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.out diff --git a/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.out b/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.out deleted file mode 100644 index 3b848ef431a..00000000000 --- a/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.out +++ /dev/null @@ -1,22 +0,0 @@ -# cabal v2-run -Resolving dependencies... -Build profile: -w ghc- -O1 -In order, the following will be built: - - test-0.1 (exe:autogen-toggle-test) (first run) -Configuring test-0.1... -Preprocessing library for test-0.1... -Building library for test-0.1... -Preprocessing executable 'autogen-toggle-test' for test-0.1... -Building executable 'autogen-toggle-test' for test-0.1... -The module says: Real module, ship to production -# cabal v2-run -Resolving dependencies... -Build profile: -w ghc- -O1 -In order, the following will be built: - - test-0.1 (exe:autogen-toggle-test) (configuration changed) -Configuring test-0.1... -Preprocessing library for test-0.1... -Building library for test-0.1... -Preprocessing executable 'autogen-toggle-test' for test-0.1... -Building executable 'autogen-toggle-test' for test-0.1... -The module says: Prebuilt module, don't use in production diff --git a/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.test.hs b/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.test.hs index 4b0e1639c12..5c6e866b2d1 100644 --- a/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.test.hs +++ b/cabal-testsuite/PackageTests/AutogenModulesToggling/cabal.test.hs @@ -1,7 +1,12 @@ import Test.Cabal.Prelude main :: IO () -main = cabalTest . recordMode RecordMarked $ do - skipUnlessGhcVersion ">= 9.7" - cabal "v2-run" ["-fgenerate", "autogen-toggle-test"] - cabal "v2-run" ["-f-generate", "autogen-toggle-test"] +main = setupTest . recordMode DoNotRecord . withPackageDb $ do + -- This test exposes a recompilation bug in ghc versions 9.0.2 and 9.2.8 + skipIfGhcVersion "== 9.0.2 || == 9.2.8 || < 8.0 " + setup_install ["-fgenerate"] + r1 <- runInstalledExe' "autogen-toggle-test" [] + setup_install ["-f-generate"] + r2 <- runInstalledExe' "autogen-toggle-test" [] + assertOutputContains "Real module, ship to production" r1 + assertOutputContains "Prebuilt module, don't use in production" r2 From fcd5b57c0cc9852964885c67912e2adff0703700 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 30 Aug 2023 11:45:36 +0100 Subject: [PATCH 43/47] Require version 3,11 of Cabal to support --semaphore flag Fixes #9197 --- cabal-install/src/Distribution/Client/ProjectPlanning.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 44372967fdb..3cb0d8033e8 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -4284,8 +4284,9 @@ setupHsBuildFlags par_strat elab _ verbosity builddir = , buildDistPref = toFlag builddir , buildNumJobs = mempty -- TODO: [nice to have] sometimes want to use toFlag (Just numBuildJobs), , buildUseSemaphore = - if elabSetupScriptCliVersion elab >= mkVersion [3, 9, 0, 0] - then par_strat + if elabSetupScriptCliVersion elab >= mkVersion [3, 11, 0, 0] + then -- Cabal 3.11 is the first version that supports parallelism semaphores + par_strat else mempty , buildArgs = mempty -- unused, passed via args not flags , buildCabalFilePath = mempty From b83cc31f54b91bf432b3c286cc5022801317efc7 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sat, 4 Nov 2023 13:38:49 +0100 Subject: [PATCH 44/47] Add dependencies used by `PackageTests` to exe:cabal-tests The runner allows the tests to use extra dependencies and the custom Prelude from 'cabal-testsuite'. However, if the tests use a dependency, say 'directory', and there are two packages with the same unit id available in the store, the test fails since it doesn't know which one to pick. By including an extra dependency to directory, we force the test runner to use a specific version directory, fixing the test failure. --- cabal-testsuite/cabal-testsuite.cabal | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index d4206163210..72221b316d5 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -101,6 +101,18 @@ executable cabal-tests , transformers -- dependencies specific to exe:cabal-tests , clock ^>= 0.7.2 || ^>=0.8 + -- Extra dependencies used by PackageTests. + -- + -- The runner allows the tests to use extra dependencies and the custom Prelude + -- from 'cabal-testsuite'. + -- However, if the tests use a dependency, say 'directory', and there are two + -- packages with the same unit id available in the store, the test fails since + -- it doesn't know which one to pick. + -- By including an extra dependency to directory, we force the test runner to + -- use a specific version directory, fixing the test failure. + -- + -- See issue description and discussion: https://github.com/haskell/cabal/issues/8356 + , directory build-tool-depends: cabal-testsuite:setup default-extensions: TypeOperators From 5df009cae1c226c1a7b764303cb2a0bc00dfac02 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?H=C3=A9cate=20Moonlight?= Date: Sat, 11 Nov 2023 12:56:20 +0100 Subject: [PATCH 45/47] Use Paths_cabal_install for cabal-install version number (#9421) * Use PackageInfo for cabal-install version number * Use Paths_cabal_install instead * Adjust documentation --------- Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> --- cabal-install/cabal-install.cabal | 2 ++ cabal-install/src/Distribution/Client/Version.hs | 12 +++++------- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index e45dc58a408..0a5e55bc3f1 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -63,6 +63,8 @@ library default-extensions: TypeOperators hs-source-dirs: src + other-modules: + Paths_cabal_install exposed-modules: -- this modules are moved from Cabal -- they are needed for as long until cabal-install moves to parsec parser diff --git a/cabal-install/src/Distribution/Client/Version.hs b/cabal-install/src/Distribution/Client/Version.hs index dc06552350f..f5c6bec510d 100644 --- a/cabal-install/src/Distribution/Client/Version.hs +++ b/cabal-install/src/Distribution/Client/Version.hs @@ -5,11 +5,9 @@ module Distribution.Client.Version import Distribution.Version --- This value determines the `cabal-install --version` output. --- --- It is used in several places throughout the project, including anonymous build reports, client configuration, --- and project planning output. Historically, this was a @Paths_*@ module, however, this conflicted with --- program coverage information generated by HPC, and hence was moved to be a standalone value. --- +import qualified Paths_cabal_install as PackageInfo + +-- | +-- This value determines the output of `cabal-install --version`. cabalInstallVersion :: Version -cabalInstallVersion = mkVersion [3, 11] +cabalInstallVersion = mkVersion' PackageInfo.version From ef0ca48b465ac75991c2ba3af5a7176f3f2678c0 Mon Sep 17 00:00:00 2001 From: Andreas Klebinger Date: Thu, 2 Nov 2023 14:02:04 +0100 Subject: [PATCH 46/47] Document --profiling-detail in setup-commands. Fixes #9182 --- doc/setup-commands.rst | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/setup-commands.rst b/doc/setup-commands.rst index 28cd9e988be..20bdafabfae 100644 --- a/doc/setup-commands.rst +++ b/doc/setup-commands.rst @@ -710,6 +710,14 @@ Miscellaneous options each module, whether top level or local. In GHC specifically, this is for non-inline toplevel or where-bound functions or values. + late-toplevel + Like top-level but costs will be assigned to top level definitions after + optimization. This lowers profiling overhead massively while giving similar + levels of detail as toplevle-functions. However it means functions introduced + by GHC during optimization will show up in profiles as well. + Corresponds to ``-fprof-late`` if supported and ``-fprof-auto-top`` otherwise. + late + Currently an alias for late-toplevel This flag is new in Cabal-1.24. Prior versions used the equivalent of ``none`` above. From 048138e58ab5813fa4db995c9bdf772f8d8f586a Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Mon, 6 Nov 2023 20:57:58 +0100 Subject: [PATCH 47/47] Add test requirement to PR template MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Adding test becomes a checkmark instead of “bonus points”. --- .github/pull_request_template.md | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index aa0b2b96c4e..8b36d183025 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -10,8 +10,7 @@ Include the following checklist in your PR: * [ ] Any changes that could be relevant to users [have been recorded in the changelog](https://github.com/haskell/cabal/blob/master/CONTRIBUTING.md#changelog). * [ ] The documentation has been updated, if necessary. * [ ] [Manual QA notes](https://github.com/haskell/cabal/blob/master/CONTRIBUTING.md#qa-notes) have been included. - -Bonus points for added automated tests! +* [ ] Tests have been added. (*Ask for help if you don’t know how to write them! Ask for an exemption if tests are too complex for too little coverage!*) ---