From d45311c3dcc77daa1e7f836779ad89650d1016c0 Mon Sep 17 00:00:00 2001
From: Phil de Joux <philderbeast@gmail.com>
Date: Tue, 17 Dec 2024 09:27:14 -0500
Subject: [PATCH] Use OS-specific splitPath before comparing projects

- Manually replace path separators before anything else
---
 .../Solver/Types/ProjectConfigPath.hs         | 22 +++++++++++++++++--
 1 file changed, 20 insertions(+), 2 deletions(-)

diff --git a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs b/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs
index 84375b0f4de..fa2bccb80f0 100644
--- a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs
+++ b/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
 
 -- | 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,12 @@ 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 c == '/' then '\\' else c| c <- p]
+                        else Posix.joinPath $ Posix.splitDirectories [if c == '\\' then '/' else c| c <- p]
+
             aPaths = splitPath <$> as
             bPaths = splitPath <$> bs
             aImporters = snd $ unconsProjectConfigPath pa