From 7c263bfca74aa1c463084095fcab970991d7374a Mon Sep 17 00:00:00 2001 From: Claude Date: Fri, 9 Oct 2026 17:47:55 +0000 Subject: [PATCH 1/5] SetupWrapper: make impossible cases unrepresentable Index SetupMethod by SetupWrapperSpec instead of a separate SetupKind, and have LibraryMethod carry the in-library arguments (InLibraryRun), with post-configure phases holding the LocalBuildInfo directly. The in-library method can then only be constructed from SetupRunnerArgs that permit it (inLibraryMethod), which removes the two internal errors in setupWrapper: - "NotInLibrary argument but getSetup chose InLibrary" - "in-library post-conf but no LBI" A post-configure phase given NotInLibraryNoLBI now uses the external method, consistent with how the package was configured. Also: - buildTypeScript takes a GeneratedSetupScript, so it is total. build-type Make (reachable on the v1 path) and Hooks with Cabal < 3.13 are reported with die' in updateSetupScript. - bestVersion takes a NonEmpty, removing the partial firstMaximumBy and the fromMaybe/error in installedCabalVersion. - Drop AllowInLibrary, SetupKind and the ASetup existential. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_01QTUcSRH5Ew1Q7PP35S8agF --- .../src/Distribution/Client/SetupWrapper.hs | 377 +++++++++--------- changelog.d/setupwrapper-unreachable.md | 15 + 2 files changed, 213 insertions(+), 179 deletions(-) create mode 100644 changelog.d/setupwrapper-unreachable.md diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs index 93faf44e53a..25c89cfd80e 100644 --- a/cabal-install/src/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs @@ -150,9 +150,6 @@ import Distribution.Simple.Utils , rewriteFileLBS , tryFindPackageDesc ) -import Distribution.Utils.Generic - ( safeHead - ) import Distribution.Compat.Stack import Distribution.ReadE @@ -175,7 +172,6 @@ import Distribution.Client.SetupHooks.CallHooksExe import Control.Concurrent.STM (TVar, readTVarIO) import qualified Data.ByteString.Lazy as BS -import Data.List (foldl1') import Data.Kind (Type, Constraint) import qualified Data.Map.Lazy as Map import Data.Type.Equality ( type (==) ) @@ -199,15 +195,6 @@ import qualified System.Win32 as Win32 -------------------------------------------------------------------------------- -data AllowInLibrary - = AllowInLibrary - | Don'tAllowInLibrary - deriving Eq - -data SetupKind - = InLibrary - | GeneralSetup - -- | If we end up using the in-library method, we use the v'InLibraryLBI' -- constructor. If not, we use the 'NotInLibraryNoLBI' constructor. -- @@ -215,6 +202,9 @@ data SetupKind -- e.g. for a package with Hooks build-type, it depends on whether the Cabal -- version used by the package matches with the Cabal version that cabal-install -- was built against. +-- +-- Post-configure phases given 'NotInLibraryNoLBI' always use the external +-- method (see 'inLibraryMethod'). data InLibraryLBI = InLibraryLBI LocalBuildInfo | NotInLibraryNoLBI @@ -267,23 +257,53 @@ type family InLibraryPhaseRes flags where -- | @Setup@ encapsulates the outcome of configuring a setup method to build a -- particular package. -data Setup kind = Setup - { setupMethod :: SetupMethod kind +data Setup spec = Setup + { setupMethod :: SetupMethod spec , setupScriptOptions :: SetupScriptOptions , setupVersion :: Version , setupBuildType :: BuildType , setupPackage :: PackageDescription } -data ASetup = forall kind. ASetup ( Setup kind ) - -- | @SetupMethod@ represents one of the methods used to run Cabal commands. -data SetupMethod (kind :: SetupKind) where +-- +-- The in-library method can only be chosen when the 'SetupRunnerArgs' allow +-- it, and it carries everything needed to run in-library. +data SetupMethod (spec :: SetupWrapperSpec) where -- | Directly use Cabal library functions, bypassing the Setup -- mechanism entirely. - LibraryMethod :: SetupMethod InLibrary + LibraryMethod :: InLibraryRun flags -> SetupMethod (TryInLibrary flags) -- | run Cabal commands through a custom \"Setup\" executable - ExternalMethod :: FilePath -> SetupMethod GeneralSetup + ExternalMethod :: FilePath -> SetupMethod spec + +-- | The arguments to the in-library method, once we know it can be used. +-- +-- Unlike 'InLibraryArgs', post-configure phases carry a 'LocalBuildInfo': +-- without one, the in-library method is not available. +data InLibraryRun (flags :: Type) where + InLibraryConfigure + :: ElaboratedSharedConfig + -> ElaboratedReadyPackage + -> TVar InstalledPackageIndex + -> InLibraryRun ConfigFlags + InLibraryPostConfigure + :: SPostConfigurePhase flags + -> LocalBuildInfo + -> InLibraryRun flags + +-- | The in-library method for the given arguments, if they permit one. +-- +-- A post-configure phase without a 'LocalBuildInfo' means the package was +-- configured by an external Setup, so later phases must use one too. +inLibraryMethod :: SetupRunnerArgs spec -> Maybe (SetupMethod spec) +inLibraryMethod NotInLibrary = Nothing +inLibraryMethod (InLibraryArgs libArgs) = case libArgs of + InLibraryConfigureArgs elabSharedConfig elabReadyPkg ipiTVar -> + Just $ LibraryMethod $ InLibraryConfigure elabSharedConfig elabReadyPkg ipiTVar + InLibraryPostConfigureArgs sPhase (InLibraryLBI lbi) -> + Just $ LibraryMethod $ InLibraryPostConfigure sPhase lbi + InLibraryPostConfigureArgs _ NotInLibraryNoLBI -> + Nothing -- TODO: The 'setupWrapper' and 'SetupScriptOptions' should be split into two -- parts: one that has no policy and just does as it's told with all the @@ -446,9 +466,10 @@ getSetup :: Verbosity -> SetupScriptOptions -> Maybe PackageDescription - -> AllowInLibrary - -> IO ASetup -getSetup verbosity options mpkg allowInLibrary = do + -> Maybe (SetupMethod spec) + -- ^ the in-library method, if the arguments permit one + -> IO (Setup spec) +getSetup verbosity options mpkg mbLibraryMethod = do pkg <- maybe getPkg return mpkg let options' = options @@ -465,15 +486,15 @@ getSetup verbosity options mpkg allowInLibrary = do buildType' = case (buildType pkg, isMainLibOrExeComponent options) of (Configure, False) -> Simple (bt, _) -> bt - withSetupMethod verbosity options' pkg buildType' allowInLibrary $ - \ (version, method, options'') -> - ASetup $ Setup - { setupMethod = method - , setupScriptOptions = options'' - , setupVersion = version - , setupBuildType = buildType' - , setupPackage = pkg - } + (version, method, options'') <- + chooseSetupMethod verbosity options' pkg buildType' mbLibraryMethod + return Setup + { setupMethod = method + , setupScriptOptions = options'' + , setupVersion = version + , setupBuildType = buildType' + , setupPackage = pkg + } where mbWorkDir = useWorkingDir options getPkg = @@ -483,45 +504,47 @@ getSetup verbosity options mpkg allowInLibrary = do -- | Decide if we're going to be able to do a direct internal call to the -- entry point in the Cabal library or if we're going to have to compile -- and execute an external Setup.hs script. -withSetupMethod +chooseSetupMethod :: Verbosity -> SetupScriptOptions -> PackageDescription -> BuildType - -> AllowInLibrary - -> ( forall kind. (Version, SetupMethod kind, SetupScriptOptions ) -> r ) - -> IO r -withSetupMethod verbosity options pkg buildType' allowInLibrary with - | buildType' == Custom - || maybe False (cabalVersion /=) (useCabalSpecVersion options) - || not (cabalVersion `withinRange` useCabalVersion options) - || allowInLibrary == Don'tAllowInLibrary - || (buildType' == Hooks && not hasHooksMain) = - withExternalSetupMethod - | buildType' == Hooks = do - -- NB: needs 'hooksMain' available in Cabal to compile the external - -- hooks executable, hence the 'not hasHooksMain' guard above. - compileExternalExe verbosity options pkg buildType' WantHooks - externalHooksABI <- - externalSetupHooksABI verbosity $ - hooksProgFilePath (useWorkingDir options) (useDistPref options) - let internalHooksABI = hooksVersion - if externalHooksABI == internalHooksABI - then do - debug verbosity "Using in-library setup method with build-type Hooks." - return $ with (cabalVersion, LibraryMethod, options) - else do - debug verbosity "Hooks ABI mismatch; falling back to external setup method." - withExternalSetupMethod - | otherwise = do - debug verbosity $ "Using in-library setup method with build-type " ++ show buildType' - return $ with (cabalVersion, LibraryMethod, options) + -> Maybe (SetupMethod spec) + -- ^ the in-library method, if the arguments permit one + -> IO (Version, SetupMethod spec, SetupScriptOptions) +chooseSetupMethod verbosity options pkg buildType' mbLibraryMethod = + case mbLibraryMethod of + Nothing -> externalMethod + Just libraryMethod + | buildType' == Custom + || maybe False (cabalVersion /=) (useCabalSpecVersion options) + || not (cabalVersion `withinRange` useCabalVersion options) + || (buildType' == Hooks && not hasHooksMain) -> + externalMethod + | buildType' == Hooks -> do + -- NB: needs 'hooksMain' available in Cabal to compile the external + -- hooks executable, hence the 'not hasHooksMain' guard above. + compileExternalExe verbosity options pkg buildType' WantHooks + externalHooksABI <- + externalSetupHooksABI verbosity $ + hooksProgFilePath (useWorkingDir options) (useDistPref options) + let internalHooksABI = hooksVersion + if externalHooksABI == internalHooksABI + then do + debug verbosity "Using in-library setup method with build-type Hooks." + return (cabalVersion, libraryMethod, options) + else do + debug verbosity "Hooks ABI mismatch; falling back to external setup method." + externalMethod + | otherwise -> do + debug verbosity $ "Using in-library setup method with build-type " ++ show buildType' + return (cabalVersion, libraryMethod, options) where hasHooksMain = case cabalLibFromOptions options of Just (v, _) -> v >= mkVersion [3, 17] Nothing -> False - withExternalSetupMethod = do + externalMethod = do debug verbosity $ "Using external setup method with build-type " ++ show buildType' debug verbosity $ case useSetupDependencies options of ExplicitSetupDeps deps -> @@ -530,15 +553,17 @@ withSetupMethod verbosity options pkg buildType' allowInLibrary with ImplicitSetupDeps deps -> "Using implicit dependencies: " ++ show (map (prettyShow . snd) deps) - with <$> compileExternalExe verbosity options pkg buildType' WantSetup + (version, path, options') <- + compileExternalExe verbosity options pkg buildType' WantSetup + return (version, ExternalMethod path, options') -runSetupMethod :: WithCallStack (SetupMethod GeneralSetup -> SetupRunner UseGeneralSetup) +runSetupMethod :: WithCallStack (SetupMethod UseGeneralSetup -> SetupRunner UseGeneralSetup) runSetupMethod (ExternalMethod path) = externalSetupMethod path -- | Run a configured 'Setup' with specific arguments. runSetup :: Verbosity - -> Setup GeneralSetup + -> Setup UseGeneralSetup -> [String] -- ^ command-line arguments -> SetupRunnerArgs UseGeneralSetup @@ -596,7 +621,7 @@ verbosityHack ver args0 -- | Run a command through a configured 'Setup'. runSetupCommand :: Verbosity - -> Setup GeneralSetup + -> Setup UseGeneralSetup -> CommandUI flags -- ^ command definition -> (flags -> CommonSetupFlags) @@ -631,18 +656,16 @@ setupWrapper -> SetupRunnerArgs setupSpec -> IO (SetupRunnerRes setupSpec) setupWrapper verbosity options mpkg cmd getCommonFlags getFlags getExtraArgs wrapperArgs = do - let allowInLibrary = case wrapperArgs of - InLibraryArgs {} -> AllowInLibrary - NotInLibrary -> Don'tAllowInLibrary - ASetup (setup :: Setup kind) <- getSetup verbosity options mpkg allowInLibrary + setup <- getSetup verbosity options mpkg (inLibraryMethod wrapperArgs) let version = setupVersion setup flags <- getFlags version let verbHandles = verbosityHandles verbosity extraArgs = getExtraArgs version - notInLibraryMethod :: kind ~ GeneralSetup => IO (SetupRunnerRes setupSpec) - notInLibraryMethod = do - runSetupCommand verbosity setup cmd getCommonFlags flags extraArgs NotInLibrary + case setupMethod setup of + ExternalMethod path -> do + runSetupCommand verbosity setup{setupMethod = ExternalMethod path} + cmd getCommonFlags flags extraArgs NotInLibrary return $ case wrapperArgs of NotInLibrary -> () InLibraryArgs libArgs -> @@ -657,87 +680,71 @@ setupWrapper verbosity options mpkg cmd getCommonFlags getFlags getExtraArgs wra SRegisterPhase -> () STestPhase -> () SBenchPhase -> () - case setupMethod setup of - LibraryMethod -> - case wrapperArgs of - InLibraryArgs libArgs -> - case libArgs of - InLibraryConfigureArgs elabSharedConfig elabReadyPkg ipiTVar -> do - -- Start from the pre-configured compiler ProgramDb, augmented - -- with all builtin programs (restored as unconfigured). - -- This ensures: - -- (a) configureAllKnownPrograms inside configureFinal skips - -- compiler programs (already configured at project level), - -- (b) builtin preprocessors like alex and happy are present as - -- unconfigured programs, so configureFinal's - -- configureAllKnownPrograms can find them using the - -- per-package search path (respecting extra-prog-path). - -- See (1) in Note [Constructing the ProgramDb]. - - -- Apply per-package user-supplied program args/paths. - -- See (2)(a) in Note [Constructing the ProgramDb] - baseProgDb <- - -- Use 'mkProgramDb' to pass user-supplied per-package - -- program options (--PROG-options=...). - mkProgramDb verbHandles flags - (restoreProgramDb builtinPrograms $ - pkgConfigCompilerProgs elabSharedConfig) - setupProgDb <- - prependProgramSearchPath verbosity - (useExtraPathEnv options) - (useExtraEnvOverrides options) - baseProgDb - -- Read the project InstalledPackageIndex to avoid needing to query - -- @ghc-pkg@ to obtain it. - -- in Distribution.Client.ProjectBuilding. - ipi <- readTVarIO ipiTVar - lbi0 <- - InLibrary.configure - (InLibrary.libraryConfigureInputsFromElabPackage - verbHandles - (setupBuildType setup) - setupProgDb - elabSharedConfig - elabReadyPkg - ipi - extraArgs - ) - flags - let progs0 = LBI.withPrograms lbi0 - -- See (2)(b) in Note [Constructing the ProgramDb] - progs1 <- updatePathProgDb verbosity progs0 - let - lbi = - lbi0 - { LBI.withPrograms = progs1 - } - mbWorkDir = useWorkingDir options - distPref = useDistPref options - -- Write the LocalBuildInfo to disk. This is needed, for instance, if we - -- skip re-configuring; we retrieve the LocalBuildInfo stored on disk from - -- the previous invocation of 'configure' and pass it to 'build'. - writePersistBuildConfig mbWorkDir distPref lbi - return (InLibraryLBI lbi) - InLibraryPostConfigureArgs sPhase mbLBI -> - case mbLBI of - NotInLibraryNoLBI -> - error "internal error: in-library post-conf but no LBI" - -- To avoid running into the above error, we must ensure that - -- when we skip re-configuring, we retrieve the cached - -- LocalBuildInfo (see "whenReconfigure" - -- in Distribution.Client.ProjectBuilding.UnpackedPackage). - InLibraryLBI lbi -> - case sPhase of - SBuildPhase -> InLibrary.build verbHandles flags lbi extraArgs - SHaddockPhase -> InLibrary.haddock verbHandles flags lbi extraArgs - SReplPhase -> InLibrary.repl verbHandles flags lbi extraArgs - SCopyPhase -> InLibrary.copy verbHandles flags lbi extraArgs - STestPhase -> InLibrary.test verbHandles flags lbi extraArgs - SBenchPhase -> InLibrary.bench verbHandles flags lbi extraArgs - SRegisterPhase -> InLibrary.register flags lbi extraArgs - NotInLibrary -> - error "internal error: NotInLibrary argument but getSetup chose InLibrary" - ExternalMethod {} -> notInLibraryMethod + LibraryMethod (InLibraryConfigure elabSharedConfig elabReadyPkg ipiTVar) -> do + -- Start from the pre-configured compiler ProgramDb, augmented + -- with all builtin programs (restored as unconfigured). + -- This ensures: + -- (a) configureAllKnownPrograms inside configureFinal skips + -- compiler programs (already configured at project level), + -- (b) builtin preprocessors like alex and happy are present as + -- unconfigured programs, so configureFinal's + -- configureAllKnownPrograms can find them using the + -- per-package search path (respecting extra-prog-path). + -- See (1) in Note [Constructing the ProgramDb]. + + -- Apply per-package user-supplied program args/paths. + -- See (2)(a) in Note [Constructing the ProgramDb] + baseProgDb <- + -- Use 'mkProgramDb' to pass user-supplied per-package + -- program options (--PROG-options=...). + mkProgramDb verbHandles flags + (restoreProgramDb builtinPrograms $ + pkgConfigCompilerProgs elabSharedConfig) + setupProgDb <- + prependProgramSearchPath verbosity + (useExtraPathEnv options) + (useExtraEnvOverrides options) + baseProgDb + -- Read the project InstalledPackageIndex to avoid needing to query + -- @ghc-pkg@ to obtain it. + -- in Distribution.Client.ProjectBuilding. + ipi <- readTVarIO ipiTVar + lbi0 <- + InLibrary.configure + (InLibrary.libraryConfigureInputsFromElabPackage + verbHandles + (setupBuildType setup) + setupProgDb + elabSharedConfig + elabReadyPkg + ipi + extraArgs + ) + flags + let progs0 = LBI.withPrograms lbi0 + -- See (2)(b) in Note [Constructing the ProgramDb] + progs1 <- updatePathProgDb verbosity progs0 + let + lbi = + lbi0 + { LBI.withPrograms = progs1 + } + mbWorkDir = useWorkingDir options + distPref = useDistPref options + -- Write the LocalBuildInfo to disk. This is needed, for instance, if we + -- skip re-configuring; we retrieve the LocalBuildInfo stored on disk from + -- the previous invocation of 'configure' and pass it to 'build'. + writePersistBuildConfig mbWorkDir distPref lbi + return (InLibraryLBI lbi) + LibraryMethod (InLibraryPostConfigure sPhase lbi) -> + case sPhase of + SBuildPhase -> InLibrary.build verbHandles flags lbi extraArgs + SHaddockPhase -> InLibrary.haddock verbHandles flags lbi extraArgs + SReplPhase -> InLibrary.repl verbHandles flags lbi extraArgs + SCopyPhase -> InLibrary.copy verbHandles flags lbi extraArgs + STestPhase -> InLibrary.test verbHandles flags lbi extraArgs + SBenchPhase -> InLibrary.bench verbHandles flags lbi extraArgs + SRegisterPhase -> InLibrary.register flags lbi extraArgs {- Note [Constructing the ProgramDb] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -873,7 +880,7 @@ compileExternalExe -> PackageDescription -> BuildType -> WantedExternalExe exe - -> IO (If (exe == HooksExe) () (Version, SetupMethod GeneralSetup, SetupScriptOptions)) + -> IO (If (exe == HooksExe) () (Version, FilePath, SetupScriptOptions)) compileExternalExe verbosity options pkg bt wantedExe = do createDirectoryIfMissingVerbose verbosity True $ i (setupDir options) (cabalLibVersion, mCabalLibInstalledPkgId, options') <- @@ -923,7 +930,7 @@ compileExternalExe verbosity options pkg bt wantedExe = do case wantedExe of WantHooks -> return () - WantSetup -> return (cabalLibVersion, ExternalMethod exePath', options'') + WantSetup -> return (cabalLibVersion, exePath', options'') where mbWorkDir = useWorkingDir options -- See Note [Symbolic paths] in Distribution.Utils.Path @@ -990,38 +997,50 @@ updateSetupScript verbosity options _ Custom = do customSetupLhs = workingDir options "Setup.lhs" i = interpretSymbolicPath (useWorkingDir options) updateSetupScript verbosity options cabalLibVersion Hooks = do + unless (cabalLibVersion >= mkVersion [3, 13, 0]) $ + die' verbosity $ + "Using 'build-type: Hooks' requires Cabal >= 3.13, but Cabal-" + ++ prettyShow cabalLibVersion ++ " was selected." let customSetupHooks = workingDir options "SetupHooks.hs" useHs <- doesFileExist customSetupHooks unless useHs $ die' verbosity "Using 'build-type: Hooks' but there is no SetupHooks.hs file." copyFileVerbose verbosity customSetupHooks (i (setupHooks options)) - rewriteFileLBS verbosity (i (setupHs options)) (buildTypeScript Hooks cabalLibVersion) + rewriteFileLBS verbosity (i (setupHs options)) (buildTypeScript HooksScript cabalLibVersion) rewriteFileLBS verbosity (i (hooksHs options)) hooksExeScript where i = interpretSymbolicPath (useWorkingDir options) -updateSetupScript verbosity options cabalLibVersion bt' = - rewriteFileLBS verbosity (i (setupHs options)) (buildTypeScript bt' cabalLibVersion) +updateSetupScript verbosity _ _ Make = + die' verbosity "'build-type: Make' is no longer supported." +updateSetupScript verbosity options cabalLibVersion Simple = + rewriteFileLBS verbosity (i (setupHs options)) (buildTypeScript SimpleScript cabalLibVersion) where i = interpretSymbolicPath (useWorkingDir options) +updateSetupScript verbosity options cabalLibVersion Configure = + rewriteFileLBS verbosity (i (setupHs options)) (buildTypeScript ConfigureScript cabalLibVersion) + where + i = interpretSymbolicPath (useWorkingDir options) + +-- | The build types for which we generate the @Setup.hs@ script ourselves. +data GeneratedSetupScript + = SimpleScript + | ConfigureScript + | -- | Requires Cabal >= 3.13. + HooksScript -- | The source code for a non-Custom 'Setup' executable. -buildTypeScript :: BuildType -> Version -> BS.ByteString +buildTypeScript :: GeneratedSetupScript -> Version -> BS.ByteString buildTypeScript bt cabalLibVersion = "{-# LANGUAGE NoImplicitPrelude #-}\n" <> case bt of - Simple -> "import Distribution.Simple; main = defaultMain\n" - Configure + SimpleScript -> "import Distribution.Simple; main = defaultMain\n" + ConfigureScript | cabalLibVersion >= mkVersion [3, 13, 0] -> "import Distribution.Simple; main = defaultMainWithSetupHooks autoconfSetupHooks\n" | cabalLibVersion >= mkVersion [1, 3, 10] -> "import Distribution.Simple; main = defaultMainWithHooks autoconfUserHooks\n" | otherwise -> "import Distribution.Simple; main = defaultMainWithHooks defaultUserHooks\n" - Make -> error "buildtypeScript Make is no longer supported" - Hooks - | cabalLibVersion >= mkVersion [3, 13, 0] - -> "import Distribution.Simple; import SetupHooks; main = defaultMainWithSetupHooks setupHooks\n" - | otherwise - -> error "buildTypeScript Hooks with Cabal < 3.13" - Custom -> error "buildTypeScript Custom" + HooksScript -> + "import Distribution.Simple; import SetupHooks; main = defaultMainWithSetupHooks setupHooks\n" -- | The source code for an external hooks executable. hooksExeScript :: BS.ByteString @@ -1472,12 +1491,14 @@ installedCabalVersion verbosity pkgId _bt options' compiler progdb = do let cabalDepName = mkPackageName "Cabal" cabalDepVersion = useCabalVersion options' options'' = options'{usePackageIndex = Just index} - case PackageIndex.lookupDependency index cabalDepName cabalDepVersion of - [] -> + pkgs = PackageIndex.lookupDependency index cabalDepName cabalDepVersion + -- 'lookupDependency' never returns a version without any package, but + -- the type does not say so. + case nonEmpty [ (v, ipkginfo) | (v, ipkginfo : _) <- pkgs ] of + Nothing -> dieWithException verbosity $ InstalledCabalVersion (packageName pkgId) (useCabalVersion options') - pkgs -> - let ipkginfo = fromMaybe err $ safeHead . snd . bestVersion fst $ pkgs - err = error "Distribution.Client.installedCabalVersion: empty version list" + Just pkgs' -> + let ipkginfo = snd $ bestVersion fst pkgs' in return ( packageVersion ipkginfo , Just . IPI.installedComponentId $ ipkginfo @@ -1489,7 +1510,7 @@ installedCabalVersion verbosity pkgId _bt options' compiler progdb = do -- Pick the best version from a non-empty list, preferring the one that -- matches or is closest to the currently running @cabal-install@\'s own -- @Cabal@ library version. -bestVersion :: (a -> Version) -> [a] -> a +bestVersion :: (a -> Version) -> NonEmpty a -> a bestVersion f = firstMaximumBy (comparing (preference . f)) where -- Like maximumBy, but picks the first maximum element instead of the @@ -1501,10 +1522,8 @@ bestVersion f = firstMaximumBy (comparing (preference . f)) -- `maximumBy cmp . reverse`, but the problem is that the behaviour of -- maximumBy is not fully specified in the case when there is not a single -- greatest element. - firstMaximumBy :: (a -> a -> Ordering) -> [a] -> a - firstMaximumBy _ [] = - error "Distribution.Client.firstMaximumBy: empty list" - firstMaximumBy cmp xs = foldl1' maxBy xs + firstMaximumBy :: (a -> a -> Ordering) -> NonEmpty a -> a + firstMaximumBy cmp (a0 :| as) = foldl' maxBy a0 as where maxBy x y = case cmp x y of GT -> x; EQ -> x; LT -> y diff --git a/changelog.d/setupwrapper-unreachable.md b/changelog.d/setupwrapper-unreachable.md new file mode 100644 index 00000000000..b838675fdfb --- /dev/null +++ b/changelog.d/setupwrapper-unreachable.md @@ -0,0 +1,15 @@ +--- +synopsis: Make impossible cases in SetupWrapper unrepresentable +packages: [cabal-install] +prs: 12434 +--- + +`SetupMethod` is now indexed by the `SetupWrapperSpec` of the call and the +in-library method carries its arguments, so selecting the in-library method for +an external-only call, or for a post-configure phase without a +`LocalBuildInfo`, no longer type checks. The corresponding internal `error` +calls are gone. + +`build-type: Make` packages on the legacy v1 path (still parsed for +`cabal-version` < 3.18), and `build-type: Hooks` with a Cabal library older +than 3.13, now fail with a proper error message instead of an internal error. From 822f3c1e600f2f138c37eac61769c446f52cc72f Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Tue, 13 Oct 2026 15:51:55 +0800 Subject: [PATCH 2/5] SetupWrapper: fold InLibraryRun into InLibraryArgs InLibraryArgs (what callers pass) and InLibraryRun (what the chosen in-library method carries) were the same GADT except for the post-configure slot: InLibraryLBI in one, LocalBuildInfo in the other. Parameterise InLibraryArgs by what sits in that slot and drop the duplicate. inLibraryMethod becomes the function that fills the slot. Call sites are unchanged since the constructor names stay the same. Co-Authored-By: Claude Fable 5.1 --- .../src/Distribution/Client/SetupWrapper.hs | 52 ++++++++----------- 1 file changed, 22 insertions(+), 30 deletions(-) diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs index 25c89cfd80e..d7c663588f6 100644 --- a/cabal-install/src/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs @@ -230,19 +230,25 @@ data SetupRunnerArgs (spec :: SetupWrapperSpec) where NotInLibrary :: SetupRunnerArgs UseGeneralSetup InLibraryArgs - :: InLibraryArgs flags + :: InLibraryArgs InLibraryLBI flags -> SetupRunnerArgs (TryInLibrary flags) -data InLibraryArgs (flags :: Type) where +-- | What the in-library method needs for a phase. +-- +-- @lbi@ is what post-configure phases carry in the 'LocalBuildInfo' slot. +-- Callers pass 'InLibraryLBI', since the package may have been configured by +-- an external Setup; once the in-library method is chosen (see +-- 'inLibraryMethod') it holds a 'LocalBuildInfo' outright. +data InLibraryArgs (lbi :: Type) (flags :: Type) where InLibraryConfigureArgs :: ElaboratedSharedConfig -> ElaboratedReadyPackage -> TVar InstalledPackageIndex - -> InLibraryArgs ConfigFlags + -> InLibraryArgs lbi ConfigFlags InLibraryPostConfigureArgs :: SPostConfigurePhase flags - -> InLibraryLBI - -> InLibraryArgs flags + -> lbi + -> InLibraryArgs lbi flags type family SetupRunnerRes (spec :: SetupWrapperSpec) where SetupRunnerRes UseGeneralSetup = () @@ -272,38 +278,24 @@ data Setup spec = Setup data SetupMethod (spec :: SetupWrapperSpec) where -- | Directly use Cabal library functions, bypassing the Setup -- mechanism entirely. - LibraryMethod :: InLibraryRun flags -> SetupMethod (TryInLibrary flags) + LibraryMethod :: InLibraryArgs LocalBuildInfo flags -> SetupMethod (TryInLibrary flags) -- | run Cabal commands through a custom \"Setup\" executable ExternalMethod :: FilePath -> SetupMethod spec --- | The arguments to the in-library method, once we know it can be used. --- --- Unlike 'InLibraryArgs', post-configure phases carry a 'LocalBuildInfo': --- without one, the in-library method is not available. -data InLibraryRun (flags :: Type) where - InLibraryConfigure - :: ElaboratedSharedConfig - -> ElaboratedReadyPackage - -> TVar InstalledPackageIndex - -> InLibraryRun ConfigFlags - InLibraryPostConfigure - :: SPostConfigurePhase flags - -> LocalBuildInfo - -> InLibraryRun flags - -- | The in-library method for the given arguments, if they permit one. -- -- A post-configure phase without a 'LocalBuildInfo' means the package was -- configured by an external Setup, so later phases must use one too. inLibraryMethod :: SetupRunnerArgs spec -> Maybe (SetupMethod spec) inLibraryMethod NotInLibrary = Nothing -inLibraryMethod (InLibraryArgs libArgs) = case libArgs of - InLibraryConfigureArgs elabSharedConfig elabReadyPkg ipiTVar -> - Just $ LibraryMethod $ InLibraryConfigure elabSharedConfig elabReadyPkg ipiTVar - InLibraryPostConfigureArgs sPhase (InLibraryLBI lbi) -> - Just $ LibraryMethod $ InLibraryPostConfigure sPhase lbi - InLibraryPostConfigureArgs _ NotInLibraryNoLBI -> - Nothing +inLibraryMethod (InLibraryArgs libArgs) = + LibraryMethod <$> case libArgs of + InLibraryConfigureArgs elabSharedConfig elabReadyPkg ipiTVar -> + Just (InLibraryConfigureArgs elabSharedConfig elabReadyPkg ipiTVar) + InLibraryPostConfigureArgs sPhase (InLibraryLBI lbi) -> + Just (InLibraryPostConfigureArgs sPhase lbi) + InLibraryPostConfigureArgs _ NotInLibraryNoLBI -> + Nothing -- TODO: The 'setupWrapper' and 'SetupScriptOptions' should be split into two -- parts: one that has no policy and just does as it's told with all the @@ -680,7 +672,7 @@ setupWrapper verbosity options mpkg cmd getCommonFlags getFlags getExtraArgs wra SRegisterPhase -> () STestPhase -> () SBenchPhase -> () - LibraryMethod (InLibraryConfigure elabSharedConfig elabReadyPkg ipiTVar) -> do + LibraryMethod (InLibraryConfigureArgs elabSharedConfig elabReadyPkg ipiTVar) -> do -- Start from the pre-configured compiler ProgramDb, augmented -- with all builtin programs (restored as unconfigured). -- This ensures: @@ -736,7 +728,7 @@ setupWrapper verbosity options mpkg cmd getCommonFlags getFlags getExtraArgs wra -- the previous invocation of 'configure' and pass it to 'build'. writePersistBuildConfig mbWorkDir distPref lbi return (InLibraryLBI lbi) - LibraryMethod (InLibraryPostConfigure sPhase lbi) -> + LibraryMethod (InLibraryPostConfigureArgs sPhase lbi) -> case sPhase of SBuildPhase -> InLibrary.build verbHandles flags lbi extraArgs SHaddockPhase -> InLibrary.haddock verbHandles flags lbi extraArgs From 82afd650aa97bd2163ab40ad016e44e40846cac9 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Tue, 13 Oct 2026 15:57:41 +0800 Subject: [PATCH 3/5] SetupWrapper: name the generated scripts *SetupScript Suggested in review of #12434. Co-Authored-By: Claude Fable 5.1 --- .../src/Distribution/Client/SetupWrapper.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs index d7c663588f6..fd94b157eb6 100644 --- a/cabal-install/src/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs @@ -998,40 +998,40 @@ updateSetupScript verbosity options cabalLibVersion Hooks = do unless useHs $ die' verbosity "Using 'build-type: Hooks' but there is no SetupHooks.hs file." copyFileVerbose verbosity customSetupHooks (i (setupHooks options)) - rewriteFileLBS verbosity (i (setupHs options)) (buildTypeScript HooksScript cabalLibVersion) + rewriteFileLBS verbosity (i (setupHs options)) (buildTypeScript HooksSetupScript cabalLibVersion) rewriteFileLBS verbosity (i (hooksHs options)) hooksExeScript where i = interpretSymbolicPath (useWorkingDir options) updateSetupScript verbosity _ _ Make = die' verbosity "'build-type: Make' is no longer supported." updateSetupScript verbosity options cabalLibVersion Simple = - rewriteFileLBS verbosity (i (setupHs options)) (buildTypeScript SimpleScript cabalLibVersion) + rewriteFileLBS verbosity (i (setupHs options)) (buildTypeScript SimpleSetupScript cabalLibVersion) where i = interpretSymbolicPath (useWorkingDir options) updateSetupScript verbosity options cabalLibVersion Configure = - rewriteFileLBS verbosity (i (setupHs options)) (buildTypeScript ConfigureScript cabalLibVersion) + rewriteFileLBS verbosity (i (setupHs options)) (buildTypeScript ConfigureSetupScript cabalLibVersion) where i = interpretSymbolicPath (useWorkingDir options) -- | The build types for which we generate the @Setup.hs@ script ourselves. data GeneratedSetupScript - = SimpleScript - | ConfigureScript + = SimpleSetupScript + | ConfigureSetupScript | -- | Requires Cabal >= 3.13. - HooksScript + HooksSetupScript -- | The source code for a non-Custom 'Setup' executable. buildTypeScript :: GeneratedSetupScript -> Version -> BS.ByteString buildTypeScript bt cabalLibVersion = "{-# LANGUAGE NoImplicitPrelude #-}\n" <> case bt of - SimpleScript -> "import Distribution.Simple; main = defaultMain\n" - ConfigureScript + SimpleSetupScript -> "import Distribution.Simple; main = defaultMain\n" + ConfigureSetupScript | cabalLibVersion >= mkVersion [3, 13, 0] -> "import Distribution.Simple; main = defaultMainWithSetupHooks autoconfSetupHooks\n" | cabalLibVersion >= mkVersion [1, 3, 10] -> "import Distribution.Simple; main = defaultMainWithHooks autoconfUserHooks\n" | otherwise -> "import Distribution.Simple; main = defaultMainWithHooks defaultUserHooks\n" - HooksScript -> + HooksSetupScript -> "import Distribution.Simple; import SetupHooks; main = defaultMainWithSetupHooks setupHooks\n" -- | The source code for an external hooks executable. From b713a30d0719a47ae252ea5482b1131133e65f95 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Tue, 13 Oct 2026 15:57:53 +0800 Subject: [PATCH 4/5] SetupWrapper: say Cabal 3.14, not 3.13 3.13 is the odd development series; Hooks shipped in 3.14. Use the release number in the messages and the version guards. Suggested in review of #12434. Co-Authored-By: Claude Fable 5.1 --- cabal-install/src/Distribution/Client/SetupWrapper.hs | 8 ++++---- changelog.d/setupwrapper-unreachable.md | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs index fd94b157eb6..74b3686c179 100644 --- a/cabal-install/src/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs @@ -989,9 +989,9 @@ updateSetupScript verbosity options _ Custom = do customSetupLhs = workingDir options "Setup.lhs" i = interpretSymbolicPath (useWorkingDir options) updateSetupScript verbosity options cabalLibVersion Hooks = do - unless (cabalLibVersion >= mkVersion [3, 13, 0]) $ + unless (cabalLibVersion >= mkVersion [3, 14]) $ die' verbosity $ - "Using 'build-type: Hooks' requires Cabal >= 3.13, but Cabal-" + "Using 'build-type: Hooks' requires Cabal >= 3.14, but Cabal-" ++ prettyShow cabalLibVersion ++ " was selected." let customSetupHooks = workingDir options "SetupHooks.hs" useHs <- doesFileExist customSetupHooks @@ -1017,7 +1017,7 @@ updateSetupScript verbosity options cabalLibVersion Configure = data GeneratedSetupScript = SimpleSetupScript | ConfigureSetupScript - | -- | Requires Cabal >= 3.13. + | -- | Requires Cabal >= 3.14. HooksSetupScript -- | The source code for a non-Custom 'Setup' executable. @@ -1025,7 +1025,7 @@ buildTypeScript :: GeneratedSetupScript -> Version -> BS.ByteString buildTypeScript bt cabalLibVersion = "{-# LANGUAGE NoImplicitPrelude #-}\n" <> case bt of SimpleSetupScript -> "import Distribution.Simple; main = defaultMain\n" ConfigureSetupScript - | cabalLibVersion >= mkVersion [3, 13, 0] + | cabalLibVersion >= mkVersion [3, 14] -> "import Distribution.Simple; main = defaultMainWithSetupHooks autoconfSetupHooks\n" | cabalLibVersion >= mkVersion [1, 3, 10] -> "import Distribution.Simple; main = defaultMainWithHooks autoconfUserHooks\n" diff --git a/changelog.d/setupwrapper-unreachable.md b/changelog.d/setupwrapper-unreachable.md index b838675fdfb..343ab37a9e9 100644 --- a/changelog.d/setupwrapper-unreachable.md +++ b/changelog.d/setupwrapper-unreachable.md @@ -12,4 +12,4 @@ calls are gone. `build-type: Make` packages on the legacy v1 path (still parsed for `cabal-version` < 3.18), and `build-type: Hooks` with a Cabal library older -than 3.13, now fail with a proper error message instead of an internal error. +than 3.14, now fail with a proper error message instead of an internal error. From 25155500b855b66b4ea3b2c674c59d45582bbce5 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Tue, 13 Oct 2026 15:58:39 +0800 Subject: [PATCH 5/5] SetupWrapper: replace InLibraryLBI with Maybe LocalBuildInfo InLibraryLBI was a Maybe with a story attached. With InLibraryArgs now parameterised by what sits in the LocalBuildInfo slot, the story fits in its Haddock and inLibraryMethod becomes a plain traversal of the slot. Co-Authored-By: Claude Fable 5.1 --- .../Client/ProjectBuilding/UnpackedPackage.hs | 8 ++-- .../src/Distribution/Client/SetupWrapper.hs | 37 ++++++------------- 2 files changed, 15 insertions(+), 30 deletions(-) diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs index 1c48169e6bd..1b26f06bfc1 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs @@ -139,7 +139,7 @@ import Web.Browser (openBrowser) -- the phases will be carried out differently. For example, when installing, -- the test, benchmark, and repl phase are ignored. data PackageBuildingPhase r where - PBConfigurePhase :: {runConfigure :: IO InLibraryLBI} -> PackageBuildingPhase InLibraryLBI + PBConfigurePhase :: {runConfigure :: IO (Maybe Cabal.LocalBuildInfo)} -> PackageBuildingPhase (Maybe Cabal.LocalBuildInfo) PBBuildPhase :: {runBuild :: IO [MonitorFilePath]} -> PackageBuildingPhase () PBHaddockPhase :: {runHaddock :: IO [MonitorFilePath]} -> PackageBuildingPhase () PBReplPhase :: {runRepl :: IO [MonitorFilePath]} -> PackageBuildingPhase () @@ -489,7 +489,7 @@ buildAndRegisterUnpackedPackage scriptOptions{isInteractive = True} (Just (elabPkgDescription pkg)) - generateInstalledPackageInfo :: InLibraryLBI -> IO InstalledPackageInfo + generateInstalledPackageInfo :: Maybe Cabal.LocalBuildInfo -> IO InstalledPackageInfo generateInstalledPackageInfo mbLBI = withTempInstalledPackageInfoFile verbosity @@ -698,7 +698,7 @@ buildInplaceUnpackedPackage (monitors ++ monitors' ++ dep_monitors) buildResult - whenReconfigure :: IO InLibraryLBI -> IO InLibraryLBI + whenReconfigure :: IO (Maybe Cabal.LocalBuildInfo) -> IO (Maybe Cabal.LocalBuildInfo) whenReconfigure configure_action = case buildStatus of BuildStatusConfigure _ -> configure_action @@ -724,7 +724,7 @@ buildInplaceUnpackedPackage builtinPrograms (Cabal.withPrograms lbi_wo_programs) } - return $ InLibraryLBI lbi + return $ Just lbi whenRebuild, whenReRegister :: IO () -> IO () whenRebuild action diff --git a/cabal-install/src/Distribution/Client/SetupWrapper.hs b/cabal-install/src/Distribution/Client/SetupWrapper.hs index 74b3686c179..f4deabb9b9b 100644 --- a/cabal-install/src/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/src/Distribution/Client/SetupWrapper.hs @@ -27,7 +27,6 @@ module Distribution.Client.SetupWrapper , SPostConfigurePhase(..) , InLibraryArgs(..) , SetupRunnerRes - , InLibraryLBI(..) , RightFlagsForPhase , setupWrapper , SetupScriptOptions (..) @@ -195,20 +194,6 @@ import qualified System.Win32 as Win32 -------------------------------------------------------------------------------- --- | If we end up using the in-library method, we use the v'InLibraryLBI' --- constructor. If not, we use the 'NotInLibraryNoLBI' constructor. --- --- NB: we don't know ahead of time whether we can use the in-library method; --- e.g. for a package with Hooks build-type, it depends on whether the Cabal --- version used by the package matches with the Cabal version that cabal-install --- was built against. --- --- Post-configure phases given 'NotInLibraryNoLBI' always use the external --- method (see 'inLibraryMethod'). -data InLibraryLBI - = InLibraryLBI LocalBuildInfo - | NotInLibraryNoLBI - data SPostConfigurePhase (flags :: Type) where SBuildPhase :: SPostConfigurePhase BuildFlags SHaddockPhase :: SPostConfigurePhase HaddockFlags @@ -230,15 +215,17 @@ data SetupRunnerArgs (spec :: SetupWrapperSpec) where NotInLibrary :: SetupRunnerArgs UseGeneralSetup InLibraryArgs - :: InLibraryArgs InLibraryLBI flags + :: InLibraryArgs (Maybe LocalBuildInfo) flags -> SetupRunnerArgs (TryInLibrary flags) -- | What the in-library method needs for a phase. -- -- @lbi@ is what post-configure phases carry in the 'LocalBuildInfo' slot. --- Callers pass 'InLibraryLBI', since the package may have been configured by --- an external Setup; once the in-library method is chosen (see --- 'inLibraryMethod') it holds a 'LocalBuildInfo' outright. +-- Callers pass a @'Maybe' 'LocalBuildInfo'@, since they do not know ahead of +-- time whether the package was configured in-library (e.g. with the Hooks +-- build type it depends on whether the Cabal version used by the package +-- matches the one cabal-install was built against). Once the in-library method +-- is chosen (see 'inLibraryMethod') it holds a 'LocalBuildInfo' outright. data InLibraryArgs (lbi :: Type) (flags :: Type) where InLibraryConfigureArgs :: ElaboratedSharedConfig @@ -255,7 +242,7 @@ type family SetupRunnerRes (spec :: SetupWrapperSpec) where SetupRunnerRes (TryInLibrary phase) = InLibraryPhaseRes phase type family InLibraryPhaseRes flags where - InLibraryPhaseRes ConfigFlags = InLibraryLBI + InLibraryPhaseRes ConfigFlags = Maybe LocalBuildInfo InLibraryPhaseRes BuildFlags = [MonitorFilePath] InLibraryPhaseRes HaddockFlags = [MonitorFilePath] InLibraryPhaseRes ReplFlags = [MonitorFilePath] @@ -292,10 +279,8 @@ inLibraryMethod (InLibraryArgs libArgs) = LibraryMethod <$> case libArgs of InLibraryConfigureArgs elabSharedConfig elabReadyPkg ipiTVar -> Just (InLibraryConfigureArgs elabSharedConfig elabReadyPkg ipiTVar) - InLibraryPostConfigureArgs sPhase (InLibraryLBI lbi) -> - Just (InLibraryPostConfigureArgs sPhase lbi) - InLibraryPostConfigureArgs _ NotInLibraryNoLBI -> - Nothing + InLibraryPostConfigureArgs sPhase mbLBI -> + InLibraryPostConfigureArgs sPhase <$> mbLBI -- TODO: The 'setupWrapper' and 'SetupScriptOptions' should be split into two -- parts: one that has no policy and just does as it's told with all the @@ -662,7 +647,7 @@ setupWrapper verbosity options mpkg cmd getCommonFlags getFlags getExtraArgs wra NotInLibrary -> () InLibraryArgs libArgs -> case libArgs of - InLibraryConfigureArgs {} -> NotInLibraryNoLBI + InLibraryConfigureArgs {} -> Nothing InLibraryPostConfigureArgs sPhase _ -> case sPhase of SBuildPhase -> [] @@ -727,7 +712,7 @@ setupWrapper verbosity options mpkg cmd getCommonFlags getFlags getExtraArgs wra -- skip re-configuring; we retrieve the LocalBuildInfo stored on disk from -- the previous invocation of 'configure' and pass it to 'build'. writePersistBuildConfig mbWorkDir distPref lbi - return (InLibraryLBI lbi) + return (Just lbi) LibraryMethod (InLibraryPostConfigureArgs sPhase lbi) -> case sPhase of SBuildPhase -> InLibrary.build verbHandles flags lbi extraArgs