diff --git a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs b/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs index 72e70966593..68f8bc577f0 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/ProjectConfigPath.hs @@ -20,6 +20,7 @@ module Distribution.Solver.Types.ProjectConfigPath , isCyclicConfigPath , isTopLevelConfigPath , canonicalizeConfigPath + , normy ) where import Distribution.Solver.Compat.Prelude hiding (toList, (<>)) @@ -31,11 +32,14 @@ import Data.List.NonEmpty ((<|)) import Network.URI (parseURI, parseAbsoluteURI) import System.Directory import System.FilePath +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 @@ -51,6 +55,12 @@ import Distribution.Simple.Utils (ordNub) newtype ProjectConfigPath = ProjectConfigPath (NonEmpty FilePath) deriving (Eq, Show, Generic) +normy :: FilePath -> FilePath +normy 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] + -- | Sorts URIs after local file paths and longer file paths after shorter ones -- as measured by the number of path segments. If still equal, then sorting is -- lexical. @@ -59,8 +69,14 @@ newtype ProjectConfigPath = ProjectConfigPath (NonEmpty FilePath) -- configuration paths it imports, should always sort first. Comparing one -- project root path against another is done lexically. -- +-- >>> normy "a/b.config" +-- "a/b.config" +-- >>> normy "a\\b.config" +-- "a/b.config" +-- +-- -- >>> let abFwd = ProjectConfigPath $ "a/b.config" :| [] --- >>> let abBwd = ProjectConfigPath $ "a\b.config" :| [] +-- >>> let abBwd = ProjectConfigPath $ "a\\b.config" :| [] -- >>> compare abFwd abBwd -- EQ instance Ord ProjectConfigPath where @@ -71,7 +87,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 (splitPath a) (splitPath b) + ([a], [b]) -> compare (splitPath $ normy a) (splitPath $ normy b) ([_], _) -> LT (_, [_]) -> GT @@ -79,14 +95,14 @@ instance Ord ProjectConfigPath where (Just ua, Just ub) -> compare ua ub P.<> compare aImporters bImporters (Just _, Nothing) -> GT (Nothing, Just _) -> LT - (Nothing, Nothing) -> compare (splitPath a) (splitPath b) P.<> compare aImporters bImporters + (Nothing, Nothing) -> compare (splitPath $ normy a) (splitPath $ normy b) P.<> compare aImporters bImporters _ -> compare (length as) (length bs) P.<> compare (length aPaths) (length bPaths) P.<> compare aPaths bPaths where - aPaths = splitPath <$> as - bPaths = splitPath <$> bs + aPaths = (splitPath . normy) <$> as + bPaths = (splitPath . normy) <$> bs aImporters = snd $ unconsProjectConfigPath pa bImporters = snd $ unconsProjectConfigPath pb