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

Don't remove legacy dir if it doesn't exist

Browse Source
This commit is contained in:
Julian Ospald 2022-07-07 14:03:49 +02:00
parent a264cb088e
commit 544c618473
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
2 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lib/GHCup/GHC.hs
View File

@ -566,8 +566,11 @@ rmGHCVer ver = do
lift $ recycleFile f lift $ recycleFile f
when (not (null survivors)) $ throwE $ UninstallFailed dir survivors when (not (null survivors)) $ throwE $ UninstallFailed dir survivors
Nothing -> do Nothing -> do
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack dir isDir <- liftIO $ doesDirectoryExist dir
lift $ recyclePathForcibly dir' isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink dir
when (isDir && not isSyml) $ do
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack dir
recyclePathForcibly dir'
v' <- v' <-
handle handle

9
lib/GHCup/HLS.hs
View File

@ -492,7 +492,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal patc
pure ghcInstallDir pure ghcInstallDir
forM_ artifacts $ \artifact -> do forM_ artifacts $ \artifact -> do
logInfo $ T.pack (show artifact) logDebug $ T.pack (show artifact)
liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt) liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt)
(tmpInstallDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt) (tmpInstallDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt) liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt)
@ -646,8 +646,11 @@ rmHLSVer ver = do
lift $ recycleFile f lift $ recycleFile f
when (not (null survivors)) $ throwE $ UninstallFailed hlsDir survivors when (not (null survivors)) $ throwE $ UninstallFailed hlsDir survivors
Nothing -> do Nothing -> do
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir isDir <- liftIO $ doesDirectoryExist hlsDir
recyclePathForcibly hlsDir' isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink hlsDir
when (isDir && not isSyml) $ do
lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir
recyclePathForcibly hlsDir'
when (Just ver == isHlsSet) $ do when (Just ver == isHlsSet) $ do
-- set latest hls -- set latest hls