Deduplicate path separator duplicates

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

@@ -30,12 +30,16 @@ import Data.Coerce (coerce)
 import Data.List.NonEmpty ((<|))
 import Network.URI (parseURI, parseAbsoluteURI)
 import System.Directory
-import System.FilePath
+import System.FilePath hiding (splitPath)
+import qualified System.FilePath as FP (splitPath)
+import qualified System.FilePath.Posix as Posix
+import qualified System.FilePath.Windows as Windows
 import qualified Data.List.NonEmpty as NE
 import Distribution.Solver.Modular.Version (VR)
 import Distribution.Pretty (prettyShow)
 import Text.PrettyPrint
 import Distribution.Simple.Utils (ordNub)
+import Distribution.System (OS(Windows), buildOS)
 
 -- | 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
@@ -58,6 +62,14 @@ newtype ProjectConfigPath = ProjectConfigPath (NonEmpty FilePath)
 -- The project itself, a single element root path, compared to any of the
 -- configuration paths it imports, should always sort first. Comparing one
 -- project root path against another is done lexically.
+--
+-- For comparison purposes, path separators are normalized to the @buildOS@
+-- platform's path separator.
+--
+-- >>> let abFwd = ProjectConfigPath $ "a/b.config" :| []
+-- >>> let abBwd = ProjectConfigPath $ "a\\b.config" :| []
+-- >>> compare abFwd abBwd
+-- EQ
 instance Ord ProjectConfigPath where
     compare pa@(ProjectConfigPath (NE.toList -> as)) pb@(ProjectConfigPath (NE.toList -> bs)) =
         case (as, bs) of
@@ -66,7 +78,7 @@ instance Ord ProjectConfigPath where
             -- this though, do a comparison anyway when both sides have length
             -- 1.  The root path, the project itself, should always be the first
             -- path in a sorted listing.
-            ([a], [b]) -> compare a b
+            ([a], [b]) -> compare (splitPath a) (splitPath b)
             ([_], _) -> LT
             (_, [_]) -> GT
 
@@ -80,6 +92,16 @@ instance Ord ProjectConfigPath where
                 P.<> compare (length aPaths) (length bPaths)
                 P.<> compare aPaths bPaths
         where
+            splitPath = FP.splitPath . normSep where
+                normSep p =
+                    if buildOS == Windows
+                        then
+                            Windows.joinPath $ Windows.splitDirectories
+                            [if Posix.isPathSeparator c then Windows.pathSeparator else c| c <- p]
+                        else
+                            Posix.joinPath $ Posix.splitDirectories
+                            [if Windows.isPathSeparator c then Posix.pathSeparator else c| c <- p]
+
             aPaths = splitPath <$> as
             bPaths = splitPath <$> bs
             aImporters = snd $ unconsProjectConfigPath pa

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

@@ -1,8 +1,5 @@
 import Test.Cabal.Prelude
 
-normalizeWindowsOutput :: String -> String
-normalizeWindowsOutput = if isWindows then map (\x -> case x of '/' -> '\\'; _ -> x) else id
-
 main = cabalTest . withRepo "repo" . recordMode RecordMarked $ do
   let log = recordHeader . pure
 

cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.out

@@ -0,0 +1,2 @@
+# cabal v2-build
+Warning: <ROOT>/else.project, else.project: Unrecognized section '_' on line 3

cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/cabal.test.hs

@@ -0,0 +1,15 @@
+import Test.Cabal.Prelude
+
+main = cabalTest . recordMode RecordMarked $ do
+  let log = recordHeader . pure
+
+  outElse <- fails $ cabal' "v2-build" [ "all", "--dry-run", "--project-file=else.project" ]
+  assertOutputContains
+    (normalizeWindowsOutput "When using configuration from: \
+    \  - else.project \
+    \  - dir-else/else.config \
+    \The following errors occurred: \
+    \  - The package location 'no-pkg-here' does not exist.")
+    outElse
+
+  return ()

cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/dir-else/else.config

@@ -0,0 +1,4 @@
+if false
+else
+    _
+    packages: no-pkg-here

cabal-testsuite/PackageTests/ProjectImport/ParseErrorProvenance/else.project

@@ -0,0 +1 @@
+import: dir-else/else.config

cabal-testsuite/src/Test/Cabal/Prelude.hs

@@ -1093,6 +1093,9 @@ flakyIfCI ticket m = do
 flakyIfWindows :: IssueID -> TestM a -> TestM a
 flakyIfWindows ticket m = flakyIf isWindows ticket m
 
+normalizeWindowsOutput :: String -> String
+normalizeWindowsOutput = if isWindows then map (\x -> case x of '/' -> '\\'; _ -> x) else id
+
 getOpenFilesLimit :: TestM (Maybe Integer)
 #ifdef mingw32_HOST_OS
 -- No MS-specified limit, was determined experimentally on Windows 10 Pro x64,

changelog.d/pr-10646

@@ -0,0 +1,34 @@
+---
+synopsis: Deduplicate path separator duplicates
+packages: [cabal-install-solver]
+prs: 10646
+issues: 10645
+---
+
+The "using configuration from" message no longer has duplicates on Windows when
+the `cabal.project` uses forward slashes for its imports but the message reports
+imports with backslashes.
+
+```diff
+$ cat cabal.project
+import: dir-a/b.config
+
+$ cabal build all --dry-run
+...
+When using configuration from:
+-   - dir-a/b.config
+    - dir-a\b.config
+    - cabal.project
+```
+
+## Ord ProjectConfigPath Instance Changes
+
+For comparison purposes, path separators are normalized to the @buildOS@
+platform's path separator.
+
+```haskell
+-- >>> let abFwd = ProjectConfigPath $ "a/b.config" :| []
+-- >>> let abBwd = ProjectConfigPath $ "a\\b.config" :| []
+-- >>> compare abFwd abBwd
+-- EQ
+```