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

implements checking if file already exists for Cabal installs

Browse Source
This commit is contained in:
Arjun Kathuria 2021-08-11 10:33:08 +05:30
parent ce6fb0bb1e
commit c2c5625685
3 changed files with 8 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
app/ghcup/BrickMain.hs
View File

@ -442,6 +442,7 @@ install' _ (_, ListResult {..}) = do
, DownloadFailed , DownloadFailed
, NoUpdate , NoUpdate
, TarDirDoesNotExist , TarDirDoesNotExist
, FileAlreadyExistsError
] ]
run (do run (do

1
app/ghcup/Main.hs
View File

@ -1478,6 +1478,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
, TarDirDoesNotExist , TarDirDoesNotExist
, NextVerNotFound , NextVerNotFound
, NoToolVersionSet , NoToolVersionSet
, FileAlreadyExistsError
] ]
let runInstTool mInstPlatform action' = do let runInstTool mInstPlatform action' = do

7
lib/GHCup.hs
View File

@ -405,6 +405,7 @@ installCabalBindist :: ( MonadMask m
#if !defined(TAR) #if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif #endif
, FileAlreadyExistsError
] ]
m m
() ()
@ -456,13 +457,16 @@ installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> FilePath -- ^ Path to install to
-> Version -> Version
-> Excepts '[CopyError] m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked path inst ver = do installCabalUnpacked path inst ver = do
lift $ $(logInfo) "Installing cabal" lift $ $(logInfo) "Installing cabal"
let cabalFile = "cabal" let cabalFile = "cabal"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' inst
let destFileName = cabalFile <> "-" <> T.unpack (prettyVer ver) <> exeExt let destFileName = cabalFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
let destPath = inst </> destFileName let destPath = inst </> destFileName
whenM
(liftIO $ doesFileExist destPath)
(throwE $ FileAlreadyExistsError destPath)
handleIO (throwE . CopyError . show) $ liftIO $ copyFile handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> cabalFile <> exeExt) (path </> cabalFile <> exeExt)
destPath destPath
@ -498,6 +502,7 @@ installCabalBin :: ( MonadMask m
#if !defined(TAR) #if !defined(TAR)
, ArchiveResult , ArchiveResult
#endif #endif
, FileAlreadyExistsError
] ]
m m
() ()