From 6047614a16f04ba0d5f1d50046538d0ae5f7416a Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 12 Nov 2023 17:35:39 +0800
Subject: [PATCH] Be less confusing when user tries to 'set' ghcup in TUI

Fixes #923
---
 app/ghcup/BrickMain.hs | 37 +++++++++++++++++++++++++++++++++++--
 1 file changed, 35 insertions(+), 2 deletions(-)

diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs
index 66c851a..5afa2db 100644
--- a/app/ghcup/BrickMain.hs
+++ b/app/ghcup/BrickMain.hs
@@ -555,7 +555,35 @@ set' bs input@(_, ListResult {..}) = do
 
   let run =
         flip runReaderT settings
-          . runE @'[FileDoesNotExistError , NotInstalled , TagNotFound]
+          . runResourceT
+          . runE
+            @'[ AlreadyInstalled
+              , ArchiveResult
+              , UnknownArchive
+              , FileDoesNotExistError
+              , CopyError
+              , NoDownload
+              , NotInstalled
+              , BuildFailed
+              , TagNotFound
+              , DigestError
+              , ContentLengthError
+              , GPGError
+              , DownloadFailed
+              , DirNotEmpty
+              , NoUpdate
+              , TarDirDoesNotExist
+              , FileAlreadyExistsError
+              , ProcessError
+              , ToolShadowed
+              , UninstallFailed
+              , MergeFileTreeError
+              , NoCompatiblePlatform
+              , GHCup.Errors.ParseError
+              , UnsupportedSetupCombo
+              , DistroNotFound
+              , NoCompatibleArch
+              ]
 
   run (do
       case lTool of
@@ -563,7 +591,12 @@ set' bs input@(_, ListResult {..}) = do
         Cabal -> liftE $ setCabal lVer $> ()
         HLS   -> liftE $ setHLS lVer SetHLSOnly Nothing $> ()
         Stack -> liftE $ setStack lVer $> ()
-        GHCup -> pure ()
+        GHCup -> do
+          promptAnswer <- getUserPromptResponse "Switching GHCup versions is not supported.\nDo you want to install the latest version? [Y/N]: "
+          case promptAnswer of
+                PromptYes -> do
+                  void $ liftE $ upgradeGHCup Nothing False False
+                PromptNo -> pure ()
     )
     >>= \case
           VRight _ -> pure $ Right ()