diff --git a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs b/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs index a1709a0cf9f..81423ed484c 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs @@ -32,13 +32,17 @@ 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 Distribution.Utils.String (trim) 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 @@ -61,6 +65,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 @@ -69,7 +81,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 @@ -83,6 +95,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