hadrian: Make copyFileLinked a bit more robust

Previously it only worked if the two files you were trying to symlink
were already in the same directory.

2 files changed, 14 insertions, 11 deletions

diff --git a/hadrian/src/Hadrian/Utilities.hs b/hadrian/src/Hadrian/Utilities.hs
index 8bcfa6f974..50639db68a 100644
--- a/hadrian/src/Hadrian/Utilities.hs
+++ b/hadrian/src/Hadrian/Utilities.hs
@@ -295,23 +295,23 @@ isGeneratedSource file = buildRoot <&> (`isPrefixOf` file)
 -- missing.
 createFileLink :: FilePath -> FilePath -> Action ()
 createFileLink linkTarget link
-  | windowsHost = copyFile' source link
+  | windowsHost = copyFile' linkTarget link
   | otherwise   = do
     -- TODO `disableHistory` is a temporary fix (see issue #16866). Remove
     -- `disableHistory` when shake issue is fixed: https://github.com/ndmitchell/shake/issues/683.
     historyDisable
-
-    need [source]
+    need [linkTarget]
 
     liftIO $ IO.createDirectoryIfMissing True dir
     putProgressInfo =<< renderCreateFileLink linkTarget link
     quietly . liftIO $ do
         IO.removeFile link <|> return ()
-        IO.createFileLink linkTarget link
+        -- This should perhaps use top instead but that is tricky due to
+        -- module cycles
+        abs_target <- IO.canonicalizePath linkTarget
+        IO.createFileLink abs_target link
 
   where dir = takeDirectory link
-        source | isAbsolute linkTarget = linkTarget
-               | otherwise             = takeDirectory link -/- linkTarget
 
 -- | Copy a file tracking the source. Create the target directory if missing.
 copyFile :: FilePath -> FilePath -> Action ()
diff --git a/hadrian/src/Rules/Rts.hs b/hadrian/src/Rules/Rts.hs
index 4583f06d51..c9d1915593 100644
--- a/hadrian/src/Rules/Rts.hs
+++ b/hadrian/src/Rules/Rts.hs
@@ -17,9 +17,11 @@ rtsRules = priority 3 $ do
       root -/- "**/libHSrts_*-ghc*.dylib",
       root -/- "**/libHSrts-ghc*.so",
       root -/- "**/libHSrts-ghc*.dylib"]
-      |%> \ rtsLibFilePath' -> createFileLink
-            (addRtsDummyVersion $ takeFileName rtsLibFilePath')
-            rtsLibFilePath'
+      |%> \ rtsLibFilePath' -> do
+            let (dir, name) = splitFileName rtsLibFilePath'
+            createFileLink
+              (dir -/- (addRtsDummyVersion name))
+              rtsLibFilePath'
 
     -- Libffi
     forM_ [Stage1 ..] $ \ stage -> do
@@ -63,7 +65,8 @@ copyLibffiStatic stage target = withLibffi stage $ \ libffiPath _ -> do
     vanillaLibFile <- rtsLibffiLibrary stage vanilla
     if target == vanillaLibFile
     then copyFile' (libffiPath -/- libffiLibrary) target
-    else createFileLink (takeFileName vanillaLibFile) target
+    else do
+      createFileLink (takeDirectory target -/- takeFileName vanillaLibFile) target
 
 
 -- | Copy a dynamic library file from the libffi build dir to the rts build dir.
@@ -88,7 +91,7 @@ copyLibffiDynamicUnix stage libSuf target = do
             , "-id", "@rpath/" ++ takeFileName target
             , target
             ]
-    else createFileLink versionlessSourceFileName target
+    else createFileLink (takeDirectory target -/- versionlessSourceFileName) target
 
 -- | Copy a dynamic library file from the libffi build dir to the rts build dir.
 copyLibffiDynamicWin :: Stage -> FilePath -> Action ()