Combine fields as ProjectImport

Author: philderbeast

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

@@ -188,16 +188,19 @@ docProjectConfigFiles ps = vcat
 -- | A message for a cyclical import, a "cyclical import of".
 cyclicalImportMsg :: ProjectConfigPath -> Doc
 cyclicalImportMsg path@(ProjectConfigPath (duplicate :| _)) =
-    seenImportMsg (text "cyclical import of" <+> text duplicate <> semi) duplicate path []
+    seenImportMsg
+        (text "cyclical import of" <+> text duplicate <> semi)
+        (ProjectImport 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 :: Doc -> FilePath -> ProjectConfigPath -> [ProjectImport] -> Doc
+duplicateImportMsg :: Doc -> ProjectImport -> [ProjectImport] -> Doc
 duplicateImportMsg intro = seenImportMsg intro
 
-seenImportMsg :: Doc -> FilePath -> ProjectConfigPath -> [ProjectImport] -> Doc
-seenImportMsg intro duplicate path seenImports =
+seenImportMsg :: Doc -> ProjectImport -> [ProjectImport] -> Doc
+seenImportMsg intro ProjectImport{importOf = duplicate, importBy = path} seenImports =
     vcat
     [ intro
     , nest 2 (docProjectConfigPath path)

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

@@ -268,8 +268,7 @@ parseProject rootPath cacheDir httpTransport verbosity configToParse = do
   return result
 
 data Dupes = Dupes
-  { dupesUniqueImport :: FilePath
-  , dupesNormLocPath :: ProjectConfigPath
+  { dupesImport :: ProjectImport
   , dupesSeenImportsBy :: [ProjectImport]
   }
   deriving (Eq)
@@ -280,10 +279,10 @@ instance Ord Dupes where
 type DupesMap = Map FilePath [Dupes]
 
 dupesMsg :: (FilePath, [Dupes]) -> Doc
-dupesMsg (duplicate, ds@(take 1 . sortOn dupesNormLocPath -> dupes)) =
+dupesMsg (duplicate, ds@(take 1 . sortOn (importBy . dupesImport) -> dupes)) =
   vcat $
     ((text "Warning:" <+> int (length ds) <+> text "imports of" <+> text duplicate) <> semi)
-      : ((\Dupes{..} -> duplicateImportMsg Disp.empty dupesUniqueImport dupesNormLocPath dupesSeenImportsBy) <$> dupes)
+      : ((\Dupes{..} -> duplicateImportMsg Disp.empty dupesImport dupesSeenImportsBy) <$> dupes)
 
 parseProjectSkeleton
   :: FilePath
@@ -325,7 +324,7 @@ parseProjectSkeleton cacheDir httpTransport verbosity importsBy dupesMap project
               (noticeDoc verbosity $ untrimmedUriImportMsg (text "Warning:") importLocPath)
             let fs = (\z -> CondNode z [normLocPath] mempty) <$> fieldsToConfig normSource (reverse acc)
             let uniqueFields = if uniqueImport `elem` seenImports then [] else xs
-            atomicModifyIORef' dupesMap $ \dm -> (Map.insertWith (++) uniqueImport [Dupes uniqueImport normLocPath seenImportsBy] dm, ())
+            atomicModifyIORef' dupesMap $ \dm -> (Map.insertWith (++) uniqueImport [Dupes (ProjectImport uniqueImport normLocPath) seenImportsBy] dm, ())
             res <- parseProjectSkeleton cacheDir httpTransport verbosity importsBy dupesMap projectDir importLocPath . ProjectConfigToParse =<< fetchImportConfig normLocPath
             rest <- go [] uniqueFields
             pure . fmap mconcat . sequence $ [projectParse Nothing normSource fs, res, rest]