Add data ProjectImport replacing tuples

Author: philderbeast

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

@@ -1,10 +1,12 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Distribution.Solver.Types.ProjectConfigPath
     (
     -- * Project Config Path Manipulation
-      ProjectConfigPath(..)
+      ProjectImport(..)
+    , ProjectConfigPath(..)
     , projectConfigPathRoot
     , nullProjectConfigPath
     , consProjectConfigPath
@@ -45,6 +47,13 @@ import Text.PrettyPrint
 import Distribution.Simple.Utils (ordNub)
 import Distribution.System (OS(Windows), buildOS)
 
+data ProjectImport =
+    ProjectImport
+        { importOf :: FilePath
+        , importBy :: ProjectConfigPath
+        }
+    deriving (Eq, Ord)
+
 -- | Path to a configuration file, either a singleton project root, or a longer
 -- list representing a path to an import.  The path is a non-empty list that we
 -- build up by prepending relative imports with @consProjectConfigPath@.
@@ -180,18 +189,18 @@ cyclicalImportMsg path@(ProjectConfigPath (duplicate :| _)) =
 -- | 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 -> [(FilePath, ProjectConfigPath)] -> Doc
+duplicateImportMsg :: Doc -> FilePath -> ProjectConfigPath -> [ProjectImport] -> Doc
 duplicateImportMsg intro = seenImportMsg intro
 
-seenImportMsg :: Doc -> FilePath -> ProjectConfigPath -> [(FilePath, ProjectConfigPath)] -> Doc
-seenImportMsg intro duplicate path seenImportsBy =
+seenImportMsg :: Doc -> FilePath -> ProjectConfigPath -> [ProjectImport] -> Doc
+seenImportMsg intro duplicate path seenImports =
     vcat
     [ intro
     , nest 2 (docProjectConfigPath path)
     , nest 2 $
         vcat
-        [ docProjectConfigPath dib
-        | (_, dib) <- filter ((duplicate ==) . fst) seenImportsBy
+        [ docProjectConfigPath importBy
+        | ProjectImport{importBy} <- filter ((duplicate ==) . importOf) seenImports
         ]
     ]
 

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

@@ -257,7 +257,7 @@ parseProject rootPath cacheDir httpTransport verbosity configToParse = do
   let (dir, projectFileName) = splitFileName rootPath
   projectDir <- makeAbsolute dir
   projectPath@(ProjectConfigPath (canonicalRoot :| _)) <- canonicalizeConfigPath projectDir (ProjectConfigPath $ projectFileName :| [])
-  importsBy <- newIORef $ toNubList [(canonicalRoot, projectPath)]
+  importsBy <- newIORef $ toNubList [ProjectImport canonicalRoot projectPath]
   dupesMap <- newIORef mempty
   result <- parseProjectSkeleton cacheDir httpTransport verbosity importsBy dupesMap projectDir projectPath configToParse
   dupes <- Map.filter ((> 1) . length) <$> readIORef dupesMap
@@ -267,7 +267,7 @@ parseProject rootPath cacheDir httpTransport verbosity configToParse = do
 data Dupes = Dupes
   { dupesUniqueImport :: FilePath
   , dupesNormLocPath :: ProjectConfigPath
-  , dupesSeenImportsBy :: [(FilePath, ProjectConfigPath)]
+  , dupesSeenImportsBy :: [ProjectImport]
   }
   deriving (Eq)
 
@@ -286,7 +286,7 @@ parseProjectSkeleton
   :: FilePath
   -> HttpTransport
   -> Verbosity
-  -> IORef (NubList (FilePath, ProjectConfigPath))
+  -> IORef (NubList ProjectImport)
   -- ^ The imports seen so far, used to report on cycles and duplicates and to detect duplicates that are not cycles
   -> IORef DupesMap
   -- ^ The duplicates seen so far, used to defer reporting on duplicates
@@ -308,7 +308,7 @@ parseProjectSkeleton cacheDir httpTransport verbosity importsBy dupesMap project
         -- Once we canonicalize the import path, we can check for cyclical and duplicate imports
         normSource <- canonicalizeConfigPath projectDir source
         normLocPath@(ProjectConfigPath (uniqueImport :| _)) <- canonicalizeConfigPath projectDir importLocPath
-        seenImportsBy@(fmap fst -> seenImports) <- fromNubList <$> atomicModifyIORef' importsBy (\ibs -> (toNubList [(uniqueImport, normLocPath)] <> ibs, ibs))
+        seenImportsBy@(fmap importOf -> seenImports) <- fromNubList <$> atomicModifyIORef' importsBy (\ibs -> (toNubList [ProjectImport uniqueImport normLocPath] <> ibs, ibs))
         debug verbosity $ "\nimport path, normalized\n=======================\n" ++ render (docProjectConfigPath normLocPath)
         debug verbosity "\nseen unique paths\n================="
         mapM_ (debug verbosity) seenImports