diff --git a/Cabal/Distribution/PackageDescription/Configuration.hs b/Cabal/Distribution/PackageDescription/Configuration.hs index 339d0ce5f4a58c62ccae3ddd0a94da55bdd90725..60568badd72c5657871fa9aa1fb335f6a01401a7 100644 --- a/Cabal/Distribution/PackageDescription/Configuration.hs +++ b/Cabal/Distribution/PackageDescription/Configuration.hs @@ -228,7 +228,7 @@ resolveWithFlags dom enabled os arch impl constrs trees checkDeps = -- dependencies to dependency maps. simplifiedTrees :: [CondTree FlagName DependencyMap PDTagged] simplifiedTrees = map ( mapTreeConstrs toDepMap -- convert to maps - . addBuildableCondition pdTaggedBuildInfo + . addBuildableConditionPDTagged . mapTreeConds (fst . simplifyWithSysParams os arch impl)) trees @@ -277,11 +277,6 @@ resolveWithFlags dom enabled os arch impl constrs trees checkDeps = env :: FlagAssignment -> FlagName -> Either FlagName Bool env flags flag = (maybe (Left flag) Right . lookup flag) flags - pdTaggedBuildInfo :: PDTagged -> BuildInfo - pdTaggedBuildInfo (Lib l) = libBuildInfo l - pdTaggedBuildInfo (SubComp _ c) = componentBuildInfo c - pdTaggedBuildInfo PDNull = mempty - -- | Transforms a 'CondTree' by putting the input under the "then" branch of a -- conditional that is True when Buildable is True. If 'addBuildableCondition' -- can determine that Buildable is always True, it returns the input unchanged. @@ -295,6 +290,33 @@ addBuildableCondition getInfo t = Lit False -> CondNode mempty mempty [] c -> CondNode mempty mempty [(c, t, Nothing)] +-- | This is a special version of 'addBuildableCondition' for the 'PDTagged' +-- type. +-- +-- It is not simply a specialisation. It is more complicated than it +-- ought to be because of the way the 'PDTagged' monoid instance works. The +-- @mempty = 'PDNull'@ forgets the component type, which has the effect of +-- completely deleting components that are not buildable. +-- +-- See <https://github.com/haskell/cabal/pull/4094> for more details. +-- +addBuildableConditionPDTagged :: (Eq v, Monoid c) => + CondTree v c PDTagged + -> CondTree v c PDTagged +addBuildableConditionPDTagged t = + case extractCondition (buildable . getInfo) t of + Lit True -> t + Lit False -> deleteConstraints t + c -> CondNode mempty mempty [(c, t, Just (deleteConstraints t))] + where + deleteConstraints = mapTreeConstrs (const mempty) + + getInfo :: PDTagged -> BuildInfo + getInfo (Lib l) = libBuildInfo l + getInfo (SubComp _ c) = componentBuildInfo c + getInfo PDNull = mempty + + -- Note: extracting buildable conditions. -- -------------------------------------- --