Show confirmation prompt for pre-install messages in TUI

Author: dfordivam

lib-tui/GHCup/Brick/Actions.hs

@@ -142,6 +142,27 @@ suspendBrickAndRunAction s action = do
       Right _   -> liftIO $ putStrLn "Success"
 
 
+getPreInstallMessage :: AppState -> GHCTargetVersion -> Tool -> Maybe T.Text
+getPreInstallMessage s v lTool =
+  let
+    dls = _ghcupDownloads $ ghcupInfo s
+  in case lTool of
+    GHC   -> do
+      let vi = getVersionInfo v GHC dls
+      (_viPreInstall =<< vi)
+    Cabal -> do
+      let vi = getVersionInfo v Cabal dls
+      (_viPreInstall =<< vi)
+    GHCup -> do
+      let vi = snd <$> getLatest dls GHCup
+      (_viPreInstall =<< vi)
+    HLS   -> do
+      let vi = getVersionInfo v HLS dls
+      (_viPreInstall =<< vi)
+    Stack -> do
+      let vi = getVersionInfo v Stack dls
+      (_viPreInstall =<< vi)
+
 installWithOptions :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
          => AdvanceInstall.InstallOptions
          -> ListResult
@@ -200,11 +221,6 @@ installWithOptions opts ListResult {..} = do
       case lTool of
         GHC   -> do
           let vi = getVersionInfo v GHC dls
-          forM_ (_viPreInstall =<< vi) $ \msg -> do
-            lift $ logWarn msg
-            lift $ logWarn
-              "...waiting for 5 seconds, you can still abort..."
-            liftIO $ threadDelay 5000000 -- give the user a sec to intervene
           case opts ^. AdvanceInstall.instBindist of
             Nothing -> do
               liftE $
@@ -228,11 +244,6 @@ installWithOptions opts ListResult {..} = do
 
         Cabal -> do
           let vi = getVersionInfo v Cabal dls
-          forM_ (_viPreInstall =<< vi) $ \msg -> do
-            lift $ logWarn msg
-            lift $ logWarn
-              "...waiting for 5 seconds, you can still abort..."
-            liftIO $ threadDelay 5000000 -- give the user a sec to intervene
           case opts ^. AdvanceInstall.instBindist of
             Nothing -> do
               liftE $
@@ -249,19 +260,9 @@ installWithOptions opts ListResult {..} = do
 
         GHCup -> do
           let vi = snd <$> getLatest dls GHCup
-          forM_ (_viPreInstall =<< vi) $ \msg -> do
-            lift $ logWarn msg
-            lift $ logWarn
-              "...waiting for 5 seconds, you can still abort..."
-            liftIO $ threadDelay 5000000 -- give the user a sec to intervene
           liftE $ upgradeGHCup Nothing False False $> (vi, dirs, ce)
         HLS   -> do
           let vi = getVersionInfo v HLS dls
-          forM_ (_viPreInstall =<< vi) $ \msg -> do
-            lift $ logWarn msg
-            lift $ logWarn
-              "...waiting for 5 seconds, you can still abort..."
-            liftIO $ threadDelay 5000000 -- give the user a sec to intervene
           case opts ^. AdvanceInstall.instBindist of
             Nothing -> do
               liftE $

lib-tui/GHCup/Brick/App/AdvanceInstallMenu.hs

@@ -7,13 +7,14 @@
 module GHCup.Brick.App.AdvanceInstallMenu where
 
 import GHCup.List ( ListResult (..))
-import GHCup.Types (GHCTargetVersion(..), KeyBindings, AppState)
+import GHCup.Types (GHCTargetVersion(..), KeyBindings, AppState, bQuit)
 import GHCup.Brick.Widgets.BaseWidget
 import GHCup.Brick.Widgets.BasicOverlay
 import GHCup.Brick.Widgets.InputField.Class
 import GHCup.Brick.Widgets.InputField.CheckBox
 import GHCup.Brick.Widgets.InputField.EditInput as EditInput
-import GHCup.Brick.Widgets.GenericMenu
+import GHCup.Brick.Widgets.GenericMenu as GenericMenu
+import qualified GHCup.Brick.Widgets.ConfirmationPrompt as ConfirmationPrompt
 import qualified GHCup.Brick.Actions as Actions
 import qualified GHCup.Brick.App.Common as Common
 import GHCup.Brick.App.AdvanceInstallOptions
@@ -32,11 +33,13 @@ import           Control.Monad (when, forM, forM_, void)
 import Data.Bifunctor (Bifunctor(..))
 import Data.Char (isSpace)
 import Data.List.NonEmpty             ( NonEmpty (..) )
+import           Data.Maybe
 import Data.Some
 import qualified Data.Text                     as T
 import GHC.Generics (Generic)
 import           Prelude                 hiding ( appendFile )
 import qualified Graphics.Vty as Vty
+import Optics (lens, (^.))
 import Optics.State.Operators ((.=), (?=))
 import Optics.TH (makeLenses)
 import URI.ByteString (URI)
@@ -61,7 +64,16 @@ create kb lr s = mkGenericMenu
   menuFields
   validateInputs
   (s, lr)
-  (\(s, lr) opts -> (Just CloseAllOverlays) <$ (Actions.suspendBrickAndRunAction s $ Actions.installWithOptions opts lr))
+  (\(s, lr) opts -> do
+      let action = (Just CloseAllOverlays) <$ (Actions.suspendBrickAndRunAction s $ Actions.installWithOptions opts lr)
+          v = fromMaybe (GHCTargetVersion (lCross lr) (lVer lr)) (opts ^. instVersion)
+      case Actions.getPreInstallMessage s v (lTool lr) of
+        Nothing -> action
+        Just msg -> do
+          let prompt = ConfirmationPrompt.create "Warning" msg action (bQuit kb)
+          GenericMenu.overlay ?= Some (IsSubWidget $ lens (const prompt) (\s _ -> s))
+          pure Nothing
+  )
   (Common.toMenuKeyBindings kb)
   "Advance Install"
   (Button (Common.MenuElement Common.OkButton)

lib-tui/GHCup/Brick/App/Navigation.hs

@@ -14,6 +14,7 @@ import qualified GHCup.Brick.App.ContextMenu as ContextMenu
 import GHCup.Brick.Widgets.BaseWidget
 import GHCup.Brick.Widgets.BasicOverlay
 import qualified GHCup.Brick.Attributes as Attributes
+import qualified GHCup.Brick.Widgets.ConfirmationPrompt as ConfirmationPrompt
 import qualified GHCup.Brick.Widgets.SectionList as SectionList
 
 import GHCup.List ( ListResult(..) )
@@ -47,7 +48,7 @@ import Control.Monad.Reader
 import Data.Some
 import Data.Vector ( Vector )
 import qualified Graphics.Vty as Vty
-import Optics (Lens', use, to, (^.), (%), (&), (%~), (.~))
+import Optics (Lens', lens, use, to, (^.), (%), (&), (%~), (.~))
 import Optics.TH (makeLenses)
 import Optics.State.Operators ((.=), (?=), (%=))
 
@@ -255,7 +256,7 @@ keyHandlers :: KeyBindings
                ]
 keyHandlers KeyBindings {..} =
   [ (bQuit, const "Quit"     , Brick.halt)
-  , (bInstall, const "Install"  , withIOAction' install')
+  , (bInstall, const "Install"  , installAfterPreInstallPrompt)
   , (bUninstall, const "Uninstall", withIOAction' del')
   , (bSet, const "Set"      , withIOAction' set')
   , (bChangelog, const "ChangeLog", withIOAction' changelog')
@@ -278,6 +279,22 @@ keyHandlers KeyBindings {..} =
         suspendBrickAndRunAction _appState $ action (curr_ix, e)
     updateNavigation
 
+  installAfterPreInstallPrompt = do
+    Navigation {..} <- Brick.get
+    case SectionList.sectionListSelectedElement _sectionList of
+      Nothing      -> pure ()
+      Just (curr_ix, lr) -> do
+        let action = (Just CloseAllOverlays) <$ suspendBrickAndRunAction _appState (install' (curr_ix, lr))
+            v = GHCTargetVersion (lCross lr) (lVer lr)
+        case getPreInstallMessage _appState v (lTool lr) of
+          Nothing -> do
+            action
+            updateNavigation
+          Just msg -> do
+            let prompt = ConfirmationPrompt.create "Warning" msg action bQuit
+            -- updateNavigation will happen after the prompt is closed
+            overlay ?= Some (IsSubWidget $ lens (const prompt) (\s _ -> s))
+
   openContextMenuforTool = do
     e <- use (sectionList % to SectionList.sectionListSelectedElement)
     case e of