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

Fix upgradeGHCup

Browse Source
This commit is contained in:
Julian Ospald 2020-04-12 20:22:16 +02:00
parent fee3984bf7
commit de66b92631
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
1 changed files with 8 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lib/GHCup.hs
View File

@ -53,6 +53,7 @@ import Prelude hiding ( abs
) )
import System.IO.Error import System.IO.Error
import System.Posix.FilePath ( getSearchPath ) import System.Posix.FilePath ( getSearchPath )
import System.Posix.Files.ByteString
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
@ -694,6 +695,11 @@ upgradeGHCup dls mtarget = do
tmp <- lift withGHCupTmpDir tmp <- lift withGHCupTmpDir
let fn = [rel|ghcup|] let fn = [rel|ghcup|]
p <- liftE $ download dli tmp (Just fn) p <- liftE $ download dli tmp (Just fn)
let fileMode' =
newFilePerms
`unionFileModes` ownerExecuteMode
`unionFileModes` groupExecuteMode
`unionFileModes` otherExecuteMode
case mtarget of case mtarget of
Nothing -> do Nothing -> do
dest <- liftIO $ ghcupBinDir dest <- liftIO $ ghcupBinDir
@ -701,11 +707,13 @@ upgradeGHCup dls mtarget = do
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
(dest </> fn) (dest </> fn)
Overwrite Overwrite
liftIO $ setFileMode (toFilePath (dest </> fn)) fileMode'
Just fullDest -> do Just fullDest -> do
liftIO $ hideError NoSuchThing $ deleteFile fullDest liftIO $ hideError NoSuchThing $ deleteFile fullDest
handleIO (throwE . CopyError . show) $ liftIO $ copyFile p handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
fullDest fullDest
Overwrite Overwrite
liftIO $ setFileMode (toFilePath fullDest) fileMode'
pure latestVer pure latestVer