diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs index a65c41cb046..bbbb1021f68 100644 --- a/cabal-install/src/Distribution/Client/Dependency.hs +++ b/cabal-install/src/Distribution/Client/Dependency.hs @@ -993,7 +993,7 @@ planPackagesProblems platform cinfo pkgs = , not (null packageProblems) ] ++ [ DuplicatePackageSolverId (Graph.nodeKey aDup) dups - | dups <- duplicatesBy (comparing Graph.nodeKey) pkgs + | dups <- fmap toList $ duplicatesBy (comparing Graph.nodeKey) pkgs , aDup <- case dups of [] -> [] (ad : _) -> [ad] @@ -1055,7 +1055,7 @@ configuredPackageProblems | pkgs <- CD.nonSetupDeps ( fmap - (duplicatesBy (comparing packageName)) + (fmap toList . duplicatesBy (comparing packageName)) specifiedDeps1 ) ] diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 685e46dfa77..2339b91f147 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -109,6 +109,7 @@ import Text.PrettyPrint , text , vcat , ($$) + , ($+$) ) import Prelude () @@ -137,7 +138,7 @@ import Distribution.Client.SetupWrapper import Distribution.Client.Store import Distribution.Client.Targets (userToPackageConstraint) import Distribution.Client.Types -import Distribution.Client.Utils (concatMapM, incVersion) +import Distribution.Client.Utils (concatMapM, duplicatesBy, incVersion) import qualified Distribution.Client.BuildReports.Storage as BuildReports import qualified Distribution.Client.IndexUtils as IndexUtils @@ -451,13 +452,29 @@ rebuildProjectConfig createDirectoryIfMissingVerbose verbosity True distDirectory createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory - fetchAndReadSourcePackages - verbosity - distDirLayout - compiler - projectConfigShared - projectConfigBuildOnly - pkgLocations + sourcePackages <- + fetchAndReadSourcePackages + verbosity + distDirLayout + compiler + projectConfigShared + projectConfigBuildOnly + pkgLocations + + case duplicatesBy (comparing srcpkgPackageId) [pkg | SpecificSourcePackage pkg <- sourcePackages] of + [] -> return () + duplicateSourcePkgs -> + liftIO $ + noticeDoc verbosity $ + vcat + [ text "cabal project has multiple sources for" + <+> (pretty (srcpkgPackageId (head dupeGroup)) <> text ":") + $+$ Disp.nest 2 (vcat [pretty (srcpkgSource srcpkg) | srcpkg <- toList dupeGroup]) + $+$ text "the choice of source that will be used is undefined." + | dupeGroup <- duplicateSourcePkgs + ] + + return sourcePackages informAboutConfigFiles projectConfig = do cwd <- getCurrentDirectory diff --git a/cabal-install/src/Distribution/Client/Types/PackageLocation.hs b/cabal-install/src/Distribution/Client/Types/PackageLocation.hs index 9a0537aae7a..9dd00c40080 100644 --- a/cabal-install/src/Distribution/Client/Types/PackageLocation.hs +++ b/cabal-install/src/Distribution/Client/Types/PackageLocation.hs @@ -16,7 +16,8 @@ import Network.URI (URI) import Distribution.Types.PackageId (PackageId) import Distribution.Client.Types.Repo -import Distribution.Client.Types.SourceRepo (SourceRepoMaybe) +import Distribution.Client.Types.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..)) +import Distribution.Pretty import Distribution.Solver.Types.SourcePackage (SourcePackage) type UnresolvedPkgLoc = PackageLocation (Maybe FilePath) @@ -39,6 +40,14 @@ data PackageLocation local RemoteSourceRepoPackage SourceRepoMaybe local deriving (Show, Functor, Eq, Ord, Generic) +instance Pretty (PackageLocation local) where + pretty (LocalUnpackedPackage fp) = showFilePath fp + pretty (LocalTarballPackage fp) = showFilePath fp + pretty (RemoteTarballPackage uri _) = showToken $ show uri + pretty (RepoTarballPackage repo pid _) = pretty pid <> showToken "@" <> pretty (repoName repo) + pretty (RemoteSourceRepoPackage sourceRepo _) = + pretty (srpType sourceRepo) <+> showToken (srpLocation sourceRepo) + instance Binary local => Binary (PackageLocation local) instance Structured local => Structured (PackageLocation local) diff --git a/cabal-install/src/Distribution/Client/Utils.hs b/cabal-install/src/Distribution/Client/Utils.hs index 07db71a9f9d..92e12e8fcc6 100644 --- a/cabal-install/src/Distribution/Client/Utils.hs +++ b/cabal-install/src/Distribution/Client/Utils.hs @@ -140,18 +140,18 @@ mergeBy cmp = merge data MergeResult a b = OnlyInLeft a | InBoth a b | OnlyInRight b -duplicates :: Ord a => [a] -> [[a]] +duplicates :: Ord a => [a] -> [NonEmpty a] duplicates = duplicatesBy compare -duplicatesBy :: forall a. (a -> a -> Ordering) -> [a] -> [[a]] -duplicatesBy cmp = filter moreThanOne . groupBy eq . sortBy cmp +duplicatesBy :: forall a. (a -> a -> Ordering) -> [a] -> [NonEmpty a] +duplicatesBy cmp = mapMaybe moreThanOne . groupBy eq . sortBy cmp where eq :: a -> a -> Bool eq a b = case cmp a b of EQ -> True _ -> False - moreThanOne (_ : _ : _) = True - moreThanOne _ = False + moreThanOne (x : xs@(_ : _)) = Just (x :| xs) + moreThanOne _ = Nothing -- | Like 'removeFile', but does not throw an exception when the file does not -- exist. diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.out b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.out new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.project b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.project new file mode 100644 index 00000000000..2f191f96e7e --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.project @@ -0,0 +1 @@ +packages: pkg-one, pkg-two diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs new file mode 100644 index 00000000000..534ef613f3a --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/cabal.test.hs @@ -0,0 +1,21 @@ +import Test.Cabal.Prelude +import Data.List (isInfixOf) + +-- output contains filepaths into /tmp, so we only match parts of the output +main = cabalTest . recordMode DoNotRecord $ do + liftIO $ skipIfWindows "\\r\\n confused with \\n" + + let msg = unlines + [ "cabal project has multiple sources for pkg-one-0.1:" + , " .*/pkg-one" + , " .*/pkg-two" + , "the choice of source that will be used is undefined." + ] + + normal <- cabal' "configure" ["-v1", "pkg-one"] + assertOutputMatches msg normal + + quiet <- cabal' "configure" ["-v0", "pkg-one"] + assertOutputDoesNotMatch msg quiet + + return () diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/Foo.hs b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/Foo.hs new file mode 100644 index 00000000000..8a39fe134cf --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/Foo.hs @@ -0,0 +1,4 @@ +module Foo where + +a :: Int +a = 42 diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/pkg-one.cabal b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/pkg-one.cabal new file mode 100644 index 00000000000..3e17e5074d7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-one/pkg-one.cabal @@ -0,0 +1,9 @@ +name: pkg-one +version: 0.1 +license: BSD3 +cabal-version: >=1.2 +build-type: Simple + +library + exposed-modules: Foo + build-depends: base diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/Bar.hs b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/Bar.hs new file mode 100644 index 00000000000..870176c2b2d --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/Bar.hs @@ -0,0 +1,4 @@ +module Bar where + +a :: Int +a = 42 diff --git a/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/pkg-one.cabal b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/pkg-one.cabal new file mode 100644 index 00000000000..5708318ba15 --- /dev/null +++ b/cabal-testsuite/PackageTests/ProjectDupPkg/pkg-two/pkg-one.cabal @@ -0,0 +1,9 @@ +name: pkg-one +version: 0.1 +license: BSD3 +cabal-version: >=1.2 +build-type: Simple + +library + exposed-modules: Bar + build-depends: base diff --git a/changelog.d/pr-11487 b/changelog.d/pr-11487 new file mode 100644 index 00000000000..8669f946f69 --- /dev/null +++ b/changelog.d/pr-11487 @@ -0,0 +1,7 @@ +--- +synopsis: Log if there are multiple local packages with the same ID in a project +packages: [cabal-install] +prs: 11487 +--- + +Log duplicate local packages with the same package identifier, so that the user knows that only one will be picked.