Merge pull request #6768 from phadej/issue-5570

Resolve #5570: Use PackageVersionConstraint more

Author: phadej

Cabal/Distribution/PackageDescription/Configuration.hs

@@ -58,6 +58,7 @@ import Distribution.Types.ForeignLib
 import Distribution.Types.Component
 import Distribution.Types.Dependency
 import Distribution.Types.PackageName
+import Distribution.Types.PackageVersionConstraint
 import Distribution.Types.UnqualComponentName
 import Distribution.Types.CondTree
 import Distribution.Types.Condition
@@ -177,7 +178,7 @@ resolveWithFlags ::
   -> OS      -- ^ OS as returned by Distribution.System.buildOS
   -> Arch    -- ^ Arch as returned by Distribution.System.buildArch
   -> CompilerInfo  -- ^ Compiler information
-  -> [Dependency]  -- ^ Additional constraints
+  -> [PackageVersionConstraint]  -- ^ Additional constraints
   -> [CondTree ConfVar [Dependency] PDTagged]
   -> ([Dependency] -> DepTestRslt [Dependency])  -- ^ Dependency test function.
   -> Either [Dependency] (TargetSet PDTagged, FlagAssignment)
@@ -186,7 +187,10 @@ resolveWithFlags ::
 resolveWithFlags dom enabled os arch impl constrs trees checkDeps =
     either (Left . fromDepMapUnion) Right $ explore (build mempty dom)
   where
-    extraConstrs = toDepMap constrs
+    extraConstrs = toDepMap
+      [ Dependency pn ver mempty
+      | PackageVersionConstraint pn ver <- constrs
+      ]
 
     -- simplify trees by (partially) evaluating all conditions and converting
     -- dependencies to dependency maps.
@@ -438,7 +442,7 @@ finalizePD ::
                           -- True.
   -> Platform      -- ^ The 'Arch' and 'OS'
   -> CompilerInfo  -- ^ Compiler information
-  -> [Dependency]  -- ^ Additional constraints
+  -> [PackageVersionConstraint]  -- ^ Additional constraints
   -> GenericPackageDescription
   -> Either [Dependency]
             (PackageDescription, FlagAssignment)

Cabal/Distribution/Simple/Build.hs

@@ -81,6 +81,7 @@ import Distribution.Simple.Utils.Json
 import Distribution.System
 import Distribution.Pretty
 import Distribution.Verbosity
+import Distribution.Version (thisVersion)
 
 import Distribution.Compat.Graph (IsNode(..))
 
@@ -535,16 +536,20 @@ testSuiteLibV09AsLibAndExe pkg_descr
                 , componentCompatPackageKey = compat_key
                 , componentExposedModules = [IPI.ExposedModule m Nothing]
                 }
+    pkgName' = mkPackageName $ prettyShow compat_name
     pkg = pkg_descr {
-            package      = (package pkg_descr) { pkgName = mkPackageName $ prettyShow compat_name }
+            package      = (package pkg_descr) { pkgName = pkgName' }
           , executables  = []
           , testSuites   = []
           , subLibraries = [lib]
           }
     ipi    = inplaceInstalledPackageInfo pwd distPref pkg (mkAbiHash "") lib lbi libClbi
     testDir = buildDir lbi </> stubName test
           </> stubName test ++ "-tmp"
-    testLibDep = thisPackageVersion $ package pkg
+    testLibDep = Dependency
+        pkgName'
+        (thisVersion $ pkgVersion $ package pkg_descr)
+        (Set.singleton LMainLibName)
     exe = Executable {
             exeName    = mkUnqualComponentName $ stubName test,
             modulePath = stubFilePath test,

Cabal/Distribution/Simple/Configure.hs

@@ -79,6 +79,7 @@ import Distribution.Simple.BuildTarget
 import Distribution.Simple.LocalBuildInfo
 import Distribution.Types.ExeDependency
 import Distribution.Types.LegacyExeDependency
+import Distribution.Types.PackageVersionConstraint
 import Distribution.Types.PkgconfigVersion
 import Distribution.Types.PkgconfigDependency
 import Distribution.Types.PkgconfigVersionRange
@@ -450,7 +451,7 @@ configure (pkg_descr0, pbi) cfg = do
     -- NB: The fact that we bundle all the constraints together means
     -- that is not possible to configure a test-suite to use one
     -- version of a dependency, and the executable to use another.
-    (allConstraints  :: [Dependency],
+    (allConstraints  :: [PackageVersionConstraint],
      requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo)
         <- either (die' verbosity) return $
               combinedConstraints (configConstraints cfg)
@@ -1000,7 +1001,7 @@ configureFinalizedPackage
     :: Verbosity
     -> ConfigFlags
     -> ComponentRequestedSpec
-    -> [Dependency]
+    -> [PackageVersionConstraint]
     -> (Dependency -> Bool) -- ^ tests if a dependency is satisfiable.
                             -- Might say it's satisfiable even when not.
     -> Compiler
@@ -1459,10 +1460,10 @@ interpretPackageDbFlags userInstall specificDBs =
 -- deps in the end. So we still need to remember which installed packages to
 -- pick.
 combinedConstraints
-  :: [Dependency]
+  :: [PackageVersionConstraint]
   -> [GivenComponent]
   -> InstalledPackageIndex
-  -> Either String ([Dependency],
+  -> Either String ([PackageVersionConstraint],
                      Map (PackageName, ComponentName) InstalledPackageInfo)
 combinedConstraints constraints dependencies installedPackages = do
 
@@ -1476,9 +1477,9 @@ combinedConstraints constraints dependencies installedPackages = do
     return (allConstraints, idConstraintMap)
 
   where
-    allConstraints :: [Dependency]
+    allConstraints :: [PackageVersionConstraint]
     allConstraints = constraints
-                  ++ [ thisPackageVersion (packageId pkg)
+                  ++ [ thisPackageVersionConstraint (packageId pkg)
                      | (_, _, _, Just pkg) <- dependenciesPkgInfo ]
 
     idConstraintMap :: Map (PackageName, ComponentName) InstalledPackageInfo

Cabal/Distribution/Simple/Setup.hs

@@ -98,11 +98,11 @@ import Distribution.Simple.Program
 import Distribution.Simple.InstallDirs
 import Distribution.Verbosity
 import Distribution.Utils.NubList
-import Distribution.Types.Dependency
 import Distribution.Types.ComponentId
 import Distribution.Types.GivenComponent
 import Distribution.Types.Module
 import Distribution.Types.PackageName
+import Distribution.Types.PackageVersionConstraint
 import Distribution.Types.UnqualComponentName (unUnqualComponentName)
 
 import Distribution.Compat.Stack
@@ -256,8 +256,8 @@ data ConfigFlags = ConfigFlags {
     configSplitObjs :: Flag Bool,      -- ^Enable -split-objs with GHC
     configStripExes :: Flag Bool,      -- ^Enable executable stripping
     configStripLibs :: Flag Bool,      -- ^Enable library stripping
-    configConstraints :: [Dependency], -- ^Additional constraints for
-                                       -- dependencies.
+    configConstraints :: [PackageVersionConstraint], -- ^Additional constraints for
+                                                     -- dependencies.
     configDependencies :: [GivenComponent],
       -- ^The packages depended on.
     configInstantiateWith :: [(ModuleName, Module)],

Cabal/Distribution/Types/Dependency.hs

@@ -6,16 +6,14 @@ module Distribution.Types.Dependency
   , depPkgName
   , depVerRange
   , depLibraries
-  , thisPackageVersion
-  , notThisPackageVersion
   , simplifyDependency
   ) where
 
 import Distribution.Compat.Prelude
 import Prelude ()
 
 import Distribution.Version
-       (VersionRange, anyVersion,notThisVersion, simplifyVersionRange, thisVersion)
+       (VersionRange, anyVersion, simplifyVersionRange )
 import Distribution.Types.VersionRange (isAnyVersionLight)
 
 import Distribution.CabalSpecVersion
@@ -25,7 +23,6 @@ import Distribution.FieldGrammar.Described
 import Distribution.Parsec
 import Distribution.Pretty
 import Distribution.Types.LibraryName
-import Distribution.Types.PackageId
 import Distribution.Types.PackageName
 import Distribution.Types.UnqualComponentName
 import Text.PrettyPrint                       ((<+>))
@@ -185,20 +182,6 @@ instance Described Dependency where
       where
         vr = RENamed "version-range" (describe (Proxy :: Proxy VersionRange))
 
--- mempty should never be in a Dependency-as-dependency.
--- This is only here until the Dependency-as-constraint problem is solved #5570.
--- Same for below.
---
--- Note: parser allows for empty set!
---
-thisPackageVersion :: PackageIdentifier -> Dependency
-thisPackageVersion (PackageIdentifier n v) =
-  Dependency n (thisVersion v) Set.empty
-
-notThisPackageVersion :: PackageIdentifier -> Dependency
-notThisPackageVersion (PackageIdentifier n v) =
-  Dependency n (notThisVersion v) Set.empty
-
 -- | Simplify the 'VersionRange' expression in a 'Dependency'.
 -- See 'simplifyVersionRange'.
 --

Cabal/Distribution/Types/PackageVersionConstraint.hs

@@ -1,8 +1,9 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric      #-}
-module Distribution.Types.PackageVersionConstraint
-  ( PackageVersionConstraint(..)
-  ) where
+module Distribution.Types.PackageVersionConstraint (
+    PackageVersionConstraint(..),
+    thisPackageVersionConstraint,
+) where
 
 import Distribution.Compat.Prelude
 import Prelude ()
@@ -21,8 +22,8 @@ import           Text.PrettyPrint                ((<+>))
 -- | A version constraint on a package. Different from 'ExeDependency' and
 -- 'Dependency' since it does not specify the need for a component, not even
 -- the main library.
--- There are a few places in the codebase where 'Dependency' is used where
--- 'PackageVersionConstraint' should be used instead (#5570).
+-- There are a few places in the codebase where 'Dependency' was used where
+-- 'PackageVersionConstraint' is not used instead (#5570).
 data PackageVersionConstraint = PackageVersionConstraint PackageName VersionRange
                   deriving (Generic, Read, Show, Eq, Typeable, Data)
 
@@ -69,3 +70,7 @@ instance Described PackageVersionConstraint where
         -- Related https://github.com/haskell/cabal/issues/6760
         , RESpaces1 <> describe (Proxy :: Proxy VersionRange)
         ]
+
+thisPackageVersionConstraint :: PackageIdentifier -> PackageVersionConstraint
+thisPackageVersionConstraint (PackageIdentifier pn vr) =
+    PackageVersionConstraint pn (thisVersion vr)

Cabal/tests/UnitTests/Distribution/Utils/Structured.hs

@@ -11,18 +11,20 @@ import Distribution.SPDX.License       (License)
 import Distribution.Types.VersionRange (VersionRange)
 
 #if MIN_VERSION_base(4,7,0)
-import Distribution.Types.LocalBuildInfo (LocalBuildInfo)
+import Distribution.Types.GenericPackageDescription (GenericPackageDescription)
+import Distribution.Types.LocalBuildInfo            (LocalBuildInfo)
 #endif
 
 import UnitTests.Orphans ()
 
 tests :: TestTree
 tests = testGroup "Distribution.Utils.Structured"
     -- This test also verifies that structureHash doesn't loop.
-    [ testCase "VersionRange"   $ structureHash (Proxy :: Proxy VersionRange)   @?= Fingerprint 0x39396fc4f2d751aa 0xa1f94e6d843f03bd
-    , testCase "SPDX.License"   $ structureHash (Proxy :: Proxy License)        @?= Fingerprint 0xd3d4a09f517f9f75 0xbc3d16370d5a853a
+    [ testCase "VersionRange"              $ structureHash (Proxy :: Proxy VersionRange)               @?= Fingerprint 0x39396fc4f2d751aa 0xa1f94e6d843f03bd
+    , testCase "SPDX.License"              $ structureHash (Proxy :: Proxy License)                    @?= Fingerprint 0xd3d4a09f517f9f75 0xbc3d16370d5a853a
     -- The difference is in encoding of newtypes
 #if MIN_VERSION_base(4,7,0)
-    , testCase "LocalBuildInfo" $ structureHash (Proxy :: Proxy LocalBuildInfo) @?= Fingerprint 0x779513b2e8a07958 0xd344652f7031f88f
+    , testCase "GenericPackageDescription" $ structureHash (Proxy :: Proxy GenericPackageDescription)  @?= Fingerprint 0xcaf11323731bfb4a 0xdfda6dfccb716a3f
+    , testCase "LocalBuildInfo"            $ structureHash (Proxy :: Proxy LocalBuildInfo)             @?= Fingerprint 0x5a476529cf81643a 0x874574ad4ae0adbf
 #endif
     ]

cabal-install/Distribution/Client/Configure.hs

@@ -63,12 +63,10 @@ import Distribution.Simple.PackageIndex
          ( InstalledPackageIndex, lookupPackageName )
 import Distribution.Package
          ( Package(..), packageName, PackageId )
-import Distribution.Types.Dependency
-         ( thisPackageVersion )
 import Distribution.Types.GivenComponent
          ( GivenComponent(..) )
 import Distribution.Types.PackageVersionConstraint
-         ( PackageVersionConstraint(..) )
+         ( PackageVersionConstraint(..), thisPackageVersionConstraint )
 import qualified Distribution.PackageDescription as PkgDesc
 import Distribution.PackageDescription.Parsec
          ( readGenericPackageDescription )
@@ -409,7 +407,7 @@ configurePackage verbosity platform comp scriptOptions configFlags
       -- We generate the legacy constraints as well as the new style precise
       -- deps.  In the end only one set gets passed to Setup.hs configure,
       -- depending on the Cabal version we are talking to.
-      configConstraints  = [ thisPackageVersion srcid
+      configConstraints  = [ thisPackageVersionConstraint srcid
                            | ConfiguredId srcid (Just (PkgDesc.CLibName PkgDesc.LMainLibName)) _uid
                                <- CD.nonSetupDeps deps ],
       configDependencies = [ GivenComponent (packageName srcid) cname uid

cabal-install/Distribution/Client/Install.hs

@@ -35,6 +35,7 @@ import Distribution.Utils.Generic(safeLast)
 
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as Map
+import qualified Data.Set as Set
 import Control.Exception as Exception
          ( Exception(toException), bracket, catches
          , Handler(Handler), handleJust, IOException, SomeException )
@@ -140,12 +141,13 @@ import Distribution.Package
          , Package(..), HasMungedPackageId(..), HasUnitId(..)
          , UnitId )
 import Distribution.Types.Dependency
-         ( thisPackageVersion )
+         ( Dependency (..) )
+import Distribution.Types.LibraryName (LibraryName (..))
 import Distribution.Types.GivenComponent
          ( GivenComponent(..) )
 import Distribution.Pretty ( prettyShow )
 import Distribution.Types.PackageVersionConstraint
-         ( PackageVersionConstraint(..) )
+         ( PackageVersionConstraint(..), thisPackageVersionConstraint )
 import Distribution.Types.MungedPackageId
 import qualified Distribution.PackageDescription as PackageDescription
 import Distribution.PackageDescription
@@ -829,8 +831,8 @@ postInstallActions verbosity
   unless oneShot $
     World.insert verbosity worldFile
       --FIXME: does not handle flags
-      [ World.WorldPkgInfo dep mempty
-      | UserTargetNamed dep <- targets ]
+      [ World.WorldPkgInfo (Dependency pn vr (Set.singleton LMainLibName)) mempty
+      | UserTargetNamed (PackageVersionConstraint pn vr) <- targets ]
 
   let buildReports = BuildReports.fromInstallPlan platform (compilerId comp)
                                                   installPlan buildOutcomes
@@ -1209,7 +1211,7 @@ installReadyPackage platform cinfo configFlags
     -- We generate the legacy constraints as well as the new style precise deps.
     -- In the end only one set gets passed to Setup.hs configure, depending on
     -- the Cabal version we are talking to.
-    configConstraints  = [ thisPackageVersion srcid
+    configConstraints  = [ thisPackageVersionConstraint srcid
                          | ConfiguredId
                              srcid
                              (Just