From d5efc86d85ee6b3338c64423ccff6751b1cd5dde Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Fri, 20 May 2022 00:15:35 +0200 Subject: [PATCH] Preserve mtime when merging filetrees --- ghcup.cabal | 1 + lib/GHCup.hs | 15 +++++++++++---- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/ghcup.cabal b/ghcup.cabal index 1b8ae3e..8484a50 100644 --- a/ghcup.cabal +++ b/ghcup.cabal @@ -109,6 +109,7 @@ library , deepseq ^>=1.4.4.0 , directory ^>=1.3.6.0 , disk-free-space ^>=0.1.0.1 + , exceptions ^>=0.10 , filepath ^>=1.4.2.1 , haskus-utils-types ^>=1.5 , haskus-utils-variant ^>=3.2.1 diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 36fdee5..05b23e1 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -329,9 +329,9 @@ installUnpackedGHC path inst ver forceInstall -- to run configure. -- We also must make sure to preserve mtime to not confuse ghc-pkg. liftE $ mergeFileTree path inst GHC (mkTVer ver) $ \source dest -> liftIO $ do - mtime <- getModificationTime source + mtime <- ifM (pathIsSymbolicLink source) (pure Nothing) (Just <$> getModificationTime source) moveFilePortable source dest - setModificationTime dest mtime + forM_ mtime $ setModificationTime dest | otherwise = do PlatformRequest {..} <- lift getPlatformReq @@ -356,7 +356,11 @@ installUnpackedGHC path inst ver forceInstall inst GHC (mkTVer ver) - (\f t -> liftIO $ install f t (not forceInstall)) + (\f t -> liftIO $ do + mtime <- ifM (pathIsSymbolicLink f) (pure Nothing) (Just <$> getModificationTime f) + install f t (not forceInstall) + forM_ mtime $ setModificationTime t) + pure () @@ -672,7 +676,10 @@ installHLSUnpacked path inst ver forceInstall = do inst HLS (mkTVer ver) - (\f t -> liftIO $ install f t (not forceInstall)) + (\f t -> liftIO $ do + mtime <- ifM (pathIsSymbolicLink f) (pure Nothing) (Just <$> getModificationTime f) + install f t (not forceInstall) + forM_ mtime $ setModificationTime t) -- | Install an unpacked hls distribution (legacy). installHLSUnpackedLegacy :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)