From 1ce1307e09dbf7360d72b04701086ad1c4cc7ecd Mon Sep 17 00:00:00 2001
From: Edsko de Vries <edsko@well-typed.com>
Date: Tue, 7 Apr 2015 14:04:41 +0100
Subject: [PATCH] Treat base special in goal qualification
---
.../Client/Dependency/Modular/Dependency.hs | 10 +++++++++-
.../Client/Dependency/Modular/Package.hs | 20 ++++++++++++++++++-
2 files changed, 28 insertions(+), 2 deletions(-)
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs b/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs
index 6f8dcbaeb5..57089054c0 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs
@@ -197,8 +197,12 @@ showDep (Dep qpn ci ) =
-- NOTE: It's the _dependencies_ of a package that may or may not be independent
-- from the package itself. Package flag choices must of course be consistent.
qualifyDeps :: QPN -> FlaggedDeps Component PN -> FlaggedDeps Component QPN
-qualifyDeps (Q pp pn) = go
+qualifyDeps (Q pp' pn) = go
where
+ -- The Base qualifier does not get inherited
+ pp :: PP
+ pp = stripBase pp'
+
go :: FlaggedDeps Component PN -> FlaggedDeps Component QPN
go = map go1
@@ -208,9 +212,13 @@ qualifyDeps (Q pp pn) = go
go1 (Simple dep comp) = Simple (goD dep comp) comp
goD :: Dep PN -> Component -> Dep QPN
+ goD dep _ | isBase dep = fmap (Q (Base pn pp)) dep
goD dep ComponentSetup = fmap (Q (Setup pn pp)) dep
goD dep _ = fmap (Q pp ) dep
+ isBase :: Dep PN -> Bool
+ isBase (Dep dep _ci) = unPackageName dep == "base"
+
{-------------------------------------------------------------------------------
Setting/forgetting the Component
-------------------------------------------------------------------------------}
diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Package.hs b/cabal-install/Distribution/Client/Dependency/Modular/Package.hs
index 1f5fe57952..cebf3b5461 100644
--- a/cabal-install/Distribution/Client/Dependency/Modular/Package.hs
+++ b/cabal-install/Distribution/Client/Dependency/Modular/Package.hs
@@ -69,15 +69,33 @@ instI _ = False
-- | Package path.
--
-- Stored in reverse order
-data PP = Independent Int PP | Setup PN PP | None
+data PP =
+ -- User-specified independent goal
+ Independent Int PP
+ -- Setup dependencies are always considered independent from their package
+ | Setup PN PP
+ -- Any dependency on base is considered independent (allows for base shims)
+ | Base PN PP
+ -- Unqualified
+ | None
deriving (Eq, Ord, Show)
+-- | Strip any 'Base' qualifiers from a PP
+--
+-- (the Base qualifier does not get inherited)
+stripBase :: PP -> PP
+stripBase (Independent i pp) = Independent i (stripBase pp)
+stripBase (Setup pn pp) = Setup pn (stripBase pp)
+stripBase (Base _pn pp) = stripBase pp
+stripBase None = None
+
-- | String representation of a package path.
--
-- NOTE: This always ends in a period
showPP :: PP -> String
showPP (Independent i pp) = show i ++ "." ++ showPP pp
showPP (Setup pn pp) = display pn ++ ".setup." ++ showPP pp
+showPP (Base pn pp) = display pn ++ "." ++ showPP pp
showPP None = ""
-- | A qualified entity. Pairs a package path with the entity.
--
GitLab