[Git][ghc/ghc][master] Hadrian: use / when making filepaths absolute

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
f813c8d7 by sheaf at 2024-12-03T17:10:15-05:00
Hadrian: use / when making filepaths absolute

In Hadrian, we are careful to use -/- rather than </>, in order to use
/ instead of \ in filepaths. However, this gets ruined by the use of
makeAbsolute from System.Directory, which, on Windows, changes back
forward slashes to backslashes.

- - - - -


5 changed files:

- hadrian/src/Hadrian/Utilities.hs
- hadrian/src/Rules/CabalReinstall.hs
- hadrian/src/Rules/Test.hs
- hadrian/src/Settings/Builders/Cabal.hs
- hadrian/src/Settings/Builders/Ghc.hs


Changes:

=====================================
hadrian/src/Hadrian/Utilities.hs
=====================================
@@ -7,7 +7,7 @@ module Hadrian.Utilities (
     quote, yesNo, parseYesNo, zeroOne,
 
     -- * FilePath manipulation
-    unifyPath, (-/-), makeRelativeNoSysLink,
+    unifyPath, (-/-), makeRelativeNoSysLink, makeAbsolute,
 
     -- * Accessing Shake's type-indexed map
     insertExtra, lookupExtra, userSetting,
@@ -57,6 +57,7 @@ import qualified System.Directory.Extra as IO
 import qualified System.Info.Extra      as IO
 import qualified System.IO              as IO
 import System.IO.Error (isPermissionError)
+import qualified System.FilePath.Posix as Posix
 
 -- | Extract a value from a singleton list, or terminate with an error message
 -- if the list does not contain exactly one value.
@@ -136,7 +137,17 @@ zeroOne True  = "1"
 unifyPath :: FilePath -> FilePath
 unifyPath = toStandard . normaliseEx
 
+{- Note [Absolute paths and MSYS]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When dealing with absolute paths in Hadrian, we opt to always use Unix-style
+forward slashes for separating paths.
+This is because, on Windows, the MSYS toolchain can reliably handle paths such
+as /c/foo, while it occasionally falls over on paths of the form C:\foo.
+-}
+
 -- | Combine paths with a forward slash regardless of platform.
+--
+-- See Note [Absolute paths and MSYS].
 (-/-) :: FilePath -> FilePath -> FilePath
 _  -/- b | isAbsolute b && not (isAbsolute $ tail b) = b
 "" -/- b = b
@@ -146,6 +157,16 @@ a  -/- b
 
 infixr 6 -/-
 
+-- | Like 'System.Directory.makeAbsolute' from @directory@, but always
+-- using forward slashes.
+--
+-- See Note [Absolute paths and MSYS].
+makeAbsolute :: FilePath -> IO FilePath
+makeAbsolute fp = do
+  cwd <- IO.getCurrentDirectory
+  let fp' = cwd -/- fp
+  return $ Posix.normalise fp'
+
 -- | This is like Posix makeRelative, but assumes no sys links in the input
 -- paths. This allows the result to start with possibly many "../"s. Input
 -- paths must both be relative, or be on the same drive


=====================================
hadrian/src/Rules/CabalReinstall.hs
=====================================
@@ -55,10 +55,10 @@ cabalBuildRules = do
         distDir        <- Context.distDir (vanillaContext Stage1 rts)
         let rtsIncludeDir    = distDir -/- "include"
 
-        libdir  <- liftIO . IO.makeAbsolute =<< stageLibPath Stage1
-        work_dir <- liftIO $ IO.makeAbsolute $ root -/- "stage-cabal"
+        libdir  <- liftIO . makeAbsolute =<< stageLibPath Stage1
+        work_dir <- liftIO $ makeAbsolute $ root -/- "stage-cabal"
         let outputDir = work_dir -/- "bin"
-        includeDir <- liftIO $ IO.makeAbsolute rtsIncludeDir
+        includeDir <- liftIO $ makeAbsolute rtsIncludeDir
 
         createDirectory outputDir
 
@@ -95,7 +95,7 @@ cabalBuildRules = do
         -- Just symlink these for now
         -- TODO: build these with cabal as well
         forM_ iserv_targets $ \(_bin_pkg,bin_path') -> do
-            bin_path <- liftIO $ IO.makeAbsolute bin_path'
+            bin_path <- liftIO $ makeAbsolute bin_path'
             let orig_filename = takeFileName bin_path
                 output_file = outputDir -/- orig_filename
             liftIO $ do


=====================================
hadrian/src/Rules/Test.hs
=====================================
@@ -195,7 +195,7 @@ testRules = do
         -- get relative path for the given program in the given stage
         let relative_path_stage s p = programPath =<< programContext s p
         let make_absolute rel_path = do
-              abs_path <- liftIO (IO.makeAbsolute rel_path)
+              abs_path <- liftIO (makeAbsolute rel_path)
               fixAbsolutePathOnWindows abs_path
 
         rel_ghc_pkg     <- relative_path_stage Stage1 ghcPkg


=====================================
hadrian/src/Settings/Builders/Cabal.hs
=====================================
@@ -11,7 +11,6 @@ import Settings.Builders.Common
 import qualified Settings.Builders.Common as S
 import Control.Exception (assert)
 import qualified Data.Set as Set
-import System.Directory
 import Settings.Program (programContext)
 import GHC.Toolchain (ccLinkProgram, tgtCCompilerLink)
 import GHC.Toolchain.Program (prgFlags)


=====================================
hadrian/src/Settings/Builders/Ghc.hs
=====================================
@@ -12,7 +12,6 @@ import Settings.Warnings
 import qualified Context as Context
 import Rules.Libffi (libffiName)
 import qualified Data.Set as Set
-import System.Directory
 import Data.Version.Extra
 
 ghcBuilderArgs :: Args



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f813c8d70e41f0d4663d894db2fee593c71a9772

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f813c8d70e41f0d4663d894db2fee593c71a9772
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241203/454d4edf/attachment-0001.html>