Normy experiment

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,22 +87,22 @@ 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
 
             (a:_, b:_) -> case (parseAbsoluteURI a, parseAbsoluteURI b) of
                 (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