hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Preserve mtime when merging filetrees

Browse Source
This commit is contained in:
Julian Ospald 2022-05-20 00:15:35 +02:00
parent 430b655785
commit d5efc86d85
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
2 changed files with 12 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ghcup.cabal
View File

@ -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

15
lib/GHCup.hs
View File

@ -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)