Add Y-forking import test

- A test for detecting when the same config is imported via many different paths
- Error on duplicate imports
- Do the filtering in duplicateImportMsg
- Use duplicateImportMsg for cycles too
- Add haddocks to IORef parameter
- Add changelog entry
- Use ordNub instead of nub
- Use NubList
- Share implement of duplicate and cyclical messages
- Update expectation for non-cyclical duplicate import

Author: philderbeast

cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs

@@ -14,6 +14,7 @@ module Distribution.Solver.Types.ProjectConfigPath
     , docProjectConfigPath
     , docProjectConfigFiles
     , cyclicalImportMsg
+    , duplicateImportMsg
     , untrimmedUriImportMsg
     , docProjectConfigPathFailReason
 
@@ -173,11 +174,24 @@ docProjectConfigFiles ps = vcat
 
 -- | A message for a cyclical import, a "cyclical import of".
 cyclicalImportMsg :: ProjectConfigPath -> Doc
-cyclicalImportMsg path@(ProjectConfigPath (duplicate :| _)) =
+cyclicalImportMsg path@(ProjectConfigPath (duplicate :| _)) = seenImportMsg "cyclical" duplicate path []
+
+-- | A message for a duplicate import, a "duplicate import of". If a check for
+-- cyclical imports has already been made then this would report a duplicate
+-- import by two different paths.
+duplicateImportMsg :: FilePath -> ProjectConfigPath -> [(FilePath, ProjectConfigPath)] -> Doc
+duplicateImportMsg = seenImportMsg "duplicate"
+
+seenImportMsg :: String -> FilePath -> ProjectConfigPath -> [(FilePath, ProjectConfigPath)] -> Doc
+seenImportMsg seen duplicate path seenImportsBy =
     vcat
-    [ text "cyclical import of" <+> text duplicate <> semi
+    [ text seen <+> text "import of" <+> text duplicate <> semi
     , nest 2 (docProjectConfigPath path)
-    ]
+    , nest 2 $
+        vcat
+        [ docProjectConfigPath dib
+        | (_, dib) <- filter ((duplicate ==) . fst) seenImportsBy
+        ]
 
 -- | A message for an import that has leading or trailing spaces.
 untrimmedUriImportMsg :: Doc -> ProjectConfigPath -> Doc

cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -35,6 +36,7 @@ module Distribution.Client.ProjectConfig.Legacy
   ) where
 
 import Data.Coerce (coerce)
+import Data.IORef
 import Distribution.Client.Compat.Prelude
 
 import Distribution.Types.Flag (FlagName, parsecFlagAssignment)
@@ -142,7 +144,8 @@ import Distribution.Types.CondTree
   )
 import Distribution.Types.SourceRepo (RepoType)
 import Distribution.Utils.NubList
-  ( fromNubList
+  ( NubList
+  , fromNubList
   , overNubList
   , toNubList
   )
@@ -260,45 +263,55 @@ parseProject rootPath cacheDir httpTransport verbosity configToParse =
   do
     let (dir, projectFileName) = splitFileName rootPath
     projectDir <- makeAbsolute dir
-    projectPath <- canonicalizeConfigPath projectDir (ProjectConfigPath $ projectFileName :| [])
-    parseProjectSkeleton cacheDir httpTransport verbosity projectDir projectPath configToParse
+    projectPath@(ProjectConfigPath (canonicalRoot :| _)) <- canonicalizeConfigPath projectDir (ProjectConfigPath $ projectFileName :| [])
+    importsBy <- newIORef $ toNubList [(canonicalRoot, projectPath)]
+    parseProjectSkeleton cacheDir httpTransport verbosity importsBy projectDir projectPath configToParse
     -- NOTE: Reverse the warnings so they are in line number order.
     <&> \case ProjectParseOk ws x -> ProjectParseOk (reverse ws) x; x -> x
 
 parseProjectSkeleton
   :: FilePath
   -> HttpTransport
   -> Verbosity
+  -> IORef (NubList (FilePath, ProjectConfigPath))
+  -- ^ The imports seen so far, used to report on cycles and duplicates and to detect duplicates that are not cycles
   -> FilePath
   -- ^ The directory of the project configuration, typically the directory of cabal.project
   -> ProjectConfigPath
   -- ^ The path of the file being parsed, either the root or an import
   -> ProjectConfigToParse
   -- ^ The contents of the file to parse
   -> IO (ProjectParseResult ProjectConfigSkeleton)
-parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (ProjectConfigToParse bs) =
+parseProjectSkeleton cacheDir httpTransport verbosity importsBy projectDir source (ProjectConfigToParse bs) =
   (sanityWalkPCS False =<<) <$> liftPR source (go []) (ParseUtils.readFields bs)
   where
     go :: [ParseUtils.Field] -> [ParseUtils.Field] -> IO (ProjectParseResult ProjectConfigSkeleton)
     go acc (x : xs) = case x of
       (ParseUtils.F _ "import" importLoc) -> do
         let importLocPath = importLoc `consProjectConfigPath` source
 
-        -- Once we canonicalize the import path, we can check for cyclical imports
+        -- Once we canonicalize the import path, we can check for cyclical and duplicate imports
         normSource <- canonicalizeConfigPath projectDir source
-        normLocPath <- canonicalizeConfigPath projectDir importLocPath
+        normLocPath@(ProjectConfigPath (uniqueImport :| _)) <- canonicalizeConfigPath projectDir importLocPath
+        seenImportsBy@(fmap fst -> seenImports) <- fromNubList <$> atomicModifyIORef' importsBy (\ibs -> (toNubList [(uniqueImport, normLocPath)] <> ibs, ibs))
         debug verbosity $ "\nimport path, normalized\n=======================\n" ++ render (docProjectConfigPath normLocPath)
-
-        if isCyclicConfigPath normLocPath
-          then pure . projectParseFail Nothing (Just normSource) $ ParseUtils.FromString (render $ cyclicalImportMsg normLocPath) Nothing
-          else do
-            when
-              (isUntrimmedUriConfigPath importLocPath)
-              (noticeDoc verbosity $ untrimmedUriImportMsg (Disp.text "Warning:") importLocPath)
-            let fs = (\z -> CondNode z [normLocPath] mempty) <$> fieldsToConfig normSource (reverse acc)
-            res <- parseProjectSkeleton cacheDir httpTransport verbosity projectDir importLocPath . ProjectConfigToParse =<< fetchImportConfig normLocPath
-            rest <- go [] xs
-            pure . fmap mconcat . sequence $ [projectParse Nothing normSource fs, res, rest]
+        debug verbosity "\nseen unique paths\n================="
+        mapM_ (debug verbosity) seenImports
+        debug verbosity "\n"
+
+        if
+            | isCyclicConfigPath normLocPath ->
+                pure . projectParseFail Nothing (Just normSource) $ ParseUtils.FromString (render $ cyclicalImportMsg normLocPath) Nothing
+            | uniqueImport `elem` seenImports -> do
+                pure . parseFail $ ParseUtils.FromString (render $ duplicateImportMsg uniqueImport normLocPath seenImportsBy) Nothing
+            | otherwise -> do
+                when
+                  (isUntrimmedUriConfigPath importLocPath)
+                  (noticeDoc verbosity $ untrimmedUriImportMsg (Disp.text "Warning:") importLocPath)
+                let fs = (\z -> CondNode z [normLocPath] mempty) <$> fieldsToConfig normSource (reverse acc)
+                res <- parseProjectSkeleton cacheDir httpTransport verbosity importsBy projectDir importLocPath . ProjectConfigToParse =<< fetchImportConfig normLocPath
+                rest <- go [] xs
+                pure . fmap mconcat . sequence $ [projectParse Nothing normSource fs, res, rest]
       (ParseUtils.Section l "if" p xs') -> do
         normSource <- canonicalizeConfigPath projectDir source
         subpcs <- go [] xs'

cabal-testsuite/PackageTests/ConditionalAndImport/cabal.test.hs

@@ -165,6 +165,37 @@ main = cabalTest . withRepo "repo" . recordMode RecordMarked $ do
   log "checking if we detect when the same config is imported via many different paths (we don't)"
   yopping <- cabal' "v2-build" [ "--project-file=yops-0.project" ]
 
+  -- The project is named yops as it is like hops but with y's for forks.
+  -- +-- yops-0.project
+  --  +-- yops/yops-1.config
+  --   +-- yops-2.config
+  --    +-- yops/yops-3.config
+  --     +-- yops-4.config
+  --      +-- yops/yops-5.config
+  --       +-- yops-6.config
+  --        +-- yops/yops-7.config
+  --         +-- yops-8.config
+  --          +-- yops/yops-9.config (no further imports)
+  --  +-- yops/yops-3.config
+  --   +-- yops-4.config
+  --    +-- yops/yops-5.config
+  --     +-- yops-6.config
+  --      +-- yops/yops-7.config
+  --       +-- yops-8.config
+  --        +-- yops/yops-9.config (no further imports)
+  --  +-- yops/yops-5.config
+  --   +-- yops-6.config
+  --    +-- yops/yops-7.config
+  --     +-- yops-8.config
+  --      +-- yops/yops-9.config (no further imports)
+  --  +-- yops/yops-7.config
+  --   +-- yops-8.config
+  --    +-- yops/yops-9.config (no further imports)
+  --  +-- yops/yops-9.config (no further imports)
+  log "checking that we detect when the same config is imported via many different paths"
+  yopping <- fails $ cabal' "v2-build" [ "--project-file=yops-0.project" ]
+  assertOutputContains "duplicate import of yops/yops-3.config" yopping
+
   log "checking bad conditional"
   badIf <- fails $ cabal' "v2-build" [ "--project-file=bad-conditional.project" ]
   assertOutputContains "Cannot set compiler in a conditional clause of a cabal project file" badIf

changelog.d/pr-9933

@@ -0,0 +1,23 @@
+synopsis: Detect non-cyclical duplicate project imports
+description:
+  Detect and report on duplicate imports that are non-cyclical and expand the
+  detail in cyclical import reporting, being more explicit and consistent with
+  non-cyclical duplicate reporting.
+
+  ```
+  $ cabal build --project-file=yops-0.project
+  ...
+  Error: [Cabal-7090]
+  Error parsing project file yops-0.project:
+  duplicate import of yops/yops-3.config;
+    yops/yops-3.config
+      imported by: yops-0.project
+    yops/yops-3.config
+      imported by: yops-2.config
+      imported by: yops/yops-1.config
+      imported by: yops-0.project
+  ```
+
+packages: cabal-install-solver cabal-install
+prs: #9578 #9933
+issues: #9562