diff --git a/Cabal/Distribution/PackageDescription.hs b/Cabal/Distribution/PackageDescription.hs index 20cb29b1224..4e1f466eff6 100644 --- a/Cabal/Distribution/PackageDescription.hs +++ b/Cabal/Distribution/PackageDescription.hs @@ -97,7 +97,7 @@ module Distribution.PackageDescription ( GenericPackageDescription(..), Flag(..), FlagName(..), FlagAssignment, CondTree(..), ConfVar(..), Condition(..), - cNot, + cNot, cAnd, cOr, -- * Source repositories SourceRepo(..), @@ -111,7 +111,7 @@ module Distribution.PackageDescription ( import Distribution.Compat.Binary import qualified Distribution.Compat.Semigroup as Semi ((<>)) -import Distribution.Compat.Semigroup as Semi (Monoid(..), Semigroup, gmempty, gmappend) +import Distribution.Compat.Semigroup as Semi (Monoid(..), Semigroup, gmempty) import qualified Distribution.Compat.ReadP as Parse import Distribution.Compat.ReadP ((<++)) import Distribution.Package @@ -308,18 +308,24 @@ instance Text BuildType where -- options authors can specify to just Haskell package dependencies. data SetupBuildInfo = SetupBuildInfo { - setupDepends :: [Dependency] + setupDepends :: [Dependency], + defaultSetupDepends :: Bool + -- ^ Is this a default 'custom-setup' section added by the cabal-install + -- code (as opposed to user-provided)? This field is only used + -- internally, and doesn't correspond to anything in the .cabal + -- file. See #3199. } deriving (Generic, Show, Eq, Read, Typeable, Data) instance Binary SetupBuildInfo instance Semi.Monoid SetupBuildInfo where - mempty = gmempty + mempty = SetupBuildInfo [] False mappend = (Semi.<>) instance Semigroup SetupBuildInfo where - (<>) = gmappend + a <> b = SetupBuildInfo (setupDepends a Semi.<> setupDepends b) + (defaultSetupDepends a || defaultSetupDepends b) -- --------------------------------------------------------------------------- -- Module renaming @@ -1193,11 +1199,32 @@ data Condition c = Var c | CAnd (Condition c) (Condition c) deriving (Show, Eq, Typeable, Data, Generic) +-- | Boolean negation of a 'Condition' value. cNot :: Condition a -> Condition a cNot (Lit b) = Lit (not b) cNot (CNot c) = c cNot c = CNot c +-- | Boolean AND of two 'Condtion' values. +cAnd :: Condition a -> Condition a -> Condition a +cAnd (Lit False) _ = Lit False +cAnd _ (Lit False) = Lit False +cAnd (Lit True) x = x +cAnd x (Lit True) = x +cAnd x y = CAnd x y + +-- | Boolean OR of two 'Condition' values. +cOr :: Eq v => Condition v -> Condition v -> Condition v +cOr (Lit True) _ = Lit True +cOr _ (Lit True) = Lit True +cOr (Lit False) x = x +cOr x (Lit False) = x +cOr c (CNot d) + | c == d = Lit True +cOr (CNot c) d + | c == d = Lit True +cOr x y = COr x y + instance Functor Condition where f `fmap` Var c = Var (f c) _ `fmap` Lit c = Lit c diff --git a/Cabal/Distribution/PackageDescription/Configuration.hs b/Cabal/Distribution/PackageDescription/Configuration.hs index 9b98d29068d..d84f5a0e9a2 100644 --- a/Cabal/Distribution/PackageDescription/Configuration.hs +++ b/Cabal/Distribution/PackageDescription/Configuration.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- -fno-warn-deprecations for use of Map.foldWithKey {-# OPTIONS_GHC -fno-warn-deprecations #-} ----------------------------------------------------------------------------- @@ -23,6 +24,7 @@ module Distribution.PackageDescription.Configuration ( parseCondition, freeVars, extractCondition, + extractConditions, addBuildableCondition, mapCondTree, mapTreeData, @@ -32,6 +34,9 @@ module Distribution.PackageDescription.Configuration ( transformAllBuildDepends, ) where +import Control.Applicative -- 7.10 -Werror workaround. +import Prelude + import Distribution.Package import Distribution.PackageDescription import Distribution.PackageDescription.Utils @@ -293,17 +298,24 @@ addBuildableCondition getInfo t = Lit False -> CondNode mempty mempty [] c -> CondNode mempty mempty [(c, t, Nothing)] --- | Extract buildable condition from a cond tree. +-- Note: extracting buildable conditions. +-- -------------------------------------- -- --- Background: If the conditions in a cond tree lead to Buildable being set to False, --- then none of the dependencies for this cond tree should actually be taken into --- account. On the other hand, some of the flags may only be decided in the solver, --- so we cannot necessarily make the decision whether a component is Buildable or not --- prior to solving. +-- If the conditions in a cond tree lead to Buildable being set to False, then +-- none of the dependencies for this cond tree should actually be taken into +-- account. On the other hand, some of the flags may only be decided in the +-- solver, so we cannot necessarily make the decision whether a component is +-- Buildable or not prior to solving. -- --- What we are doing here is to partially evaluate a condition tree in order to extract --- the condition under which Buildable is True. The predicate determines whether data --- under a 'CondTree' is buildable. +-- What we are doing here is to partially evaluate a condition tree in order to +-- extract the condition under which Buildable is True. The predicate determines +-- whether data under a 'CondTree' is buildable. + + +-- | Extract the condition matched by the given predicate from a cond tree. +-- +-- We use this mainly for extracting buildable conditions (see the Note above), +-- but the function is in fact more general. extractCondition :: Eq v => (a -> Bool) -> CondTree v c a -> Condition v extractCondition p = go where @@ -316,21 +328,20 @@ extractCondition p = go ct = go t ce = maybe (Lit True) go e in - ((c `cand` ct) `cor` (CNot c `cand` ce)) `cand` goList cs - - cand (Lit False) _ = Lit False - cand _ (Lit False) = Lit False - cand (Lit True) x = x - cand x (Lit True) = x - cand x y = CAnd x y - - cor (Lit True) _ = Lit True - cor _ (Lit True) = Lit True - cor (Lit False) x = x - cor x (Lit False) = x - cor c (CNot d) - | c == d = Lit True - cor x y = COr x y + ((c `cAnd` ct) `cOr` (CNot c `cAnd` ce)) `cAnd` goList cs + +-- | Extract conditions matched by the given predicate from all cond trees in a +-- 'GenericPackageDescription'. +extractConditions :: (BuildInfo -> Bool) -> GenericPackageDescription + -> [Condition ConfVar] +extractConditions f gpkg = + concat [ + maybeToList $ extractCondition (f . libBuildInfo) <$> condLibrary gpkg + , extractCondition (f . buildInfo) . snd <$> condExecutables gpkg + , extractCondition (f . testBuildInfo) . snd <$> condTestSuites gpkg + , extractCondition (f . benchmarkBuildInfo) . snd <$> condBenchmarks gpkg + ] + -- | A map of dependencies that combines version ranges using 'unionVersionRanges'. newtype DepMapUnion = DepMapUnion { unDepMapUnion :: Map PackageName VersionRange } diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs index 18427490dbc..8c22fe5b932 100644 --- a/cabal-install/Distribution/Client/Configure.hs +++ b/cabal-install/Distribution/Client/Configure.hs @@ -184,18 +184,18 @@ configureSetupScript packageDBs index mpkg = SetupScriptOptions { - useCabalVersion = cabalVersion - , useCabalSpecVersion = Nothing - , useCompiler = Just comp - , usePlatform = Just platform - , usePackageDB = packageDBs' - , usePackageIndex = index' - , useProgramConfig = conf - , useDistPref = distPref - , useLoggingHandle = Nothing - , useWorkingDir = Nothing - , setupCacheLock = lock - , useWin32CleanHack = False + useCabalVersion = cabalVersion + , useCabalSpecVersion = Nothing + , useCompiler = Just comp + , usePlatform = Just platform + , usePackageDB = packageDBs' + , usePackageIndex = index' + , useProgramConfig = conf + , useDistPref = distPref + , useLoggingHandle = Nothing + , useWorkingDir = Nothing + , setupCacheLock = lock + , useWin32CleanHack = False , forceExternalSetupMethod = forceExternal -- If we have explicit setup dependencies, list them; otherwise, we give -- the empty list of dependencies; ideally, we would fix the version of @@ -204,8 +204,8 @@ configureSetupScript packageDBs -- know the version of Cabal at this point, but only find this there. -- Therefore, for now, we just leave this blank. , useDependencies = fromMaybe [] explicitSetupDeps - , useDependenciesExclusive = isJust explicitSetupDeps - , useVersionMacros = isJust explicitSetupDeps + , useDependenciesExclusive = not defaultSetupDeps && isJust explicitSetupDeps + , useVersionMacros = not defaultSetupDeps && isJust explicitSetupDeps } where -- When we are compiling a legacy setup script without an explicit @@ -223,13 +223,24 @@ configureSetupScript packageDBs -- but if the user is using an odd db stack, don't touch it _otherwise -> (packageDBs, Just index) + maybeSetupBuildInfo :: Maybe PkgDesc.SetupBuildInfo + maybeSetupBuildInfo = do + ReadyPackage (ConfiguredPackage (SourcePackage _ gpkg _ _) _ _ _) _ + <- mpkg + PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg) + + -- Was a default 'custom-setup' stanza added by 'cabal-install' itself? If + -- so, 'setup-depends' must not be exclusive. See #3199. + defaultSetupDeps :: Bool + defaultSetupDeps = maybe False PkgDesc.defaultSetupDepends + maybeSetupBuildInfo + explicitSetupDeps :: Maybe [(UnitId, PackageId)] explicitSetupDeps = do - ReadyPackage (ConfiguredPackage (SourcePackage _ gpkg _ _) _ _ _) deps - <- mpkg - -- Check if there is an explicit setup stanza - _buildInfo <- PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg) + -- Check if there is an explicit setup stanza. + _buildInfo <- maybeSetupBuildInfo -- Return the setup dependencies computed by the solver + ReadyPackage _ deps <- mpkg return [ ( Installed.installedUnitId deppkg , Installed.sourcePackageId deppkg ) diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs index 98e0e7c46c0..2d7b03b224b 100644 --- a/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency.hs @@ -92,16 +92,14 @@ import Distribution.Package , Package(..), packageName, packageVersion , UnitId, Dependency(Dependency)) import qualified Distribution.PackageDescription as PD - ( PackageDescription(..), SetupBuildInfo(..) - , GenericPackageDescription(..) - , Flag(flagName), FlagName(..) ) +import qualified Distribution.PackageDescription.Configuration as PD import Distribution.PackageDescription.Configuration ( finalizePackageDescription ) import Distribution.Client.PackageUtils ( externalBuildDepends ) import Distribution.Version - ( VersionRange, anyVersion, thisVersion, withinRange - , simplifyVersionRange ) + ( VersionRange, Version(..), anyVersion, orLaterVersion, thisVersion + , withinRange, simplifyVersionRange ) import Distribution.Compiler ( CompilerInfo(..) ) import Distribution.System @@ -122,7 +120,7 @@ import Distribution.Verbosity import Data.List ( foldl', sort, sortBy, nubBy, maximumBy, intercalate, nub ) import Data.Function (on) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe) import qualified Data.Map as Map import qualified Data.Set as Set import Data.Set (Set) @@ -392,7 +390,7 @@ removeUpperBounds allowNewer params = -- 'addSourcePackages'. Otherwise, the packages inserted by -- 'addSourcePackages' won't have upper bounds in dependencies relaxed. -- -addDefaultSetupDependencies :: (SourcePackage -> [Dependency]) +addDefaultSetupDependencies :: (SourcePackage -> Maybe [Dependency]) -> DepResolverParams -> DepResolverParams addDefaultSetupDependencies defaultSetupDeps params = params { @@ -408,9 +406,12 @@ addDefaultSetupDependencies defaultSetupDeps params = PD.setupBuildInfo = case PD.setupBuildInfo pkgdesc of Just sbi -> Just sbi - Nothing -> Just PD.SetupBuildInfo { - PD.setupDepends = defaultSetupDeps srcpkg - } + Nothing -> case defaultSetupDeps srcpkg of + Nothing -> Nothing + Just deps -> Just PD.SetupBuildInfo { + PD.defaultSetupDepends = True, + PD.setupDepends = deps + } } } } @@ -449,12 +450,41 @@ standardInstallPolicy . hideInstalledPackagesSpecificBySourcePackageId [ packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers ] + . addDefaultSetupDependencies mkDefaultSetupDeps + . addSourcePackages [ pkg | SpecificSourcePackage pkg <- pkgSpecifiers ] $ basicDepResolverParams installedPkgIndex sourcePkgIndex + where + -- Force Cabal >= 1.24 dep when the package is affected by #3199. + mkDefaultSetupDeps :: SourcePackage -> Maybe [Dependency] + mkDefaultSetupDeps srcpkg | affected = + Just [Dependency (PackageName "Cabal") + (orLaterVersion $ Version [1,24] [])] + | otherwise = Nothing + where + gpkgdesc = packageDescription srcpkg + pkgdesc = PD.packageDescription gpkgdesc + bt = fromMaybe PD.Custom (PD.buildType pkgdesc) + affected = bt == PD.Custom && hasBuildableFalse gpkgdesc + + -- Does this package contain any components with non-empty 'build-depends' + -- and a 'buildable' field that could potentially be set to 'False'? False + -- positives are possible. + hasBuildableFalse :: PD.GenericPackageDescription -> Bool + hasBuildableFalse gpkg = + not (all alwaysTrue (zipWith PD.cOr buildableConditions noDepConditions)) + where + buildableConditions = PD.extractConditions PD.buildable gpkg + noDepConditions = PD.extractConditions + (null . PD.targetBuildDepends) gpkg + alwaysTrue (PD.Lit True) = True + alwaysTrue _ = False + + applySandboxInstallPolicy :: SandboxPackageInfo -> DepResolverParams -> DepResolverParams diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 8348c1acd6a..b4af2b3f55c 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -1575,7 +1575,7 @@ packageSetupScriptStylePreSolver pkg -- we still need to distinguish the case of explicit and implict setup deps. -- See 'rememberImplicitSetupDeps'. -- -defaultSetupDeps :: Platform -> PD.PackageDescription -> [Dependency] +defaultSetupDeps :: Platform -> PD.PackageDescription -> Maybe [Dependency] defaultSetupDeps platform pkg = case packageSetupScriptStylePreSolver pkg of @@ -1583,6 +1583,7 @@ defaultSetupDeps platform pkg = -- setup dependencies, we add a dependency on Cabal and a number -- of other packages. SetupCustomImplicitDeps -> + Just $ [ Dependency depPkgname anyVersion | depPkgname <- legacyCustomSetupPkgs platform ] ++ -- The Cabal dep is slightly special: @@ -1609,13 +1610,13 @@ defaultSetupDeps platform pkg = -- external Setup.hs, it'll be one of the simple ones that only depends -- on Cabal and base. SetupNonCustomExternalLib -> - [ Dependency cabalPkgname cabalConstraint - , Dependency basePkgname anyVersion ] + Just [ Dependency cabalPkgname cabalConstraint + , Dependency basePkgname anyVersion ] where cabalConstraint = orLaterVersion (PD.specVersion pkg) -- The internal setup wrapper method has no deps at all. - SetupNonCustomInternalLib -> [] + SetupNonCustomInternalLib -> Just [] SetupCustomExplicitDeps -> error $ "defaultSetupDeps: called for a package with explicit " diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs index fdeea689beb..a88c123ee30 100644 --- a/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/Distribution/Client/SetupWrapper.hs @@ -161,15 +161,16 @@ data SetupScriptOptions = SetupScriptOptions { useWorkingDir :: Maybe FilePath, forceExternalSetupMethod :: Bool, - -- | List of dependencies to use when building Setup.hs + -- | List of dependencies to use when building Setup.hs. useDependencies :: [(UnitId, PackageId)], -- | Is the list of setup dependencies exclusive? -- - -- When this is @False@, if we compile the Setup.hs script we do so with - -- the list in 'useDependencies' but all other packages in the environment - -- are also visible. Additionally, a suitable version of @Cabal@ library - -- is added to the list of dependencies (see 'useCabalVersion'). + -- When this is @False@, if we compile the Setup.hs script we do so with the + -- list in 'useDependencies' but all other packages in the environment are + -- also visible. A suitable version of @Cabal@ library (see + -- 'useCabalVersion') is also added to the list of dependencies, unless + -- 'useDependencies' already contains a Cabal dependency. -- -- When @True@, only the 'useDependencies' packages are used, with other -- packages in the environment hidden. @@ -604,16 +605,22 @@ externalSetupMethod verbosity options pkg bt mkargs = do -- With 'useDependenciesExclusive' we enforce the deps specified, -- so only the given ones can be used. Otherwise we allow the use -- of packages in the ambient environment, and add on a dep on the - -- Cabal library. + -- Cabal library (unless 'useDependencies' already contains one). -- -- With 'useVersionMacros' we use a version CPP macros .h file. -- -- Both of these options should be enabled for packages that have -- opted-in and declared a custom-settup stanza. -- + hasCabal (_, PackageIdentifier (PackageName "Cabal") _) = True + hasCabal _ = False + selectedDeps | useDependenciesExclusive options' = useDependencies options' - | otherwise = useDependencies options' ++ cabalDep + | otherwise = useDependencies options' ++ + if any hasCabal (useDependencies options') + then [] + else cabalDep addRenaming (ipid, pid) = (ipid, pid, defaultRenaming) cppMacrosFile = setupDir "setup_macros.h" ghcOptions = mempty { diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs index f0e0e4aa456..2d62abd1e28 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs @@ -168,7 +168,8 @@ exAvSrcPkg ex = , C.benchmarks = error "not yet configured: benchmarks" , C.buildDepends = error "not yet configured: buildDepends" , C.setupBuildInfo = Just C.SetupBuildInfo { - C.setupDepends = mkSetupDeps (CD.setupDeps (exAvDeps ex)) + C.setupDepends = mkSetupDeps (CD.setupDeps (exAvDeps ex)), + C.defaultSetupDepends = False } } , C.genPackageFlags = nub $ concatMap extractFlags