From 15560a06b19172f5f91aa1e354a304fbbcbc3029 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 27 Aug 2021 13:05:54 +0530 Subject: [PATCH 01/15] Adds the --force option in install commands --- app/ghcup/Main.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index ccba203..112f906 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -139,6 +139,7 @@ data InstallOptions = InstallOptions , instBindist :: Maybe URI , instSet :: Bool , isolateDir :: Maybe FilePath + , forceInstall :: Bool } data SetCommand = SetGHC SetOptions @@ -595,7 +596,7 @@ Examples: installOpts :: Maybe Tool -> Parser InstallOptions installOpts tool = - (\p (u, v) b is -> InstallOptions v p u b is) + (\p (u, v) b is f -> InstallOptions v p u b is f) <$> optional (option (eitherReader platformParser) @@ -633,6 +634,9 @@ installOpts tool = <> help "install in an isolated dir instead of the default one" ) ) + <*> switch + (short 'f' <> long "force" <> help "Force install") + setParser :: Parser (Either SetCommand SetOptions) From d7f82d643c79e2bfe19b4fd3a3cf0353a2637a8f Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 27 Aug 2021 13:06:18 +0530 Subject: [PATCH 02/15] implements --force option for cabal installs. --- app/ghcup/BrickMain.hs | 2 +- app/ghcup/Main.hs | 5 ++-- lib/GHCup.hs | 59 ++++++++++++++++++++++++++++-------------- 3 files changed, 44 insertions(+), 22 deletions(-) diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index 6cdcb4a..3ee740e 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -448,7 +448,7 @@ install' _ (_, ListResult {..}) = do liftE $ installGHCBin lVer Nothing $> vi Cabal -> do let vi = getVersionInfo lVer Cabal dls - liftE $ installCabalBin lVer Nothing $> vi + liftE $ installCabalBin lVer Nothing False $> 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 112f906..f998919 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1742,16 +1742,17 @@ Report bugs at |] (case instBindist of Nothing -> runInstTool instPlatform $ do (v, vi) <- liftE $ fromVersion instVer Cabal - liftE $ installCabalBin (_tvVersion v) isolateDir + liftE $ installCabalBin (_tvVersion v) isolateDir forceInstall pure vi Just uri -> do s' <- appState runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do (v, vi) <- liftE $ fromVersion instVer Cabal - liftE $ installCabalBindist + liftE $ installCabalBindist (DownloadInfo uri Nothing "") (_tvVersion v) isolateDir + forceInstall pure vi ) >>= \case diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 0489714..b3293b5 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -402,6 +402,7 @@ installCabalBindist :: ( MonadMask m => DownloadInfo -> Version -> Maybe FilePath -- ^ isolated install filepath, if user provides any. + -> Bool -- ^ Force install -> Excepts '[ AlreadyInstalled , CopyError @@ -416,25 +417,32 @@ installCabalBindist :: ( MonadMask m ] m () -installCabalBindist dlinfo ver isoFilepath = do +installCabalBindist dlinfo ver isoFilepath forceInstall = do lift $ $(logDebug) $ "Requested to install cabal version " <> prettyVer ver PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs - 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) - - _ -> pure () -- check isn't required in isolated installs + -- check if we already have a regular cabal already installed + regularCabalInstalled <- checkIfCabalInstalled ver binDir exeExt + + case forceInstall of + True -> case isoFilepath of + Nothing -> -- force install and a regular install + when (regularCabalInstalled) + (do + lift $ $(logInfo) $ "Removing the currently installed version first!" + liftE $ rmCabalVer ver) + + _ -> pure () -- force install and an isolated install (checks done later while unpacking) + False -> case isoFilepath of + Nothing -> + when (regularCabalInstalled) + (throwE $ AlreadyInstalled Cabal ver) + + _ -> pure () + -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing @@ -449,23 +457,34 @@ installCabalBindist dlinfo ver isoFilepath = do case isoFilepath of Just isoDir -> do -- isolated install lift $ $(logInfo) $ "isolated installing Cabal to " <> T.pack isoDir - liftE $ installCabalUnpacked workdir isoDir Nothing + liftE $ installCabalUnpacked workdir isoDir Nothing forceInstall Nothing -> do -- regular install - liftE $ installCabalUnpacked workdir binDir (Just ver) + liftE $ installCabalUnpacked workdir binDir (Just ver) forceInstall -- 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 + + where + + checkIfCabalInstalled ver binDir exeExt = (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) + ) + -- | Install an unpacked cabal distribution. installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) -> FilePath -- ^ Path to install to -> Maybe Version -- ^ Nothing for isolated install + -> Bool -- ^ Force Install -> Excepts '[CopyError, FileAlreadyExistsError] m () -installCabalUnpacked path inst mver' = do +installCabalUnpacked path inst mver' forceInstall = do lift $ $(logInfo) "Installing cabal" let cabalFile = "cabal" liftIO $ createDirRecursive' inst @@ -474,7 +493,8 @@ installCabalUnpacked path inst mver' = do <> exeExt let destPath = inst destFileName - liftE $ throwIfFileAlreadyExists destPath + unless forceInstall -- Overwrite it when it IS a force install + (liftE $ throwIfFileAlreadyExists destPath) handleIO (throwE . CopyError . show) $ liftIO $ copyFile (path cabalFile <> exeExt) @@ -499,6 +519,7 @@ installCabalBin :: ( MonadMask m ) => Version -> Maybe FilePath -- isolated install Path, if user provided any + -> Bool -- force install -> Excepts '[ AlreadyInstalled , CopyError @@ -513,9 +534,9 @@ installCabalBin :: ( MonadMask m ] m () -installCabalBin ver isoFilepath = do +installCabalBin ver isoFilepath forceInstall = do dlinfo <- liftE $ getDownloadInfo Cabal ver - installCabalBindist dlinfo ver isoFilepath + installCabalBindist dlinfo ver isoFilepath forceInstall -- | Like 'installHLSBin, except takes the 'DownloadInfo' as From f8d02431468c0ed061464b33359b7b988b668ccd Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Mon, 30 Aug 2021 15:18:43 +0530 Subject: [PATCH 03/15] refactor nested case statements when installing cabal --- lib/GHCup.hs | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index b3293b5..bc0ead8 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -426,22 +426,23 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do -- check if we already have a regular cabal already installed regularCabalInstalled <- checkIfCabalInstalled ver binDir exeExt - case forceInstall of - True -> case isoFilepath of - Nothing -> -- force install and a regular install - when (regularCabalInstalled) - (do - lift $ $(logInfo) $ "Removing the currently installed version first!" - liftE $ rmCabalVer ver) - - _ -> pure () -- force install and an isolated install (checks done later while unpacking) + -- check if we already have a regular cabal already installed + regularCabalInstalled <- lift $ checkIfToolInstalled Cabal ver + + if + | forceInstall + , regularCabalInstalled + , Nothing <- isoFilepath -> do + lift $ $(logInfo) $ "Removing the currently installed version first!" + liftE $ rmCabalVer ver + + | not forceInstall + , regularCabalInstalled + , Nothing <- isoFilepath -> do + throwE $ AlreadyInstalled Cabal ver + + | otherwise -> pure () - False -> case isoFilepath of - Nothing -> - when (regularCabalInstalled) - (throwE $ AlreadyInstalled Cabal ver) - - _ -> pure () -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing From be82565775f398d0f8aa1f6edb412cf90528ead3 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Mon, 30 Aug 2021 15:20:33 +0530 Subject: [PATCH 04/15] factor out `checkIfCabalInstalled` to `checkIfToolInstalled` --- lib/GHCup.hs | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index bc0ead8..07c6f7d 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -423,9 +423,6 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs - -- check if we already have a regular cabal already installed - regularCabalInstalled <- checkIfCabalInstalled ver binDir exeExt - -- check if we already have a regular cabal already installed regularCabalInstalled <- lift $ checkIfToolInstalled Cabal ver @@ -468,17 +465,28 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do let lInstCabal = headMay . reverse . sort $ cVers when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver - where +checkIfToolInstalled :: ( MonadIO m + , MonadLogger m + , MonadReader env m + , HasDirs env + , MonadCatch m) => + Tool -> + Version -> + m Bool - checkIfCabalInstalled ver binDir exeExt = (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) - ) +checkIfToolInstalled tool ver = do + Dirs { binDir } <- getDirs + case tool of + Cabal -> do + v <- cabalInstalled ver + liftIO $ handleIO (\_ -> pure False) + $ fmap (\x -> v && x) + $ pathIsLink (binDir "cabal" <> exeExt) --- | Install an unpacked cabal distribution. + _ -> pure False + +-- | Install an unpacked cabal distribution.Symbol installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) -> FilePath -- ^ Path to install to From 20bcb26e3d7d287d46ab2204c726656a300489bf Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 27 Aug 2021 13:05:54 +0530 Subject: [PATCH 05/15] Adds the --force option in install commands --- app/ghcup/Main.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 39b2e9a..343870c 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -141,6 +141,7 @@ data InstallOptions = InstallOptions , instBindist :: Maybe URI , instSet :: Bool , isolateDir :: Maybe FilePath + , forceInstall :: Bool } data SetCommand = SetGHC SetOptions @@ -602,7 +603,7 @@ Examples: installOpts :: Maybe Tool -> Parser InstallOptions installOpts tool = - (\p (u, v) b is -> InstallOptions v p u b is) + (\p (u, v) b is f -> InstallOptions v p u b is f) <$> optional (option (eitherReader platformParser) @@ -640,6 +641,9 @@ installOpts tool = <> help "install in an isolated dir instead of the default one" ) ) + <*> switch + (short 'f' <> long "force" <> help "Force install") + setParser :: Parser (Either SetCommand SetOptions) From 59a9a770a53d1e46994c3908a67d071d4e776324 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Fri, 27 Aug 2021 13:06:18 +0530 Subject: [PATCH 06/15] implements --force option for cabal installs. --- app/ghcup/BrickMain.hs | 2 +- app/ghcup/Main.hs | 5 ++-- lib/GHCup.hs | 65 ++++++++++++++++++++++++++++-------------- 3 files changed, 47 insertions(+), 25 deletions(-) diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index cb71e45..dbc963d 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -443,7 +443,7 @@ install' _ (_, ListResult {..}) = do liftE $ installGHCBin lVer Nothing $> vi Cabal -> do let vi = getVersionInfo lVer Cabal dls - liftE $ installCabalBin lVer Nothing $> vi + liftE $ installCabalBin lVer Nothing False $> 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 343870c..80c5c95 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1779,16 +1779,17 @@ Report bugs at |] (case instBindist of Nothing -> runInstTool instPlatform $ do (v, vi) <- liftE $ fromVersion instVer Cabal - liftE $ installCabalBin (_tvVersion v) isolateDir + liftE $ installCabalBin (_tvVersion v) isolateDir forceInstall pure vi Just uri -> do s' <- appState runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do (v, vi) <- liftE $ fromVersion instVer Cabal - liftE $ installCabalBindist + liftE $ installCabalBindist (DownloadInfo uri Nothing "") (_tvVersion v) isolateDir + forceInstall pure vi ) >>= \case diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 3a6f315..8813e2a 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -401,6 +401,7 @@ installCabalBindist :: ( MonadMask m => DownloadInfo -> Version -> Maybe FilePath -- ^ isolated install filepath, if user provides any. + -> Bool -- ^ Force install -> Excepts '[ AlreadyInstalled , CopyError @@ -415,25 +416,32 @@ installCabalBindist :: ( MonadMask m ] m () -installCabalBindist dlinfo ver isoFilepath = do - lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver +installCabalBindist dlinfo ver isoFilepath forceInstall = do + lift $ $(logDebug) $ "Requested to install cabal version " <> prettyVer ver PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs - 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) - - _ -> pure () -- check isn't required in isolated installs + -- check if we already have a regular cabal already installed + regularCabalInstalled <- checkIfCabalInstalled ver binDir exeExt + + case forceInstall of + True -> case isoFilepath of + Nothing -> -- force install and a regular install + when (regularCabalInstalled) + (do + lift $ $(logInfo) $ "Removing the currently installed version first!" + liftE $ rmCabalVer ver) + + _ -> pure () -- force install and an isolated install (checks done later while unpacking) + False -> case isoFilepath of + Nothing -> + when (regularCabalInstalled) + (throwE $ AlreadyInstalled Cabal ver) + + _ -> pure () + -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing @@ -447,25 +455,36 @@ installCabalBindist dlinfo ver isoFilepath = do case isoFilepath of Just isoDir -> do -- isolated install - lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir - liftE $ installCabalUnpacked workdir isoDir Nothing + lift $ $(logInfo) $ "isolated installing Cabal to " <> T.pack isoDir + liftE $ installCabalUnpacked workdir isoDir Nothing forceInstall Nothing -> do -- regular install - liftE $ installCabalUnpacked workdir binDir (Just ver) + liftE $ installCabalUnpacked workdir binDir (Just ver) forceInstall -- 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 + + where + + checkIfCabalInstalled ver binDir exeExt = (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) + ) + -- | Install an unpacked cabal distribution. installCabalUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) -> FilePath -- ^ Path to install to -> Maybe Version -- ^ Nothing for isolated install + -> Bool -- ^ Force Install -> Excepts '[CopyError, FileAlreadyExistsError] m () -installCabalUnpacked path inst mver' = do - lift $ logInfo "Installing cabal" +installCabalUnpacked path inst mver' forceInstall = do + lift $ $(logInfo) "Installing cabal" let cabalFile = "cabal" liftIO $ createDirRecursive' inst let destFileName = cabalFile @@ -473,7 +492,8 @@ installCabalUnpacked path inst mver' = do <> exeExt let destPath = inst destFileName - liftE $ throwIfFileAlreadyExists destPath + unless forceInstall -- Overwrite it when it IS a force install + (liftE $ throwIfFileAlreadyExists destPath) handleIO (throwE . CopyError . show) $ liftIO $ copyFile (path cabalFile <> exeExt) @@ -498,6 +518,7 @@ installCabalBin :: ( MonadMask m ) => Version -> Maybe FilePath -- isolated install Path, if user provided any + -> Bool -- force install -> Excepts '[ AlreadyInstalled , CopyError @@ -512,9 +533,9 @@ installCabalBin :: ( MonadMask m ] m () -installCabalBin ver isoFilepath = do +installCabalBin ver isoFilepath forceInstall = do dlinfo <- liftE $ getDownloadInfo Cabal ver - installCabalBindist dlinfo ver isoFilepath + installCabalBindist dlinfo ver isoFilepath forceInstall -- | Like 'installHLSBin, except takes the 'DownloadInfo' as From 107fed6e609ec808c3ee14c438733314fe9c4973 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Mon, 30 Aug 2021 15:18:43 +0530 Subject: [PATCH 07/15] refactor nested case statements when installing cabal --- lib/GHCup.hs | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 8813e2a..f75a99b 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -425,22 +425,23 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do -- check if we already have a regular cabal already installed regularCabalInstalled <- checkIfCabalInstalled ver binDir exeExt - case forceInstall of - True -> case isoFilepath of - Nothing -> -- force install and a regular install - when (regularCabalInstalled) - (do - lift $ $(logInfo) $ "Removing the currently installed version first!" - liftE $ rmCabalVer ver) - - _ -> pure () -- force install and an isolated install (checks done later while unpacking) + -- check if we already have a regular cabal already installed + regularCabalInstalled <- lift $ checkIfToolInstalled Cabal ver + + if + | forceInstall + , regularCabalInstalled + , Nothing <- isoFilepath -> do + lift $ $(logInfo) $ "Removing the currently installed version first!" + liftE $ rmCabalVer ver + + | not forceInstall + , regularCabalInstalled + , Nothing <- isoFilepath -> do + throwE $ AlreadyInstalled Cabal ver + + | otherwise -> pure () - False -> case isoFilepath of - Nothing -> - when (regularCabalInstalled) - (throwE $ AlreadyInstalled Cabal ver) - - _ -> pure () -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing From 0f98ec6b782c678489b98d76cb0c14a30a8d3be1 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Mon, 30 Aug 2021 15:20:33 +0530 Subject: [PATCH 08/15] factor out `checkIfCabalInstalled` to `checkIfToolInstalled` --- lib/GHCup.hs | 32 ++++++++++++++++++++------------ 1 file changed, 20 insertions(+), 12 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index f75a99b..eb5a847 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -422,9 +422,6 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs - -- check if we already have a regular cabal already installed - regularCabalInstalled <- checkIfCabalInstalled ver binDir exeExt - -- check if we already have a regular cabal already installed regularCabalInstalled <- lift $ checkIfToolInstalled Cabal ver @@ -467,18 +464,29 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do let lInstCabal = headMay . reverse . sort $ cVers when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver - where +checkIfToolInstalled :: ( MonadIO m + , MonadLogger m + , MonadReader env m + , HasDirs env + , MonadCatch m) => + Tool -> + Version -> + m Bool - checkIfCabalInstalled ver binDir exeExt = (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) - ) +checkIfToolInstalled tool ver = do + Dirs { binDir } <- getDirs + case tool of + Cabal -> do + v <- cabalInstalled ver + liftIO $ handleIO (\_ -> pure False) + $ fmap (\x -> v && x) + $ pathIsLink (binDir "cabal" <> exeExt) --- | Install an unpacked cabal distribution. -installCabalUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m) + _ -> pure False + +-- | Install an unpacked cabal distribution.Symbol +installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) -> FilePath -- ^ Path to install to -> Maybe Version -- ^ Nothing for isolated install From 7a6a119829aac0caeeccf56b90ca33845822556e Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Tue, 7 Sep 2021 14:21:24 +0530 Subject: [PATCH 09/15] Patch for MonadLogger deletion since new rebase --- lib/GHCup.hs | 11 +++++------ lib/GHCup/Utils.hs | 3 +-- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index eb5a847..fa58f29 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -417,7 +417,7 @@ installCabalBindist :: ( MonadMask m m () installCabalBindist dlinfo ver isoFilepath forceInstall = do - lift $ $(logDebug) $ "Requested to install cabal version " <> prettyVer ver + lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs @@ -429,7 +429,7 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do | forceInstall , regularCabalInstalled , Nothing <- isoFilepath -> do - lift $ $(logInfo) $ "Removing the currently installed version first!" + lift $ logInfo $ "Removing the currently installed version first!" liftE $ rmCabalVer ver | not forceInstall @@ -453,7 +453,7 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do case isoFilepath of Just isoDir -> do -- isolated install - lift $ $(logInfo) $ "isolated installing Cabal to " <> T.pack isoDir + lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir liftE $ installCabalUnpacked workdir isoDir Nothing forceInstall Nothing -> do -- regular install @@ -465,7 +465,6 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver checkIfToolInstalled :: ( MonadIO m - , MonadLogger m , MonadReader env m , HasDirs env , MonadCatch m) => @@ -486,14 +485,14 @@ checkIfToolInstalled tool ver = do _ -> pure False -- | Install an unpacked cabal distribution.Symbol -installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m) +installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) -> FilePath -- ^ Path to install to -> Maybe Version -- ^ Nothing for isolated install -> Bool -- ^ Force Install -> Excepts '[CopyError, FileAlreadyExistsError] m () installCabalUnpacked path inst mver' forceInstall = do - lift $ $(logInfo) "Installing cabal" + lift $ logInfo "Installing cabal" let cabalFile = "cabal" liftIO $ createDirRecursive' inst let destFileName = cabalFile diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index ad21d46..419a0cf 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -250,7 +250,6 @@ getInstalledGHCs = do -- | Get all installed cabals, by matching on @~\/.ghcup\/bin/cabal-*@. getInstalledCabals :: ( MonadReader env m , HasDirs env - , HasLog env , MonadIO m , MonadCatch m ) @@ -268,7 +267,7 @@ getInstalledCabals = do -- | Whether the given cabal version is installed. -cabalInstalled :: (HasLog env, MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool +cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool cabalInstalled ver = do vers <- fmap rights getInstalledCabals pure $ elem ver vers From d60f58cf431602a4d206b484318d76f5f125d209 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Tue, 7 Sep 2021 14:22:21 +0530 Subject: [PATCH 10/15] simplify `checkIfToolInstalled` for Cabal --- lib/GHCup.hs | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index fa58f29..89fa26b 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -476,12 +476,7 @@ checkIfToolInstalled tool ver = do Dirs { binDir } <- getDirs case tool of - Cabal -> do - v <- cabalInstalled ver - liftIO $ handleIO (\_ -> pure False) - $ fmap (\x -> v && x) - $ pathIsLink (binDir "cabal" <> exeExt) - + Cabal -> cabalInstalled ver _ -> pure False -- | Install an unpacked cabal distribution.Symbol From 6ac7a75bab8bc575cd0b4c2249f4a9c209ea8c79 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sat, 11 Sep 2021 21:29:53 +0530 Subject: [PATCH 11/15] Implements --force install for HLS --- app/ghcup/BrickMain.hs | 2 +- app/ghcup/Main.hs | 12 +++++++---- lib/GHCup.hs | 46 +++++++++++++++++++++++++++--------------- 3 files changed, 39 insertions(+), 21 deletions(-) diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index dbc963d..1a93c45 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -449,7 +449,7 @@ install' _ (_, ListResult {..}) = do liftE $ upgradeGHCup Nothing False $> vi HLS -> do let vi = getVersionInfo lVer HLS dls - liftE $ installHLSBin lVer Nothing $> vi + liftE $ installHLSBin lVer Nothing False $> vi Stack -> do let vi = getVersionInfo lVer Stack dls liftE $ installStackBin lVer Nothing $> vi diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 80c5c95..1f4bfa3 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1812,16 +1812,20 @@ Report bugs at |] (case instBindist of Nothing -> runInstTool instPlatform $ do (v, vi) <- liftE $ fromVersion instVer HLS - liftE $ installHLSBin (_tvVersion v) isolateDir + liftE $ installHLSBin + (_tvVersion v) + isolateDir + forceInstall 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 + (DownloadInfo uri Nothing "") + (_tvVersion v) + isolateDir + forceInstall pure vi ) >>= \case diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 89fa26b..319fae2 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -477,7 +477,8 @@ checkIfToolInstalled tool ver = do case tool of Cabal -> cabalInstalled ver - _ -> pure False + HLS -> hlsInstalled ver + _ -> pure False -- | Install an unpacked cabal distribution.Symbol installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m) @@ -558,6 +559,7 @@ installHLSBindist :: ( MonadMask m => DownloadInfo -> Version -> Maybe FilePath -- ^ isolated install path, if user passed any + -> Bool -- ^ Force install -> Excepts '[ AlreadyInstalled , CopyError @@ -572,20 +574,28 @@ installHLSBindist :: ( MonadMask m ] m () -installHLSBindist dlinfo ver isoFilepath = do +installHLSBindist dlinfo ver isoFilepath forceInstall = do lift $ logDebug $ "Requested to install hls version " <> prettyVer ver PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs - case isoFilepath of - Nothing -> - -- we only check for already installed in regular (non-isolated) installs - whenM (lift (hlsInstalled ver)) - (throwE $ AlreadyInstalled HLS ver) + regularHLSInstalled <- lift $ checkIfToolInstalled HLS ver - _ -> pure () + if + | forceInstall + , regularHLSInstalled + , Nothing <- isoFilepath -> do -- regular forced install + lift $ logInfo "Removing the currently installed version of HLS before force installing!" + liftE $ rmHLSVer ver + | not forceInstall + , regularHLSInstalled + , Nothing <- isoFilepath -> do -- regular install + throwE $ AlreadyInstalled HLS ver + + | otherwise -> pure () + -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing @@ -600,10 +610,10 @@ installHLSBindist dlinfo ver isoFilepath = do case isoFilepath of Just isoDir -> do lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir - liftE $ installHLSUnpacked workdir isoDir Nothing + liftE $ installHLSUnpacked workdir isoDir Nothing forceInstall Nothing -> do - liftE $ installHLSUnpacked workdir binDir (Just ver) + liftE $ installHLSUnpacked workdir binDir (Just ver) forceInstall -- create symlink if this is the latest version in a regular install hlsVers <- lift $ fmap rights getInstalledHLSs @@ -616,8 +626,9 @@ installHLSUnpacked :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, => FilePath -- ^ Path to the unpacked hls bindist (where the executable resides) -> FilePath -- ^ Path to install to -> Maybe Version -- ^ Nothing for isolated install + -> Bool -- ^ is it a force install -> Excepts '[CopyError, FileAlreadyExistsError] m () -installHLSUnpacked path inst mver' = do +installHLSUnpacked path inst mver' forceInstall = do lift $ logInfo "Installing HLS" liftIO $ createDirRecursive' inst @@ -636,7 +647,8 @@ installHLSUnpacked path inst mver' = do let srcPath = path f let destPath = inst toF - liftE $ throwIfFileAlreadyExists destPath + unless forceInstall -- if it is a force install, overwrite it. + (liftE $ throwIfFileAlreadyExists destPath) handleIO (throwE . CopyError . show) $ liftIO $ copyFile srcPath @@ -651,7 +663,8 @@ installHLSUnpacked path inst mver' = do srcWrapperPath = path wrapper <> exeExt destWrapperPath = inst toF - liftE $ throwIfFileAlreadyExists destWrapperPath + unless forceInstall + (liftE $ throwIfFileAlreadyExists destWrapperPath) handleIO (throwE . CopyError . show) $ liftIO $ copyFile srcWrapperPath @@ -675,7 +688,8 @@ installHLSBin :: ( MonadMask m , MonadFail m ) => Version - -> Maybe FilePath + -> Maybe FilePath -- isolated install Dir (if any) + -> Bool -- force install -> Excepts '[ AlreadyInstalled , CopyError @@ -690,9 +704,9 @@ installHLSBin :: ( MonadMask m ] m () -installHLSBin ver isoFilepath = do +installHLSBin ver isoFilepath forceInstall = do dlinfo <- liftE $ getDownloadInfo HLS ver - installHLSBindist dlinfo ver isoFilepath + installHLSBindist dlinfo ver isoFilepath forceInstall -- | Installs stack into @~\/.ghcup\/bin/stack-\@ and From 10a30bbf3821fb8b5b4c0d03cb1c7b62ca45509e Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sat, 11 Sep 2021 21:58:11 +0530 Subject: [PATCH 12/15] Implements --force install for Stack --- app/ghcup/BrickMain.hs | 2 +- app/ghcup/Main.hs | 12 ++++++++---- lib/GHCup.hs | 42 ++++++++++++++++++++++++++++-------------- 3 files changed, 37 insertions(+), 19 deletions(-) diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index 1a93c45..1316db6 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -452,7 +452,7 @@ install' _ (_, ListResult {..}) = do liftE $ installHLSBin lVer Nothing False $> vi Stack -> do let vi = getVersionInfo lVer Stack dls - liftE $ installStackBin lVer Nothing $> vi + liftE $ installStackBin lVer Nothing False $> vi ) >>= \case VRight vi -> do diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 1f4bfa3..4ad5d3c 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1852,16 +1852,20 @@ Report bugs at |] (case instBindist of Nothing -> runInstTool instPlatform $ do (v, vi) <- liftE $ fromVersion instVer Stack - liftE $ installStackBin (_tvVersion v) isolateDir + liftE $ installStackBin + (_tvVersion v) + isolateDir + forceInstall 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 + (DownloadInfo uri Nothing "") + (_tvVersion v) + isolateDir + forceInstall pure vi ) >>= \case diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 319fae2..8501d74 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -478,6 +478,7 @@ checkIfToolInstalled tool ver = do case tool of Cabal -> cabalInstalled ver HLS -> hlsInstalled ver + Stack -> stackInstalled ver _ -> pure False -- | Install an unpacked cabal distribution.Symbol @@ -726,7 +727,8 @@ installStackBin :: ( MonadMask m , MonadFail m ) => Version - -> Maybe FilePath + -> Maybe FilePath -- ^ isolate install Dir (if any) + -> Bool -- ^ Force install -> Excepts '[ AlreadyInstalled , CopyError @@ -741,9 +743,9 @@ installStackBin :: ( MonadMask m ] m () -installStackBin ver isoFilepath = do +installStackBin ver isoFilepath forceInstall = do dlinfo <- liftE $ getDownloadInfo Stack ver - installStackBindist dlinfo ver isoFilepath + installStackBindist dlinfo ver isoFilepath forceInstall -- | Like 'installStackBin', except takes the 'DownloadInfo' as @@ -762,7 +764,8 @@ installStackBindist :: ( MonadMask m ) => DownloadInfo -> Version - -> Maybe FilePath + -> Maybe FilePath -- ^ isolate install Dir (if any) + -> Bool -- ^ Force install -> Excepts '[ AlreadyInstalled , CopyError @@ -777,18 +780,27 @@ installStackBindist :: ( MonadMask m ] m () -installStackBindist dlinfo ver isoFilepath = do +installStackBindist dlinfo ver isoFilepath forceInstall = do lift $ logDebug $ "Requested to install stack version " <> prettyVer ver PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs - case isoFilepath of - Nothing -> -- check previous versions in case of regular installs - whenM (lift (stackInstalled ver)) - (throwE $ AlreadyInstalled Stack ver) + regularStackInstalled <- lift $ checkIfToolInstalled Stack ver - _ -> pure () -- don't do shit for isolates + if + | not forceInstall + , regularStackInstalled + , Nothing <- isoFilepath -> do + throwE $ AlreadyInstalled Stack ver + + | forceInstall + , regularStackInstalled + , Nothing <- isoFilepath -> do + lift $ logInfo $ "Removing the currently installed version of Stack first!" + liftE $ rmStackVer ver + + | otherwise -> pure () -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing @@ -804,9 +816,9 @@ installStackBindist dlinfo ver isoFilepath = do case isoFilepath of Just isoDir -> do -- isolated install lift $ logInfo $ "isolated installing Stack to " <> T.pack isoDir - liftE $ installStackUnpacked workdir isoDir Nothing + liftE $ installStackUnpacked workdir isoDir Nothing forceInstall Nothing -> do -- regular install - liftE $ installStackUnpacked workdir binDir (Just ver) + liftE $ installStackUnpacked workdir binDir (Just ver) forceInstall -- create symlink if this is the latest version and a regular install sVers <- lift $ fmap rights getInstalledStacks @@ -819,8 +831,9 @@ installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m) => FilePath -- ^ Path to the unpacked stack bindist (where the executable resides) -> FilePath -- ^ Path to install to -> Maybe Version -- ^ Nothing for isolated installs + -> Bool -- ^ Force install -> Excepts '[CopyError, FileAlreadyExistsError] m () -installStackUnpacked path inst mver' = do +installStackUnpacked path inst mver' forceInstall = do lift $ logInfo "Installing stack" let stackFile = "stack" liftIO $ createDirRecursive' inst @@ -829,7 +842,8 @@ installStackUnpacked path inst mver' = do <> exeExt destPath = inst destFileName - liftE $ throwIfFileAlreadyExists destPath + unless forceInstall + (liftE $ throwIfFileAlreadyExists destPath) handleIO (throwE . CopyError . show) $ liftIO $ copyFile (path stackFile <> exeExt) From cadb5086e1871010ec2129b833f342781bd3d15a Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sat, 11 Sep 2021 23:20:06 +0530 Subject: [PATCH 13/15] Implements --force install for GHC --- app/ghcup/BrickMain.hs | 2 +- app/ghcup/Main.hs | 12 +++++++---- lib/GHCup.hs | 45 +++++++++++++++++++++++++++++------------- 3 files changed, 40 insertions(+), 19 deletions(-) diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index 1316db6..6a1aad9 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -440,7 +440,7 @@ install' _ (_, ListResult {..}) = do case lTool of GHC -> do let vi = getVersionInfo lVer GHC dls - liftE $ installGHCBin lVer Nothing $> vi + liftE $ installGHCBin lVer Nothing False $> vi Cabal -> do let vi = getVersionInfo lVer Cabal dls liftE $ installCabalBin lVer Nothing False $> vi diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 4ad5d3c..75d6e13 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1737,7 +1737,10 @@ Report bugs at |] (case instBindist of Nothing -> runInstTool instPlatform $ do (v, vi) <- liftE $ fromVersion instVer GHC - liftE $ installGHCBin (_tvVersion v) isolateDir + liftE $ installGHCBin + (_tvVersion v) + isolateDir + forceInstall when instSet $ void $ liftE $ setGHC v SetGHCOnly pure vi Just uri -> do @@ -1745,9 +1748,10 @@ Report bugs at |] runInstTool' s'{ settings = settings {noVerify = True}} instPlatform $ do (v, vi) <- liftE $ fromVersion instVer GHC liftE $ installGHCBindist - (DownloadInfo uri (Just $ RegexDir "ghc-.*") "") - (_tvVersion v) - isolateDir + (DownloadInfo uri (Just $ RegexDir "ghc-.*") "") + (_tvVersion v) + isolateDir + forceInstall when instSet $ void $ liftE $ setGHC v SetGHCOnly pure vi ) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 8501d74..4b18208 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -184,6 +184,7 @@ installGHCBindist :: ( MonadFail m => DownloadInfo -- ^ where/how to download -> Version -- ^ the version to install -> Maybe FilePath -- ^ isolated filepath if user passed any + -> Bool -- ^ Force install -> Excepts '[ AlreadyInstalled , BuildFailed @@ -198,15 +199,26 @@ installGHCBindist :: ( MonadFail m ] m () -installGHCBindist dlinfo ver isoFilepath = do +installGHCBindist dlinfo ver isoFilepath forceInstall = do let tver = mkTVer ver lift $ logDebug $ "Requested to install GHC with " <> prettyVer 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 () + regularGHCInstalled <- lift $ checkIfToolInstalled GHC ver + + if + | not forceInstall + , regularGHCInstalled + , Nothing <- isoFilepath -> do + (throwE $ AlreadyInstalled GHC ver) + + | forceInstall + , regularGHCInstalled + , Nothing <- isoFilepath -> do + lift $ logInfo $ "Removing the currently installed GHC version first!" + liftE $ rmGHCVer tver + + | otherwise -> pure () -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing @@ -215,13 +227,13 @@ installGHCBindist dlinfo ver isoFilepath = do ghcdir <- lift $ ghcupGHCDir tver toolchainSanityChecks - + case isoFilepath of Just isoDir -> do -- isolated install lift $ logInfo $ "isolated installing GHC to " <> T.pack isoDir - liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver + liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver forceInstall Nothing -> do -- regular install - liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver + liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver forceInstall -- make symlinks & stuff when regular install, liftE $ postGHCInstall tver @@ -254,6 +266,7 @@ installPackedGHC :: ( MonadMask m -> Maybe TarDir -- ^ Subdir of the archive -> FilePath -- ^ Path to install to -> Version -- ^ The GHC version + -> Bool -- ^ Force install -> Excepts '[ BuildFailed , UnknownArchive @@ -261,10 +274,11 @@ installPackedGHC :: ( MonadMask m , DirNotEmpty , ArchiveResult ] m () -installPackedGHC dl msubdir inst ver = do +installPackedGHC dl msubdir inst ver forceInstall = do PlatformRequest {..} <- lift getPlatformReq - liftE $ installDestSanityCheck inst + unless forceInstall + (liftE $ installDestSanityCheck inst) -- unpack tmpUnpack <- lift mkGhcupTmpDir @@ -275,7 +289,7 @@ installPackedGHC dl msubdir inst ver = do workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) msubdir - + liftE $ runBuildAction tmpUnpack (Just inst) (installUnpackedGHC workdir inst ver) @@ -365,6 +379,7 @@ installGHCBin :: ( MonadFail m ) => Version -- ^ the version to install -> Maybe FilePath -- ^ isolated install filepath, if user passed any + -> Bool -- ^ force install -> Excepts '[ AlreadyInstalled , BuildFailed @@ -379,9 +394,9 @@ installGHCBin :: ( MonadFail m ] m () -installGHCBin ver isoFilepath = do +installGHCBin ver isoFilepath forceInstall = do dlinfo <- liftE $ getDownloadInfo GHC ver - installGHCBindist dlinfo ver isoFilepath + installGHCBindist dlinfo ver isoFilepath forceInstall -- | Like 'installCabalBin', except takes the 'DownloadInfo' as @@ -479,8 +494,9 @@ checkIfToolInstalled tool ver = do Cabal -> cabalInstalled ver HLS -> hlsInstalled ver Stack -> stackInstalled ver + GHC -> ghcInstalled $ mkTVer ver _ -> pure False - + -- | Install an unpacked cabal distribution.Symbol installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) @@ -1960,6 +1976,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had (Just $ RegexDir "ghc-.*") ghcdir (tver ^. tvVersion) + False -- not a force install, since we already overwrite when compiling. liftIO $ B.writeFile (ghcdir ghcUpSrcBuiltFile) bmk From 6011242eae424b049284e26916101067e869ce02 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sat, 11 Sep 2021 23:23:58 +0530 Subject: [PATCH 14/15] minor cleanup --- lib/GHCup.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 4b18208..92bc402 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -487,9 +487,7 @@ checkIfToolInstalled :: ( MonadIO m Version -> m Bool -checkIfToolInstalled tool ver = do - Dirs { binDir } <- getDirs - +checkIfToolInstalled tool ver = case tool of Cabal -> cabalInstalled ver HLS -> hlsInstalled ver From 8fc128e89b14602d062a649c7aa0d6f83ca023a0 Mon Sep 17 00:00:00 2001 From: Arjun Kathuria Date: Sun, 12 Sep 2021 09:24:04 +0530 Subject: [PATCH 15/15] move some code around for better consistency --- app/ghcup/Main.hs | 13 ++++++----- lib/GHCup.hs | 55 +++++++++++++++++++++++------------------------ 2 files changed, 35 insertions(+), 33 deletions(-) diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 75d6e13..452f336 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1783,17 +1783,20 @@ Report bugs at |] (case instBindist of Nothing -> runInstTool instPlatform $ do (v, vi) <- liftE $ fromVersion instVer Cabal - liftE $ installCabalBin (_tvVersion v) isolateDir forceInstall + liftE $ installCabalBin + (_tvVersion v) + isolateDir + forceInstall 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 - forceInstall + (DownloadInfo uri Nothing "") + (_tvVersion v) + isolateDir + forceInstall pure vi ) >>= \case diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 92bc402..99e4cba 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -441,17 +441,17 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do regularCabalInstalled <- lift $ checkIfToolInstalled Cabal ver if + | not forceInstall + , regularCabalInstalled + , Nothing <- isoFilepath -> do + throwE $ AlreadyInstalled Cabal ver + | forceInstall , regularCabalInstalled , Nothing <- isoFilepath -> do lift $ logInfo $ "Removing the currently installed version first!" liftE $ rmCabalVer ver - | not forceInstall - , regularCabalInstalled - , Nothing <- isoFilepath -> do - throwE $ AlreadyInstalled Cabal ver - | otherwise -> pure () @@ -479,22 +479,6 @@ installCabalBindist dlinfo ver isoFilepath forceInstall = do let lInstCabal = headMay . reverse . sort $ cVers when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver -checkIfToolInstalled :: ( MonadIO m - , MonadReader env m - , HasDirs env - , MonadCatch m) => - Tool -> - Version -> - m Bool - -checkIfToolInstalled tool ver = - case tool of - Cabal -> cabalInstalled ver - HLS -> hlsInstalled ver - Stack -> stackInstalled ver - GHC -> ghcInstalled $ mkTVer ver - _ -> pure False - -- | Install an unpacked cabal distribution.Symbol installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) @@ -598,17 +582,17 @@ installHLSBindist dlinfo ver isoFilepath forceInstall = do regularHLSInstalled <- lift $ checkIfToolInstalled HLS ver if - | forceInstall - , regularHLSInstalled - , Nothing <- isoFilepath -> do -- regular forced install - lift $ logInfo "Removing the currently installed version of HLS before force installing!" - liftE $ rmHLSVer ver - | not forceInstall , regularHLSInstalled - , Nothing <- isoFilepath -> do -- regular install + , Nothing <- isoFilepath -> do -- regular install throwE $ AlreadyInstalled HLS ver + | forceInstall + , regularHLSInstalled + , Nothing <- isoFilepath -> do -- regular forced install + lift $ logInfo "Removing the currently installed version of HLS before force installing!" + liftE $ rmHLSVer ver + | otherwise -> pure () -- download (or use cached version) @@ -2421,6 +2405,21 @@ whereIsTool tool ver@GHCTargetVersion {..} = do currentRunningExecPath <- liftIO getExecutablePath liftIO $ canonicalizePath currentRunningExecPath +checkIfToolInstalled :: ( MonadIO m + , MonadReader env m + , HasDirs env + , MonadCatch m) => + Tool -> + Version -> + m Bool + +checkIfToolInstalled tool ver = + case tool of + Cabal -> cabalInstalled ver + HLS -> hlsInstalled ver + Stack -> stackInstalled ver + GHC -> ghcInstalled $ mkTVer ver + _ -> pure False throwIfFileAlreadyExists :: ( MonadIO m ) => FilePath ->