Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion Cabal/Cabal.cabal
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
name: Cabal
version: 1.24.0.0
version: 1.24.1.0
copyright: 2003-2006, Isaac Jones
2005-2011, Duncan Coutts
license: BSD3
Expand Down
37 changes: 32 additions & 5 deletions Cabal/Distribution/PackageDescription.hs
Original file line number Diff line number Diff line change
Expand Up @@ -97,7 +97,7 @@ module Distribution.PackageDescription (
GenericPackageDescription(..),
Flag(..), FlagName(..), FlagAssignment,
CondTree(..), ConfVar(..), Condition(..),
cNot,
cNot, cAnd, cOr,

-- * Source repositories
SourceRepo(..),
Expand All @@ -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
Expand Down Expand Up @@ -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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ah, cunning. I went to some lengths in the new-build code to do this without changing the underlying type, but yes it is rather easier if we can just stash the info here. I might switch the new-build code over to use that, rather than keeping an extra Set around.

-- ^ 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
Expand Down Expand Up @@ -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
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I forgot to mention that I added a case to my snippet:

cor  (CNot c)    d
  | c == d                   = Lit True

Without it, the function testing whether #3199 applies doesn't ignore this use of buildable:

executable exe
  if !flag(build-exe)
    buildable: False
  else
    build-depends: package
  [...]

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

indeed, it's kinda odd that symmetry was broken for the "x or (not x)" case...

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@grayjay Updated.


instance Functor Condition where
f `fmap` Var c = Var (f c)
_ `fmap` Lit c = Lit c
Expand Down
59 changes: 35 additions & 24 deletions Cabal/Distribution/PackageDescription/Configuration.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
-- -fno-warn-deprecations for use of Map.foldWithKey
{-# OPTIONS_GHC -fno-warn-deprecations #-}
-----------------------------------------------------------------------------
Expand All @@ -23,6 +24,7 @@ module Distribution.PackageDescription.Configuration (
parseCondition,
freeVars,
extractCondition,
extractConditions,
addBuildableCondition,
mapCondTree,
mapTreeData,
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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 }
Expand Down
47 changes: 29 additions & 18 deletions cabal-install/Distribution/Client/Configure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
)
Expand Down
50 changes: 40 additions & 10 deletions cabal-install/Distribution/Client/Dependency.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand Down Expand Up @@ -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 {
Expand All @@ -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
}
}
}
}
Expand Down Expand Up @@ -449,12 +450,41 @@ standardInstallPolicy
. hideInstalledPackagesSpecificBySourcePackageId
[ packageId pkg | SpecificSourcePackage pkg <- pkgSpecifiers ]

. addDefaultSetupDependencies mkDefaultSetupDeps

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

So make this function conditional on the build-type Custom, and then we don't need the previous patch to apply that conditionality within addDefaultSetupDependencies itself.

. 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
Expand Down
Loading