diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 23fb40b..9c6f687 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1631,22 +1631,29 @@ Report bugs at |] ----------------------- let installGHC InstallOptions{..} = - (case instBindist of - Nothing -> runInstTool instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer GHC - liftE $ installGHCBin (_tvVersion v) - when instSet $ void $ liftE $ setGHC v SetGHCOnly - pure vi - Just uri -> do - s' <- liftIO appState - runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do + (case isolateDir of + Just isoDir -> runInstTool instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer GHC + let ghcVersion = _tvVersion v + liftE $ installGHCBinIsolated isoDir ghcVersion + pure vi + Nothing -> + case instBindist of + Nothing -> runInstTool instPlatform $ do (v, vi) <- liftE $ fromVersion instVer GHC - liftE $ installGHCBindist - (DownloadInfo uri (Just $ RegexDir "ghc-.*") "") - (_tvVersion v) + liftE $ installGHCBin (_tvVersion v) when instSet $ void $ liftE $ setGHC v SetGHCOnly pure vi - ) + Just uri -> do + s' <- liftIO appState + runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer GHC + liftE $ installGHCBindist + (DownloadInfo uri (Just $ RegexDir "ghc-.*") "") + (_tvVersion v) + when instSet $ void $ liftE $ setGHC v SetGHCOnly + pure vi + ) >>= \case VRight vi -> do runLogger $ $(logInfo) "GHC installation successful" diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 5a226e8..e579ddf 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -229,6 +229,49 @@ installGHCBindist dlinfo ver = do lift $ $(logWarn) "environments). If you encounter problems, unset CC and LD and reinstall." +-- | Installs GHC to a specified location, doesn't make any symlinks. +installGHCBinIsolated :: ( MonadFail m + , MonadMask m + , MonadCatch m + , MonadReader env m + , HasPlatformReq env + , HasGHCupInfo env + , HasDirs env + , HasSettings env + , MonadLogger m + , MonadResource m + , MonadIO m + , MonadUnliftIO m + ) + => FilePath + -> Version -- ^ the version to install + -> Excepts + '[ AlreadyInstalled + , BuildFailed + , DigestError + , DownloadFailed + , NoDownload + , NotInstalled + , UnknownArchive + , TarDirDoesNotExist +#if !defined(TAR) + , ArchiveResult +#endif + ] + m + () + +installGHCBinIsolated isoDir ver = do + dlinfo <- liftE $ getDownloadInfo GHC ver + + lift $ $(logDebug) [i|Requested to install GHC with #{ver}|] + + -- download (or use cached version) + dl <- liftE $ downloadCached dlinfo Nothing + + liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver + + -- | Install a packed GHC distribution. This only deals with unpacking and the GHC -- build system and nothing else. installPackedGHC :: ( MonadMask m