From e2daf5381c15b09faf8871b66b025d5b3cf199de Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Tue, 20 Jul 2021 22:05:01 +0530 Subject: [PATCH 01/26] adds basic --isolate option structure for install commands --- app/ghcup/Main.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 30459f1..6468f59 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -137,6 +137,7 @@ data InstallOptions = InstallOptions , instPlatform :: Maybe PlatformRequest , instBindist :: Maybe URI , instSet :: Bool + , isolateDir :: Maybe FilePath } data SetCommand = SetGHC SetOptions @@ -571,7 +572,7 @@ Examples: installOpts :: Maybe Tool -> Parser InstallOptions installOpts tool = - (\p (u, v) b -> InstallOptions v p u b) + (\p (u, v) b is -> InstallOptions v p u b is) <$> optional (option (eitherReader platformParser) @@ -600,6 +601,15 @@ installOpts tool = (long "set" <> help "Set as active version after install" ) + <*> optional + (option + (eitherReader isolateParser) + ( short 'i' + <> long "isolate" + <> metavar "DIR" + <> help "install in an isolated dir instead of the default one" + ) + ) setParser :: Parser (Either SetCommand SetOptions) @@ -1201,6 +1211,10 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of bindistParser :: String -> Either String URI bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString +isolateParser :: FilePath -> Either String FilePath +isolateParser f = case isValid f of + True -> Right $ normalise f + False -> Left "Please enter a valid filepath for isolate dir." toSettings :: Options -> IO (Settings, KeyBindings) toSettings options = do From 9b3d55a0950a97a51588d82f98d36b930d2a63e7 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Thu, 22 Jul 2021 19:32:56 +0530 Subject: [PATCH 02/26] adds rudimentary isolate capability to ghcup install ghc command --- app/ghcup/Main.hs | 33 ++++++++++++++++++++------------- lib/GHCup.hs | 43 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 63 insertions(+), 13 deletions(-) diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 6468f59..f5ba12c 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1601,22 +1601,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 3628bd3..3f106f4 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -226,6 +226,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 From 8b7c22440e706de09bedf34d14a66154cf8b960f Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 23 Jul 2021 15:51:56 +0530 Subject: [PATCH 03/26] factor out installCabal' from `installCabalBindist`, to be shared with `installCabalBinIsolated` function --- lib/GHCup.hs | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 3f106f4..750746c 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -470,22 +470,22 @@ installCabalBindist dlinfo ver = do let lInstCabal = headMay . reverse . sort $ cVers when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver - where - -- | Install an unpacked cabal distribution. - installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m) - => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) - -> FilePath -- ^ Path to install to - -> Excepts '[CopyError] m () - installCabal' path inst = do - lift $ $(logInfo) "Installing cabal" - let cabalFile = "cabal" - liftIO $ createDirRecursive' inst - let destFileName = cabalFile <> "-" <> T.unpack (prettyVer ver) <> exeExt - let destPath = inst destFileName - handleIO (throwE . CopyError . show) $ liftIO $ copyFile - (path cabalFile <> exeExt) - destPath - lift $ chmod_755 destPath +-- | Install an unpacked cabal distribution. +installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m) + => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) + -> FilePath -- ^ Path to install to + -> Version + -> Excepts '[CopyError] m () +installCabal' path inst ver = do + lift $ $(logInfo) "Installing cabal" + let cabalFile = "cabal" + liftIO $ createDirRecursive' inst + let destFileName = cabalFile <> "-" <> T.unpack (prettyVer ver) <> exeExt + let destPath = inst destFileName + handleIO (throwE . CopyError . show) $ liftIO $ copyFile + (path cabalFile <> exeExt) + destPath + lift $ chmod_755 destPath -- | Installs cabal into @~\/.ghcup\/bin/cabal-\@ and From 91d982c7b23ca3d0f8357e4f009c71efa2ad21f5 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 23 Jul 2021 15:56:03 +0530 Subject: [PATCH 04/26] use the new factored out installCabal' in `installCabalBindist` function --- lib/GHCup.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 750746c..fc30c5f 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -463,7 +463,7 @@ installCabalBindist dlinfo ver = do -- the subdir of the archive where we do the work workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) - liftE $ installCabal' workdir binDir + liftE $ installCabal' workdir binDir ver -- create symlink if this is the latest version cVers <- lift $ fmap rights getInstalledCabals From 4729364e99fc9e96ce78ee0334344f5d240a8c93 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 23 Jul 2021 15:57:42 +0530 Subject: [PATCH 05/26] Adds isolate install functionality to 'Cabal' tool installs --- app/ghcup/Main.hs | 34 +++++++++++++++++++------------ lib/GHCup.hs | 51 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+), 13 deletions(-) diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index f5ba12c..7b284dd 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1649,19 +1649,27 @@ Report bugs at |] let installCabal InstallOptions{..} = - (case instBindist of - Nothing -> runInstTool instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer Cabal - liftE $ installCabalBin (_tvVersion v) - pure vi - Just uri -> do - s' <- appState - runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer Cabal - liftE $ installCabalBindist - (DownloadInfo uri Nothing "") - (_tvVersion v) - pure vi + (case isolateDir of + Just isoDir -> + runInstTool instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer Cabal + let cabalVersion = (_tvVersion v) + liftE $ installCabalBinIsolated isoDir cabalVersion + pure vi + Nothing -> + case instBindist of + Nothing -> runInstTool instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer Cabal + liftE $ installCabalBin (_tvVersion v) + pure vi + Just uri -> do + s' <- appState + runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer Cabal + liftE $ installCabalBindist + (DownloadInfo uri Nothing "") + (_tvVersion v) + pure vi ) >>= \case VRight vi -> do diff --git a/lib/GHCup.hs b/lib/GHCup.hs index fc30c5f..a3c0930 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -487,6 +487,57 @@ installCabal' path inst ver = do destPath lift $ chmod_755 destPath +-- | Installs GHC to a specified location, doesn't make any symlinks. +installCabalBinIsolated :: ( MonadMask m + , MonadCatch m + , MonadReader env m + , HasPlatformReq env + , HasGHCupInfo env + , HasDirs env + , HasSettings env + , MonadLogger m + , MonadResource m + , MonadIO m + , MonadUnliftIO m + , MonadFail m + ) + => FilePath + -> Version + -> Excepts + '[ AlreadyInstalled + , CopyError + , DigestError + , DownloadFailed + , NoDownload + , NotInstalled + , UnknownArchive + , TarDirDoesNotExist +#if !defined(TAR) + , ArchiveResult +#endif + ] + m + () +installCabalBinIsolated isoDir ver = do + dlinfo <- liftE $ getDownloadInfo Cabal ver + lift $ $(logDebug) [i|Requested to install cabal version #{ver}|] + + -- download (or use cached version) + dl <- liftE $ downloadCached dlinfo Nothing + + PlatformRequest {_rPlatform} <- lift getPlatformReq + + -- unpack + tmpUnpack <- lift withGHCupTmpDir + liftE $ unpackToDir tmpUnpack dl + void $ lift $ darwinNotarization _rPlatform tmpUnpack + + -- the subdir of the archive where we do the work + workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) + + lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|] + liftE $ installCabal' workdir isoDir ver + -- | Installs cabal into @~\/.ghcup\/bin/cabal-\@ and -- creates a default @cabal -> cabal-x.y.z.q@ symlink for From 9686ee98268217a2692efa3f45b40fa899be9b0f Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 23 Jul 2021 16:23:03 +0530 Subject: [PATCH 06/26] Factor out installHLS' --- lib/GHCup.hs | 55 ++++++++++++++++++++++++++-------------------------- 1 file changed, 27 insertions(+), 28 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index a3c0930..9b08917 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -634,39 +634,38 @@ installHLSBindist dlinfo ver = do let lInstHLS = headMay . reverse . sort $ hlsVers when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver - where - -- | Install an unpacked hls distribution. - installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m) - => FilePath -- ^ Path to the unpacked hls bindist (where the executable resides) - -> FilePath -- ^ Path to install to - -> Excepts '[CopyError] m () - installHLS' path inst = do - lift $ $(logInfo) "Installing HLS" - liftIO $ createDirRecursive' inst +-- | Install an unpacked hls distribution. +installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m) + => FilePath -- ^ Path to the unpacked hls bindist (where the executable resides) + -> FilePath -- ^ Path to install to + -> Version + -> Excepts '[CopyError] m () +installHLS' path inst ver = do + lift $ $(logInfo) "Installing HLS" + liftIO $ createDirRecursive' inst - -- install haskell-language-server- - bins@(_:_) <- liftIO $ findFiles - path - (makeRegexOpts compExtended - execBlank - ([s|^haskell-language-server-[0-9].*$|] :: ByteString) - ) - forM_ bins $ \f -> do - let toF = dropSuffix exeExt f - <> "~" <> T.unpack (prettyVer ver) <> exeExt - handleIO (throwE . CopyError . show) $ liftIO $ copyFile - (path f) - (inst toF) - lift $ chmod_755 (inst toF) - - -- install haskell-language-server-wrapper - let wrapper = "haskell-language-server-wrapper" - toF = wrapper <> "-" <> T.unpack (prettyVer ver) <> exeExt + -- install haskell-language-server- + bins@(_:_) <- liftIO $ findFiles + path + (makeRegexOpts compExtended + execBlank + ([s|^haskell-language-server-[0-9].*$|] :: ByteString) + ) + forM_ bins $ \f -> do + let toF = dropSuffix exeExt f + <> "~" <> T.unpack (prettyVer ver) <> exeExt handleIO (throwE . CopyError . show) $ liftIO $ copyFile - (path wrapper <> exeExt) + (path f) (inst toF) lift $ chmod_755 (inst toF) + -- install haskell-language-server-wrapper + let wrapper = "haskell-language-server-wrapper" + toF = wrapper <> "-" <> T.unpack (prettyVer ver) <> exeExt + handleIO (throwE . CopyError . show) $ liftIO $ copyFile + (path wrapper <> exeExt) + (inst toF) + lift $ chmod_755 (inst toF) -- | Installs hls binaries @haskell-language-server-\@ -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@. From 63f10a187113ff8c266098c40ded9c271d662d62 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 23 Jul 2021 16:23:52 +0530 Subject: [PATCH 07/26] update installHLS' usage in `installHLSBindist` --- lib/GHCup.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 9b08917..4c04b41 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -627,7 +627,7 @@ installHLSBindist dlinfo ver = do -- the subdir of the archive where we do the work workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) - liftE $ installHLS' workdir binDir + liftE $ installHLS' workdir binDir ver -- create symlink if this is the latest version hlsVers <- lift $ fmap rights getInstalledHLSs From 9a79af6fd2015fdf62587a2fd135397ab1148a7b Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 23 Jul 2021 16:25:01 +0530 Subject: [PATCH 08/26] Adds isolated install to HLS installs --- app/ghcup/Main.hs | 33 +++++++++++++++++----------- lib/GHCup.hs | 56 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 76 insertions(+), 13 deletions(-) diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 7b284dd..0d6e6d6 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1688,19 +1688,26 @@ Report bugs at |] pure $ ExitFailure 4 let installHLS InstallOptions{..} = - (case instBindist of - Nothing -> runInstTool instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer HLS - liftE $ installHLSBin (_tvVersion v) - pure vi - Just uri -> do - s' <- appState - runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer HLS - liftE $ installHLSBindist - (DownloadInfo uri Nothing "") - (_tvVersion v) - pure vi + (case isolateDir of + Just isoDir -> runInstTool instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer HLS + let hlsVersion = (_tvVersion v) + liftE $ installHLSBinIsolated isoDir hlsVersion + pure vi + Nothing -> + case instBindist of + Nothing -> runInstTool instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer HLS + liftE $ installHLSBin (_tvVersion v) + pure vi + Just uri -> do + s' <- appState + runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer HLS + liftE $ installHLSBindist + (DownloadInfo uri Nothing "") + (_tvVersion v) + pure vi ) >>= \case VRight vi -> do diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 4c04b41..50f30dd 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -667,6 +667,62 @@ installHLS' path inst ver = do (inst toF) lift $ chmod_755 (inst toF) +-- | Installs hls binaries in an isolated location provided by user, +-- doesn't make any symlinks + +installHLSBinIsolated :: ( MonadMask m + , MonadCatch m + , MonadReader env m + , HasPlatformReq env + , HasGHCupInfo env + , HasDirs env + , HasSettings env + , MonadLogger m + , MonadResource m + , MonadIO m + , MonadUnliftIO m + , MonadFail m + ) + => FilePath + -> Version + -> Excepts + '[ AlreadyInstalled + , CopyError + , DigestError + , DownloadFailed + , NoDownload + , NotInstalled + , UnknownArchive + , TarDirDoesNotExist +#if !defined(TAR) + , ArchiveResult +#endif + ] + m + () +installHLSBinIsolated isoDir ver = do + dlinfo <- liftE $ getDownloadInfo HLS ver + + lift $ $(logDebug) [i|Requested to install hls version #{ver}|] + + PlatformRequest {_rPlatform} <- lift getPlatformReq + + -- download (or use cached version) + dl <- liftE $ downloadCached dlinfo Nothing + + -- unpack + tmpUnpack <- lift withGHCupTmpDir + liftE $ unpackToDir tmpUnpack dl + void $ lift $ darwinNotarization _rPlatform tmpUnpack + + -- the subdir of the archive where we do the work + workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) + + lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|] + + liftE $ installHLS' workdir isoDir ver + + -- | Installs hls binaries @haskell-language-server-\@ -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@. installHLSBin :: ( MonadMask m From 42d4a6649397a093bd9a7bd4d484af0e69769fc8 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 23 Jul 2021 16:43:43 +0530 Subject: [PATCH 09/26] factor out installStack' function --- lib/GHCup.hs | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 50f30dd..91d4cfc 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -854,23 +854,23 @@ installStackBindist dlinfo ver = do let lInstStack = headMay . reverse . sort $ sVers when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver - where - -- | Install an unpacked stack distribution. - installStack' :: (MonadLogger m, MonadCatch m, MonadIO m) - => FilePath -- ^ Path to the unpacked stack bindist (where the executable resides) - -> FilePath -- ^ Path to install to - -> Excepts '[CopyError] m () - installStack' path inst = do - lift $ $(logInfo) "Installing stack" - let stackFile = "stack" - liftIO $ createDirRecursive' inst - let destFileName = stackFile <> "-" <> T.unpack (prettyVer ver) <> exeExt - let destPath = inst destFileName - handleIO (throwE . CopyError . show) $ liftIO $ copyFile - (path stackFile <> exeExt) - destPath - lift $ chmod_755 destPath +-- | Install an unpacked stack distribution. +installStack' :: (MonadLogger m, MonadCatch m, MonadIO m) + => FilePath -- ^ Path to the unpacked stack bindist (where the executable resides) + -> FilePath -- ^ Path to install to + -> Version + -> Excepts '[CopyError] m () +installStack' path inst ver = do + lift $ $(logInfo) "Installing stack" + let stackFile = "stack" + liftIO $ createDirRecursive' inst + let destFileName = stackFile <> "-" <> T.unpack (prettyVer ver) <> exeExt + let destPath = inst destFileName + handleIO (throwE . CopyError . show) $ liftIO $ copyFile + (path stackFile <> exeExt) + destPath + lift $ chmod_755 destPath From 873f75da9f52c2b33230793aeae51db35396a4f2 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 23 Jul 2021 16:44:40 +0530 Subject: [PATCH 10/26] updates installStack' usage in `installStackBindist` function --- lib/GHCup.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 91d4cfc..d9f8509 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -847,7 +847,7 @@ installStackBindist dlinfo ver = do -- the subdir of the archive where we do the work workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) - liftE $ installStack' workdir binDir + liftE $ installStack' workdir binDir ver -- create symlink if this is the latest version sVers <- lift $ fmap rights getInstalledStacks From 511272e86d0725237332a9701779e0056169e460 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 23 Jul 2021 16:46:11 +0530 Subject: [PATCH 11/26] Adds isolated installs to Stack install --- app/ghcup/Main.hs | 33 +++++++++++++++++------------ lib/GHCup.hs | 54 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 74 insertions(+), 13 deletions(-) diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 0d6e6d6..0e0f26f 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1726,19 +1726,26 @@ Report bugs at |] pure $ ExitFailure 4 let installStack InstallOptions{..} = - (case instBindist of - Nothing -> runInstTool instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer Stack - liftE $ installStackBin (_tvVersion v) - pure vi - Just uri -> do - s' <- appState - runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer Stack - liftE $ installStackBindist - (DownloadInfo uri Nothing "") - (_tvVersion v) - pure vi + (case isolateDir of + Just isoDir -> runInstTool instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer Stack + let stackVersion = (_tvVersion v) + liftE $ installStackBinIsolated isoDir stackVersion + pure vi + Nothing -> + case instBindist of + Nothing -> runInstTool instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer Stack + liftE $ installStackBin (_tvVersion v) + pure vi + Just uri -> do + s' <- appState + runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer Stack + liftE $ installStackBindist + (DownloadInfo uri Nothing "") + (_tvVersion v) + pure vi ) >>= \case VRight vi -> do diff --git a/lib/GHCup.hs b/lib/GHCup.hs index d9f8509..559fcef 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -873,6 +873,60 @@ installStack' path inst ver = do lift $ chmod_755 destPath +-- | Installs stack into an isolated location sepcified by the user, +-- also, doesn't make any symlinks. + +installStackBinIsolated :: ( MonadMask m + , MonadCatch m + , MonadReader env m + , HasDirs env + , HasSettings env + , HasPlatformReq env + , HasGHCupInfo env + , MonadLogger m + , MonadResource m + , MonadIO m + , MonadUnliftIO m + , MonadFail m + ) + => FilePath + -> Version + -> Excepts + '[ AlreadyInstalled + , CopyError + , DigestError + , DownloadFailed + , NoDownload + , NotInstalled + , UnknownArchive + , TarDirDoesNotExist +#if !defined(TAR) + , ArchiveResult +#endif + ] + m + () +installStackBinIsolated isoDir ver = do + dlinfo <- liftE $ getDownloadInfo Stack ver + + lift $ $(logDebug) [i|Requested to install stack version #{ver}|] + + PlatformRequest {_rPlatform} <- lift getPlatformReq + + -- download (or use cached version) + dl <- liftE $ downloadCached dlinfo Nothing + + -- unpack + tmpUnpack <- lift withGHCupTmpDir + liftE $ unpackToDir tmpUnpack dl + void $ lift $ darwinNotarization _rPlatform tmpUnpack + + -- the subdir of the archive where we do the work + workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) + + lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|] + + liftE $ installStack' workdir isoDir ver --------------------- --[ Set GHC/cabal ]-- From ba51cbad6fff049138d0cc7a24053fa348cf784d Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 23 Jul 2021 16:51:50 +0530 Subject: [PATCH 12/26] Adds a log to notify where the isolated ghc is being installed by the tool --- lib/GHCup.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 559fcef..52754e3 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -266,6 +266,8 @@ installGHCBinIsolated isoDir ver = do -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing + lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|] + liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver From 338f5f309df109430ecdbc62e03db0646197f640 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 25 Jul 2021 13:35:41 +0530 Subject: [PATCH 13/26] update `installGhcBindist` to take a "Maybe FilePath" to work with isolated installs --- lib/GHCup.hs | 29 +++++++++++++++++++++++------ 1 file changed, 23 insertions(+), 6 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 52754e3..0de2f92 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -183,6 +183,7 @@ installGHCBindist :: ( MonadFail m ) => DownloadInfo -- ^ where/how to download -> Version -- ^ the version to install + -> Maybe FilePath -- ^ isolated filepath if user passed any -> Excepts '[ AlreadyInstalled , BuildFailed @@ -198,10 +199,16 @@ installGHCBindist :: ( MonadFail m ] m () -installGHCBindist dlinfo ver = do +installGHCBindist dlinfo ver isoFilepath = do let tver = mkTVer ver + let isIsolatedInstall = isJust isoFilepath + + lift $ $(logDebug) [i|Requested to install GHC with #{ver}|] - whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver) + + -- we only care for already installed errors in regular (non-isolated) installs + when (not isIsolatedInstall) $ + whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver) -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing @@ -209,11 +216,21 @@ installGHCBindist dlinfo ver = do -- prepare paths ghcdir <- lift $ ghcupGHCDir tver - toolchainSanityChecks - - liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver + let isoDir = if isIsolatedInstall + then fromJust isoFilepath + else mempty :: FilePath - liftE $ postGHCInstall tver + if isIsolatedInstall + then do + lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|] + liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver + else do + toolchainSanityChecks + liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver + + -- make symlinks & stuff when regular install, + -- don't make any for isolated installs. + whenM (pure $ not isIsolatedInstall) (liftE $ postGHCInstall tver) where toolchainSanityChecks = do From 5efe2e5f7aea38a6569ca6a6b3928540380844d8 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 25 Jul 2021 13:38:32 +0530 Subject: [PATCH 14/26] updates usages of new installGHCBindist and related installGHCBin --- app/ghcup/BrickMain.hs | 2 +- app/ghcup/Main.hs | 38 ++++++++++++++++---------------------- lib/GHCup.hs | 5 +++-- 3 files changed, 20 insertions(+), 25 deletions(-) diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index ba6d8bc..497c2ba 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -448,7 +448,7 @@ install' _ (_, ListResult {..}) = do case lTool of GHC -> do let vi = getVersionInfo lVer GHC dls - liftE $ installGHCBin lVer $> vi + liftE $ installGHCBin lVer Nothing $> vi Cabal -> do let vi = getVersionInfo lVer Cabal dls liftE $ installCabalBin lVer $> vi diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 0e0f26f..d5bb1c4 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1601,28 +1601,22 @@ Report bugs at |] ----------------------- let installGHC InstallOptions{..} = - (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 $ 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 instBindist of + Nothing -> runInstTool instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer GHC + liftE $ installGHCBin (_tvVersion v) isolateDir + 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) + isolateDir + when instSet $ void $ liftE $ setGHC v SetGHCOnly + pure vi ) >>= \case VRight vi -> do diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 0de2f92..5f86cad 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -405,6 +405,7 @@ installGHCBin :: ( MonadFail m , MonadUnliftIO m ) => Version -- ^ the version to install + -> Maybe FilePath -- ^ isolated install filepath, if user passed any -> Excepts '[ AlreadyInstalled , BuildFailed @@ -420,9 +421,9 @@ installGHCBin :: ( MonadFail m ] m () -installGHCBin ver = do +installGHCBin ver isoFilepath = do dlinfo <- liftE $ getDownloadInfo GHC ver - installGHCBindist dlinfo ver + installGHCBindist dlinfo ver isoFilepath -- | Like 'installCabalBin', except takes the 'DownloadInfo' as From 4f7d41a8cc408f77393e8102ac9877e71aa80802 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 25 Jul 2021 13:39:44 +0530 Subject: [PATCH 15/26] remove installGHCBinIsolated function. --- lib/GHCup.hs | 45 --------------------------------------------- 1 file changed, 45 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 5f86cad..75d37a6 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -243,51 +243,6 @@ installGHCBindist dlinfo ver isoFilepath = 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 - - lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|] - - 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 From b148d8e2e7649d7adcbc02c3af463f336c632a78 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 25 Jul 2021 21:20:42 +0530 Subject: [PATCH 16/26] update `installCabalBindist` to take a "Maybe FilePath" argument for isolated installs --- lib/GHCup.hs | 26 ++++++++++++++++++++------ 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 75d37a6..12fa816 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -397,6 +397,7 @@ installCabalBindist :: ( MonadMask m ) => DownloadInfo -> Version + -> Maybe FilePath -- ^ isolated install filepath, if user provides any. -> Excepts '[ AlreadyInstalled , CopyError @@ -412,13 +413,17 @@ installCabalBindist :: ( MonadMask m ] m () -installCabalBindist dlinfo ver = do +installCabalBindist dlinfo ver isoFilepath = do lift $ $(logDebug) [i|Requested to install cabal version #{ver}|] PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs - whenM + let isIsolatedInstall = isJust isoFilepath + + -- check if cabal already installed in regular (non-isolated) installs + when (not isIsolatedInstall) $ + whenM (lift (cabalInstalled ver) >>= \a -> liftIO $ handleIO (\_ -> pure False) $ fmap (\x -> a && x) @@ -438,12 +443,21 @@ installCabalBindist dlinfo ver = do -- the subdir of the archive where we do the work workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) - liftE $ installCabal' workdir binDir ver + let isoDir = fromJust isoFilepath + + if isIsolatedInstall + then do + lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|] + liftE $ installCabal' workdir isoDir ver + else do + liftE $ installCabal' workdir binDir ver -- create symlink if this is the latest version - cVers <- lift $ fmap rights getInstalledCabals - let lInstCabal = headMay . reverse . sort $ cVers - when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver + -- not applicable for isolated installs + whenM (pure $ not isIsolatedInstall) $ do + cVers <- lift $ fmap rights getInstalledCabals + let lInstCabal = headMay . reverse . sort $ cVers + when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver -- | Install an unpacked cabal distribution. installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m) From bc6d006c578f85b8e1f6521a3c09fb5da7769874 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 25 Jul 2021 21:24:50 +0530 Subject: [PATCH 17/26] updates usages of new `installCabalBindist` across files. --- app/ghcup/BrickMain.hs | 2 +- app/ghcup/Main.hs | 35 ++++++++++++++--------------------- lib/GHCup.hs | 5 +++-- 3 files changed, 18 insertions(+), 24 deletions(-) diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index 497c2ba..9fc9c7d 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -451,7 +451,7 @@ install' _ (_, ListResult {..}) = do liftE $ installGHCBin lVer Nothing $> vi Cabal -> do let vi = getVersionInfo lVer Cabal dls - liftE $ installCabalBin lVer $> vi + liftE $ installCabalBin lVer Nothing $> vi GHCup -> do let vi = snd <$> getLatest dls GHCup liftE $ upgradeGHCup Nothing False $> vi diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index d5bb1c4..a945b9a 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1643,27 +1643,20 @@ Report bugs at |] let installCabal InstallOptions{..} = - (case isolateDir of - Just isoDir -> - runInstTool instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer Cabal - let cabalVersion = (_tvVersion v) - liftE $ installCabalBinIsolated isoDir cabalVersion - pure vi - Nothing -> - case instBindist of - Nothing -> runInstTool instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer Cabal - liftE $ installCabalBin (_tvVersion v) - pure vi - Just uri -> do - s' <- appState - runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer Cabal - liftE $ installCabalBindist - (DownloadInfo uri Nothing "") - (_tvVersion v) - pure vi + (case instBindist of + Nothing -> runInstTool instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer Cabal + liftE $ installCabalBin (_tvVersion v) isolateDir + pure vi + Just uri -> do + s' <- appState + runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer Cabal + liftE $ installCabalBindist + (DownloadInfo uri Nothing "") + (_tvVersion v) + isolateDir + pure vi ) >>= \case VRight vi -> do diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 12fa816..5e3d92f 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -545,6 +545,7 @@ installCabalBin :: ( MonadMask m , MonadFail m ) => Version + -> Maybe FilePath -- isolated install Path, if user provided any -> Excepts '[ AlreadyInstalled , CopyError @@ -560,9 +561,9 @@ installCabalBin :: ( MonadMask m ] m () -installCabalBin ver = do +installCabalBin ver isoFilepath = do dlinfo <- liftE $ getDownloadInfo Cabal ver - installCabalBindist dlinfo ver + installCabalBindist dlinfo ver isoFilepath -- | Like 'installHLSBin, except takes the 'DownloadInfo' as From 5995a8b5928a74b0566972947bbfe8e41a7fbe8c Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 25 Jul 2021 21:25:27 +0530 Subject: [PATCH 18/26] Delete installCabalBinIsolated function. --- lib/GHCup.hs | 52 ---------------------------------------------------- 1 file changed, 52 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 5e3d92f..a0c1382 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -476,58 +476,6 @@ installCabal' path inst ver = do destPath lift $ chmod_755 destPath --- | Installs GHC to a specified location, doesn't make any symlinks. -installCabalBinIsolated :: ( MonadMask m - , MonadCatch m - , MonadReader env m - , HasPlatformReq env - , HasGHCupInfo env - , HasDirs env - , HasSettings env - , MonadLogger m - , MonadResource m - , MonadIO m - , MonadUnliftIO m - , MonadFail m - ) - => FilePath - -> Version - -> Excepts - '[ AlreadyInstalled - , CopyError - , DigestError - , DownloadFailed - , NoDownload - , NotInstalled - , UnknownArchive - , TarDirDoesNotExist -#if !defined(TAR) - , ArchiveResult -#endif - ] - m - () -installCabalBinIsolated isoDir ver = do - dlinfo <- liftE $ getDownloadInfo Cabal ver - lift $ $(logDebug) [i|Requested to install cabal version #{ver}|] - - -- download (or use cached version) - dl <- liftE $ downloadCached dlinfo Nothing - - PlatformRequest {_rPlatform} <- lift getPlatformReq - - -- unpack - tmpUnpack <- lift withGHCupTmpDir - liftE $ unpackToDir tmpUnpack dl - void $ lift $ darwinNotarization _rPlatform tmpUnpack - - -- the subdir of the archive where we do the work - workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) - - lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|] - liftE $ installCabal' workdir isoDir ver - - -- | Installs cabal into @~\/.ghcup\/bin/cabal-\@ and -- creates a default @cabal -> cabal-x.y.z.q@ symlink for -- the latest installed version. From e5d3080b54284d11d72184227afaa8be5cfd4d0c Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 25 Jul 2021 22:08:32 +0530 Subject: [PATCH 19/26] update `installHLSBindist` to take a "Maybe FilePath" argument for isolated installs --- lib/GHCup.hs | 26 +++++++++++++++++++------- 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index a0c1382..dd56d7b 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -530,6 +530,7 @@ installHLSBindist :: ( MonadMask m ) => DownloadInfo -> Version + -> Maybe FilePath -- ^ isolated install path, if user passed any -> Excepts '[ AlreadyInstalled , CopyError @@ -545,13 +546,17 @@ installHLSBindist :: ( MonadMask m ] m () -installHLSBindist dlinfo ver = do +installHLSBindist dlinfo ver isoFilepath = do lift $ $(logDebug) [i|Requested to install hls version #{ver}|] PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs - whenM (lift (hlsInstalled ver)) + let isIsolatedInstall = isJust isoFilepath + + -- we only check for already installed in regular (non-isolated) installs + when (not isIsolatedInstall) $ + whenM (lift (hlsInstalled ver)) (throwE $ AlreadyInstalled HLS ver) -- download (or use cached version) @@ -564,13 +569,20 @@ installHLSBindist dlinfo ver = do -- the subdir of the archive where we do the work workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) + let isoDir = fromJust isoFilepath - liftE $ installHLS' workdir binDir ver + if isIsolatedInstall + then do + lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|] + liftE $ installHLS' workdir isoDir ver + else do + liftE $ installHLS' workdir binDir ver - -- create symlink if this is the latest version - hlsVers <- lift $ fmap rights getInstalledHLSs - let lInstHLS = headMay . reverse . sort $ hlsVers - when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver + -- create symlink if this is the latest version in a regular install + whenM (pure $ not isIsolatedInstall) $ do + hlsVers <- lift $ fmap rights getInstalledHLSs + let lInstHLS = headMay . reverse . sort $ hlsVers + when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver -- | Install an unpacked hls distribution. installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m) From 9c22ba9d45b44e69962efef028efc56f29ea7235 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 25 Jul 2021 22:10:10 +0530 Subject: [PATCH 20/26] updates usages of `installHLSBin` across files --- app/ghcup/BrickMain.hs | 2 +- app/ghcup/Main.hs | 34 ++++++++++++++-------------------- lib/GHCup.hs | 5 +++-- 3 files changed, 18 insertions(+), 23 deletions(-) diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index 9fc9c7d..93ff739 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -457,7 +457,7 @@ install' _ (_, ListResult {..}) = do liftE $ upgradeGHCup Nothing False $> vi HLS -> do let vi = getVersionInfo lVer HLS dls - liftE $ installHLSBin lVer $> vi + liftE $ installHLSBin lVer Nothing $> vi Stack -> do let vi = getVersionInfo lVer Stack dls liftE $ installStackBin lVer $> vi diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index a945b9a..3b2e7aa 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1675,26 +1675,20 @@ Report bugs at |] pure $ ExitFailure 4 let installHLS InstallOptions{..} = - (case isolateDir of - Just isoDir -> runInstTool instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer HLS - let hlsVersion = (_tvVersion v) - liftE $ installHLSBinIsolated isoDir hlsVersion - pure vi - Nothing -> - case instBindist of - Nothing -> runInstTool instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer HLS - liftE $ installHLSBin (_tvVersion v) - pure vi - Just uri -> do - s' <- appState - runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer HLS - liftE $ installHLSBindist - (DownloadInfo uri Nothing "") - (_tvVersion v) - pure vi + (case instBindist of + Nothing -> runInstTool instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer HLS + liftE $ installHLSBin (_tvVersion v) isolateDir + pure vi + Just uri -> do + s' <- appState + runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer HLS + liftE $ installHLSBindist + (DownloadInfo uri Nothing "") + (_tvVersion v) + isolateDir + pure vi ) >>= \case VRight vi -> do diff --git a/lib/GHCup.hs b/lib/GHCup.hs index dd56d7b..f8b6b41 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -689,6 +689,7 @@ installHLSBin :: ( MonadMask m , MonadFail m ) => Version + -> Maybe FilePath -> Excepts '[ AlreadyInstalled , CopyError @@ -704,9 +705,9 @@ installHLSBin :: ( MonadMask m ] m () -installHLSBin ver = do +installHLSBin ver isoFilepath = do dlinfo <- liftE $ getDownloadInfo HLS ver - installHLSBindist dlinfo ver + installHLSBindist dlinfo ver isoFilepath -- | Installs stack into @~\/.ghcup\/bin/stack-\@ and From e9da8ab439f2b37938bfdf1cc592490f30009886 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 25 Jul 2021 22:10:43 +0530 Subject: [PATCH 21/26] deletes `installHLSBinIsolated` function --- lib/GHCup.hs | 56 ---------------------------------------------------- 1 file changed, 56 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index f8b6b41..88ed583 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -617,62 +617,6 @@ installHLS' path inst ver = do (inst toF) lift $ chmod_755 (inst toF) --- | Installs hls binaries in an isolated location provided by user, --- doesn't make any symlinks - -installHLSBinIsolated :: ( MonadMask m - , MonadCatch m - , MonadReader env m - , HasPlatformReq env - , HasGHCupInfo env - , HasDirs env - , HasSettings env - , MonadLogger m - , MonadResource m - , MonadIO m - , MonadUnliftIO m - , MonadFail m - ) - => FilePath - -> Version - -> Excepts - '[ AlreadyInstalled - , CopyError - , DigestError - , DownloadFailed - , NoDownload - , NotInstalled - , UnknownArchive - , TarDirDoesNotExist -#if !defined(TAR) - , ArchiveResult -#endif - ] - m - () -installHLSBinIsolated isoDir ver = do - dlinfo <- liftE $ getDownloadInfo HLS ver - - lift $ $(logDebug) [i|Requested to install hls version #{ver}|] - - PlatformRequest {_rPlatform} <- lift getPlatformReq - - -- download (or use cached version) - dl <- liftE $ downloadCached dlinfo Nothing - - -- unpack - tmpUnpack <- lift withGHCupTmpDir - liftE $ unpackToDir tmpUnpack dl - void $ lift $ darwinNotarization _rPlatform tmpUnpack - - -- the subdir of the archive where we do the work - workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) - - lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|] - - liftE $ installHLS' workdir isoDir ver - - -- | Installs hls binaries @haskell-language-server-\@ -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@. installHLSBin :: ( MonadMask m From fd2add78bd3ab00bfc125bd122eeb5adff18611e Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 25 Jul 2021 22:23:58 +0530 Subject: [PATCH 22/26] update `installStackBindist` to take a "Maybe FilePath" argument for isolated installs --- lib/GHCup.hs | 26 +++++++++++++++++++------- 1 file changed, 19 insertions(+), 7 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 88ed583..576084a 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -707,6 +707,7 @@ installStackBindist :: ( MonadMask m ) => DownloadInfo -> Version + -> Maybe FilePath -> Excepts '[ AlreadyInstalled , CopyError @@ -722,13 +723,16 @@ installStackBindist :: ( MonadMask m ] m () -installStackBindist dlinfo ver = do +installStackBindist dlinfo ver isoFilepath = do lift $ $(logDebug) [i|Requested to install stack version #{ver}|] PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs - whenM (lift (stackInstalled ver)) + let isIsolatedInstall = isJust isoFilepath + + when (not isIsolatedInstall) $ + whenM (lift (stackInstalled ver)) (throwE $ AlreadyInstalled Stack ver) -- download (or use cached version) @@ -742,12 +746,20 @@ installStackBindist dlinfo ver = do -- the subdir of the archive where we do the work workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) - liftE $ installStack' workdir binDir ver + let isoDir = fromJust isoFilepath - -- create symlink if this is the latest version - sVers <- lift $ fmap rights getInstalledStacks - let lInstStack = headMay . reverse . sort $ sVers - when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver + if isIsolatedInstall + then do + lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|] + liftE $ installStack' workdir isoDir ver + else do + liftE $ installStack' workdir binDir ver + + -- create symlink if this is the latest version and a regular install + whenM (pure $ not isIsolatedInstall) $ do + sVers <- lift $ fmap rights getInstalledStacks + let lInstStack = headMay . reverse . sort $ sVers + when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver -- | Install an unpacked stack distribution. From 4e3dbea5d06a79aa4e11f40b2be5d4cf3557c89e Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 25 Jul 2021 22:24:38 +0530 Subject: [PATCH 23/26] updates usages of new `installStackBin` across files --- app/ghcup/BrickMain.hs | 2 +- app/ghcup/Main.hs | 34 ++++++++++++++-------------------- lib/GHCup.hs | 5 +++-- 3 files changed, 18 insertions(+), 23 deletions(-) diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index 93ff739..a320087 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -460,7 +460,7 @@ install' _ (_, ListResult {..}) = do liftE $ installHLSBin lVer Nothing $> vi Stack -> do let vi = getVersionInfo lVer Stack dls - liftE $ installStackBin lVer $> vi + liftE $ installStackBin lVer Nothing $> vi ) >>= \case VRight vi -> do diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 3b2e7aa..34caac0 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1707,26 +1707,20 @@ Report bugs at |] pure $ ExitFailure 4 let installStack InstallOptions{..} = - (case isolateDir of - Just isoDir -> runInstTool instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer Stack - let stackVersion = (_tvVersion v) - liftE $ installStackBinIsolated isoDir stackVersion - pure vi - Nothing -> - case instBindist of - Nothing -> runInstTool instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer Stack - liftE $ installStackBin (_tvVersion v) - pure vi - Just uri -> do - s' <- appState - runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do - (v, vi) <- liftE $ fromVersion instVer Stack - liftE $ installStackBindist - (DownloadInfo uri Nothing "") - (_tvVersion v) - pure vi + (case instBindist of + Nothing -> runInstTool instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer Stack + liftE $ installStackBin (_tvVersion v) isolateDir + pure vi + Just uri -> do + s' <- appState + runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do + (v, vi) <- liftE $ fromVersion instVer Stack + liftE $ installStackBindist + (DownloadInfo uri Nothing "") + (_tvVersion v) + isolateDir + pure vi ) >>= \case VRight vi -> do diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 576084a..d1e6a9e 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -671,6 +671,7 @@ installStackBin :: ( MonadMask m , MonadFail m ) => Version + -> Maybe FilePath -> Excepts '[ AlreadyInstalled , CopyError @@ -686,9 +687,9 @@ installStackBin :: ( MonadMask m ] m () -installStackBin ver = do +installStackBin ver isoFilepath = do dlinfo <- liftE $ getDownloadInfo Stack ver - installStackBindist dlinfo ver + installStackBindist dlinfo ver isoFilepath -- | Like 'installStackBin', except takes the 'DownloadInfo' as From 692cd1616b3602fa006f5c22aee538f5c066ab63 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 25 Jul 2021 22:25:25 +0530 Subject: [PATCH 24/26] deletes `installStackBinIsolated` function --- lib/GHCup.hs | 55 ---------------------------------------------------- 1 file changed, 55 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index d1e6a9e..908e1c4 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -781,61 +781,6 @@ installStack' path inst ver = do lift $ chmod_755 destPath --- | Installs stack into an isolated location sepcified by the user, --- also, doesn't make any symlinks. - -installStackBinIsolated :: ( MonadMask m - , MonadCatch m - , MonadReader env m - , HasDirs env - , HasSettings env - , HasPlatformReq env - , HasGHCupInfo env - , MonadLogger m - , MonadResource m - , MonadIO m - , MonadUnliftIO m - , MonadFail m - ) - => FilePath - -> Version - -> Excepts - '[ AlreadyInstalled - , CopyError - , DigestError - , DownloadFailed - , NoDownload - , NotInstalled - , UnknownArchive - , TarDirDoesNotExist -#if !defined(TAR) - , ArchiveResult -#endif - ] - m - () -installStackBinIsolated isoDir ver = do - dlinfo <- liftE $ getDownloadInfo Stack ver - - lift $ $(logDebug) [i|Requested to install stack version #{ver}|] - - PlatformRequest {_rPlatform} <- lift getPlatformReq - - -- download (or use cached version) - dl <- liftE $ downloadCached dlinfo Nothing - - -- unpack - tmpUnpack <- lift withGHCupTmpDir - liftE $ unpackToDir tmpUnpack dl - void $ lift $ darwinNotarization _rPlatform tmpUnpack - - -- the subdir of the archive where we do the work - workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) - - lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|] - - liftE $ installStack' workdir isoDir ver - --------------------- --[ Set GHC/cabal ]-- --------------------- From 71e6dbfdca6c546a8d81694ebc9a92ee28983cb5 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 25 Jul 2021 22:34:53 +0530 Subject: [PATCH 25/26] rename some auxiliary functions to their "unpacked" versions --- lib/GHCup.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 908e1c4..772129b 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -448,9 +448,9 @@ installCabalBindist dlinfo ver isoFilepath = do if isIsolatedInstall then do lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|] - liftE $ installCabal' workdir isoDir ver + liftE $ installCabalUnpacked workdir isoDir ver else do - liftE $ installCabal' workdir binDir ver + liftE $ installCabalUnpacked workdir binDir ver -- create symlink if this is the latest version -- not applicable for isolated installs @@ -460,12 +460,12 @@ installCabalBindist dlinfo ver isoFilepath = do when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver -- | Install an unpacked cabal distribution. -installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m) +installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) -> FilePath -- ^ Path to install to -> Version -> Excepts '[CopyError] m () -installCabal' path inst ver = do +installCabalUnpacked path inst ver = do lift $ $(logInfo) "Installing cabal" let cabalFile = "cabal" liftIO $ createDirRecursive' inst @@ -574,9 +574,9 @@ installHLSBindist dlinfo ver isoFilepath = do if isIsolatedInstall then do lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|] - liftE $ installHLS' workdir isoDir ver + liftE $ installHLSUnpacked workdir isoDir ver else do - liftE $ installHLS' workdir binDir ver + liftE $ installHLSUnpacked workdir binDir ver -- create symlink if this is the latest version in a regular install whenM (pure $ not isIsolatedInstall) $ do @@ -585,12 +585,12 @@ installHLSBindist dlinfo ver isoFilepath = do when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver -- | Install an unpacked hls distribution. -installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m) +installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m) => FilePath -- ^ Path to the unpacked hls bindist (where the executable resides) -> FilePath -- ^ Path to install to -> Version -> Excepts '[CopyError] m () -installHLS' path inst ver = do +installHLSUnpacked path inst ver = do lift $ $(logInfo) "Installing HLS" liftIO $ createDirRecursive' inst @@ -752,9 +752,9 @@ installStackBindist dlinfo ver isoFilepath = do if isIsolatedInstall then do lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|] - liftE $ installStack' workdir isoDir ver + liftE $ installStackUnpacked workdir isoDir ver else do - liftE $ installStack' workdir binDir ver + liftE $ installStackUnpacked workdir binDir ver -- create symlink if this is the latest version and a regular install whenM (pure $ not isIsolatedInstall) $ do @@ -764,12 +764,12 @@ installStackBindist dlinfo ver isoFilepath = do -- | Install an unpacked stack distribution. -installStack' :: (MonadLogger m, MonadCatch m, MonadIO m) +installStackUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m) => FilePath -- ^ Path to the unpacked stack bindist (where the executable resides) -> FilePath -- ^ Path to install to -> Version -> Excepts '[CopyError] m () -installStack' path inst ver = do +installStackUnpacked path inst ver = do lift $ $(logInfo) "Installing stack" let stackFile = "stack" liftIO $ createDirRecursive' inst From 03d77f50064117bc23061fa9272d0110732394ee Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Mon, 26 Jul 2021 11:49:52 +0530 Subject: [PATCH 26/26] updates Bindist functions as per https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/127#note_366702 --- lib/GHCup.hs | 144 ++++++++++++++++++++++++--------------------------- 1 file changed, 67 insertions(+), 77 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 772129b..4eba20d 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -201,14 +201,13 @@ installGHCBindist :: ( MonadFail m () installGHCBindist dlinfo ver isoFilepath = do let tver = mkTVer ver - let isIsolatedInstall = isJust isoFilepath - lift $ $(logDebug) [i|Requested to install GHC with #{ver}|] - -- we only care for already installed errors in regular (non-isolated) installs - when (not isIsolatedInstall) $ - whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver) + case isoFilepath of + -- we only care for already installed errors in regular (non-isolated) installs + Nothing -> whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver) + _ -> pure () -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing @@ -216,21 +215,16 @@ installGHCBindist dlinfo ver isoFilepath = do -- prepare paths ghcdir <- lift $ ghcupGHCDir tver - let isoDir = if isIsolatedInstall - then fromJust isoFilepath - else mempty :: FilePath + case isoFilepath of + Just isoDir -> do -- isolated install + lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|] + liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver + Nothing -> do -- regular install + toolchainSanityChecks + liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver - if isIsolatedInstall - then do - lift $ $(logInfo) [i|isolated installing GHC to #{isoDir}|] - liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver - else do - toolchainSanityChecks - liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver - - -- make symlinks & stuff when regular install, - -- don't make any for isolated installs. - whenM (pure $ not isIsolatedInstall) (liftE $ postGHCInstall tver) + -- make symlinks & stuff when regular install, + liftE $ postGHCInstall tver where toolchainSanityChecks = do @@ -419,18 +413,18 @@ installCabalBindist dlinfo ver isoFilepath = do PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs - let isIsolatedInstall = isJust isoFilepath + case isoFilepath of + Nothing -> -- for regular install check if any previous versions installed + whenM + (lift (cabalInstalled ver) >>= \a -> liftIO $ + handleIO (\_ -> pure False) + $ fmap (\x -> a && x) + -- ignore when the installation is a legacy cabal (binary, not symlink) + $ pathIsLink (binDir "cabal" <> exeExt) + ) + (throwE $ AlreadyInstalled Cabal ver) - -- check if cabal already installed in regular (non-isolated) installs - when (not isIsolatedInstall) $ - whenM - (lift (cabalInstalled ver) >>= \a -> liftIO $ - handleIO (\_ -> pure False) - $ fmap (\x -> a && x) - -- ignore when the installation is a legacy cabal (binary, not symlink) - $ pathIsLink (binDir "cabal" <> exeExt) - ) - (throwE $ AlreadyInstalled Cabal ver) + _ -> pure () -- check isn't required in isolated installs -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing @@ -443,21 +437,18 @@ installCabalBindist dlinfo ver isoFilepath = do -- the subdir of the archive where we do the work workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) - let isoDir = fromJust isoFilepath + case isoFilepath of + Just isoDir -> do -- isolated install + lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|] + liftE $ installCabalUnpacked workdir isoDir ver - if isIsolatedInstall - then do - lift $ $(logInfo) [i|isolated installing Cabal to #{isoDir}|] - liftE $ installCabalUnpacked workdir isoDir ver - else do - liftE $ installCabalUnpacked workdir binDir ver + Nothing -> do -- regular install + liftE $ installCabalUnpacked workdir binDir ver - -- create symlink if this is the latest version - -- not applicable for isolated installs - whenM (pure $ not isIsolatedInstall) $ do - cVers <- lift $ fmap rights getInstalledCabals - let lInstCabal = headMay . reverse . sort $ cVers - when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver + -- create symlink if this is the latest version for regular installs + cVers <- lift $ fmap rights getInstalledCabals + let lInstCabal = headMay . reverse . sort $ cVers + when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver -- | Install an unpacked cabal distribution. installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m) @@ -552,12 +543,13 @@ installHLSBindist dlinfo ver isoFilepath = do PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs - let isIsolatedInstall = isJust isoFilepath + case isoFilepath of + Nothing -> + -- we only check for already installed in regular (non-isolated) installs + whenM (lift (hlsInstalled ver)) + (throwE $ AlreadyInstalled HLS ver) - -- we only check for already installed in regular (non-isolated) installs - when (not isIsolatedInstall) $ - whenM (lift (hlsInstalled ver)) - (throwE $ AlreadyInstalled HLS ver) + _ -> pure () -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing @@ -569,20 +561,20 @@ installHLSBindist dlinfo ver isoFilepath = do -- the subdir of the archive where we do the work workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) - let isoDir = fromJust isoFilepath - if isIsolatedInstall - then do - lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|] - liftE $ installHLSUnpacked workdir isoDir ver - else do - liftE $ installHLSUnpacked workdir binDir ver + case isoFilepath of + Just isoDir -> do + lift $ $(logInfo) [i|isolated installing HLS to #{isoDir}|] + liftE $ installHLSUnpacked workdir isoDir ver + + Nothing -> do + liftE $ installHLSUnpacked workdir binDir ver + + -- create symlink if this is the latest version in a regular install + hlsVers <- lift $ fmap rights getInstalledHLSs + let lInstHLS = headMay . reverse . sort $ hlsVers + when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver - -- create symlink if this is the latest version in a regular install - whenM (pure $ not isIsolatedInstall) $ do - hlsVers <- lift $ fmap rights getInstalledHLSs - let lInstHLS = headMay . reverse . sort $ hlsVers - when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver -- | Install an unpacked hls distribution. installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m) @@ -730,11 +722,12 @@ installStackBindist dlinfo ver isoFilepath = do PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs - let isIsolatedInstall = isJust isoFilepath + case isoFilepath of + Nothing -> -- check previous versions in case of regular installs + whenM (lift (stackInstalled ver)) + (throwE $ AlreadyInstalled Stack ver) - when (not isIsolatedInstall) $ - whenM (lift (stackInstalled ver)) - (throwE $ AlreadyInstalled Stack ver) + _ -> pure () -- don't do shit for isolates -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing @@ -747,20 +740,17 @@ installStackBindist dlinfo ver isoFilepath = do -- the subdir of the archive where we do the work workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo) - let isoDir = fromJust isoFilepath + case isoFilepath of + Just isoDir -> do -- isolated install + lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|] + liftE $ installStackUnpacked workdir isoDir ver + Nothing -> do -- regular install + liftE $ installStackUnpacked workdir binDir ver - if isIsolatedInstall - then do - lift $ $(logInfo) [i|isolated installing Stack to #{isoDir}|] - liftE $ installStackUnpacked workdir isoDir ver - else do - liftE $ installStackUnpacked workdir binDir ver - - -- create symlink if this is the latest version and a regular install - whenM (pure $ not isIsolatedInstall) $ do - sVers <- lift $ fmap rights getInstalledStacks - let lInstStack = headMay . reverse . sort $ sVers - when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver + -- create symlink if this is the latest version and a regular install + sVers <- lift $ fmap rights getInstalledStacks + let lInstStack = headMay . reverse . sort $ sVers + when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver -- | Install an unpacked stack distribution.