Merge remote-tracking branch 'origin/pr/1102'

lib-opt/GHCup/OptParse/Compile.hs

@@ -218,7 +218,7 @@ ghcCompileOpts =
           (  long "hadrian-ghc"
           <> metavar "HADRIAN_GHC"
           <> help
-               "The GHC version (or full path) to GHC that will be used to compile hadrian (must be installed)"
+               "The GHC version (or full path) that will be used to compile hadrian (must be installed)"
           <> (completer $ versionCompleter [] GHC)
           ))
     <*> optional

lib-tui/GHCup/Brick/Actions.hs

@@ -30,6 +30,7 @@ import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
 import           GHCup.Brick.Widgets.Navigation (BrickInternalState)
 import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
 import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
+import           GHCup.Brick.Widgets.Menu (MenuKeyBindings(..))
 
 import qualified Brick
 import qualified Brick.Widgets.List as L
@@ -714,14 +715,14 @@ keyHandlers KeyBindings {..} =
  where
   createMenuforTool = do
     e <- use (appState % to sectionListSelectedElement)
-    let exitKey = KeyCombination (Vty.KChar 'c') [Vty.MCtrl]
     case e of
       Nothing     -> pure ()
       Just (_, r) -> do
         -- Create new ContextMenu, but maintain the state of Install/Compile
         -- menus. This is especially useful in case the user made a typo and
         -- would like to retry the action.
-        contextMenu .= ContextMenu.create r exitKey
+        contextMenu .= ContextMenu.create r
+          (MenuKeyBindings { mKbUp = bUp, mKbDown = bDown, mKbQuit = bQuit})
         -- Set mode to context
         mode           .= ContextPanel
     pure ()

lib-tui/GHCup/Brick/App.hs

@@ -35,7 +35,8 @@ import qualified GHCup.Brick.Widgets.Tutorial as Tutorial
 import qualified GHCup.Brick.Widgets.Menu as Menu
 import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
 
-import GHCup.Types (AppState (AppState, keyBindings), KeyCombination (KeyCombination))
+import GHCup.List (ListResult)
+import GHCup.Types (AppState (AppState, keyBindings), KeyCombination (KeyCombination), KeyBindings (..))
 
 import qualified Brick.Focus as F
 import Brick (
@@ -48,7 +49,7 @@ import Brick (
  )
 import qualified Brick
 import Control.Monad.Reader (
-  MonadIO (liftIO),
+  MonadIO (liftIO), ReaderT,
   void,
  )
 import Data.IORef (readIORef)
@@ -59,6 +60,7 @@ import qualified Graphics.Vty as Vty
 
 import qualified Data.Text as T
 
+import Optics (Lens')
 import Optics.Getter (to)
 import Optics.Operators ((^.))
 import Optics.Optic ((%))
@@ -91,26 +93,31 @@ drawUI dimAttrs st =
     navg = Navigation.draw dimAttrs (st ^. appState) <=> footer
   in case st ^. mode of
        Navigation   -> [navg]
-       Tutorial     -> [Tutorial.draw, navg]
+       Tutorial     -> [Tutorial.draw (bQuit $ st ^. appKeys), navg]
        KeyInfo      -> [KeyInfo.draw (st ^. appKeys), navg]
        ContextPanel -> [ContextMenu.draw (st ^. contextMenu), navg]
-       AdvanceInstallPanel -> [AdvanceInstall.draw (st ^. advanceInstallMenu), navg]
-       CompileGHCPanel     -> [CompileGHC.draw (st ^. compileGHCMenu), navg]
-       CompileHLSPanel     -> [CompileHLS.draw (st ^. compileHLSMenu), navg]
+       AdvanceInstallPanel -> AdvanceInstall.draw (st ^. advanceInstallMenu) ++ [navg]
+       CompileGHCPanel     -> CompileGHC.draw (st ^. compileGHCMenu) ++ [navg]
+       CompileHLSPanel     -> CompileHLS.draw (st ^. compileHLSMenu) ++ [navg]
 
 -- | On q, go back to navigation.
 --   On Enter, to go to tutorial
 keyInfoHandler :: BrickEvent Name e -> EventM Name BrickState ()
-keyInfoHandler ev = case ev of
-  VtyEvent (Vty.EvKey (Vty.KChar 'c') [Vty.MCtrl]) -> mode .= Navigation
-  VtyEvent (Vty.EvKey Vty.KEnter _ )   -> mode .= Tutorial
-  _ -> pure ()
+keyInfoHandler ev = do
+  AppState { keyBindings = kb } <- liftIO $ readIORef Actions.settings'
+  case ev of
+    VtyEvent (Vty.EvKey Vty.KEnter _ )   -> mode .= Tutorial
+    VtyEvent (Vty.EvKey key mods)
+      | bQuit kb == KeyCombination key mods -> mode .= Navigation
+    _ -> pure ()
 
 -- | On q, go back to navigation. Else, do nothing
 tutorialHandler :: BrickEvent Name e -> EventM Name BrickState ()
-tutorialHandler ev =
+tutorialHandler ev = do
+  AppState { keyBindings = kb } <- liftIO $ readIORef Actions.settings'
   case ev of
-    VtyEvent (Vty.EvKey (Vty.KChar 'c') [Vty.MCtrl]) -> mode .= Navigation
+    VtyEvent (Vty.EvKey key mods)
+      | bQuit kb == KeyCombination key mods -> mode .= Navigation
     _ -> pure ()
 
 -- | Tab/Arrows to navigate.
@@ -128,7 +135,7 @@ contextMenuHandler :: BrickEvent Name e -> EventM Name BrickState ()
 contextMenuHandler ev = do
   ctx <- use contextMenu
   let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
-      (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
+      (KeyCombination exitKey mods) = ctx ^. Menu.menuKeyBindingsL % Menu.mKbQuitL
   case (ev, focusedElement) of
     (_ , Nothing) -> pure ()
     (VtyEvent (Vty.EvKey k m), Just n) |  k == exitKey && m == mods -> mode .= Navigation
@@ -138,47 +145,35 @@ contextMenuHandler ev = do
     _ -> Common.zoom contextMenu $ ContextMenu.handler ev
 --
 advanceInstallHandler :: BrickEvent Name e -> EventM Name BrickState ()
-advanceInstallHandler ev = do
-  ctx <- use advanceInstallMenu
-  let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
-      (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
-  case (ev, focusedElement) of
-    (_ , Nothing) -> pure ()
-    (VtyEvent (Vty.EvKey k m), Just n) | k == exitKey && m == mods -> mode .= ContextPanel
-    (VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
-        let iopts = ctx ^. Menu.menuStateL
-        when (Menu.isValidMenu ctx) $
-          Actions.withIOAction $ Actions.installWithOptions iopts
-    _ -> Common.zoom advanceInstallMenu $ AdvanceInstall.handler ev
+advanceInstallHandler = menuWithOverlayHandler advanceInstallMenu Actions.installWithOptions AdvanceInstall.handler
 
 compileGHCHandler :: BrickEvent Name e -> EventM Name BrickState ()
-compileGHCHandler ev = do
-  ctx <- use compileGHCMenu
-  let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
-      (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
-  case (ev, focusedElement) of
-    (_ , Nothing) -> pure ()
-    (VtyEvent (Vty.EvKey k m), Just n) | k == exitKey && m == mods -> mode .= ContextPanel
-    (VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
-        let iopts = ctx ^. Menu.menuStateL
-        when (Menu.isValidMenu ctx)
-          (Actions.withIOAction $ Actions.compileGHC iopts)
-    _ -> Common.zoom compileGHCMenu $ CompileGHC.handler ev
-
+compileGHCHandler = menuWithOverlayHandler compileGHCMenu Actions.compileGHC CompileGHC.handler
 
 compileHLSHandler :: BrickEvent Name e -> EventM Name BrickState ()
-compileHLSHandler ev = do
-  ctx <- use compileHLSMenu
+compileHLSHandler = menuWithOverlayHandler compileHLSMenu Actions.compileHLS CompileHLS.handler
+
+-- | Passes all events to innerHandler if an overlay is opened
+-- else handles the exitKey and Enter key for the Menu's "OkButton"
+menuWithOverlayHandler :: Lens' BrickState (Menu.Menu t Name)
+  -> (t -> ((Int, ListResult) -> ReaderT AppState IO (Either String a)))
+  -> (BrickEvent Name e -> EventM Name (Menu.Menu t Name) ())
+  -> BrickEvent Name e
+  -> EventM Name BrickState ()
+menuWithOverlayHandler accessor action innerHandler ev = do
+  ctx <- use accessor
   let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
-      (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
-  case (ev, focusedElement) of
-    (_ , Nothing) -> pure ()
-    (VtyEvent (Vty.EvKey k m), Just n) | k == exitKey && m == mods -> mode .= ContextPanel
-    (VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
+      focusedField = (\n -> find (\x -> Brick.getName x == n) $ ctx ^. Menu.menuFieldsL) =<< focusedElement
+      (KeyCombination exitKey mods) = ctx ^. Menu.menuKeyBindingsL % Menu.mKbQuitL
+  case (ev, focusedElement, Menu.drawFieldOverlay =<< focusedField) of
+    (_ , Nothing, _) -> pure ()
+    (_ , _, Just _) -> Common.zoom accessor $ innerHandler ev
+    (VtyEvent (Vty.EvKey k m), Just n, _) | k == exitKey && m == mods -> mode .= ContextPanel
+    (VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton), _) -> do
         let iopts = ctx ^. Menu.menuStateL
         when (Menu.isValidMenu ctx)
-          (Actions.withIOAction $ Actions.compileHLS iopts)
-    _ -> Common.zoom compileHLSMenu $ CompileHLS.handler ev
+          (Actions.withIOAction $ action iopts)
+    _ -> Common.zoom accessor $ innerHandler ev
 
 eventHandler :: BrickEvent Name e -> EventM Name BrickState ()
 eventHandler ev = do

lib-tui/GHCup/Brick/Attributes.hs

@@ -40,7 +40,7 @@ defaultAttributes no_color = Brick.attrMap
   , (dayAttr                   , Vty.defAttr `withForeColor` Vty.brightCyan)
   , (helpAttr                  , Vty.defAttr `withStyle`     Vty.italic)
   , (hoorayAttr                , Vty.defAttr `withForeColor` Vty.brightWhite)
-  , (helpMsgAttr               , Vty.defAttr `withForeColor` Vty.brightBlack)
+  , (helpMsgAttr               , Vty.defAttr `withForeColor` Vty.yellow)
   , (errMsgAttr                , Vty.defAttr `withForeColor` Vty.red)
   ]
   where

lib-tui/GHCup/Brick/Common.hs

@@ -48,6 +48,7 @@ module GHCup.Brick.Common  (
     , BuildFlavourEditBox, BuildSystemEditBox, OkButton, AdvanceInstallButton
     , CompileGHCButton, CompileHLSButton, CabalProjectEditBox
     , CabalProjectLocalEditBox, UpdateCabalCheckBox, GitRefEditBox
+    , BootstrapGhcSelectBox, HadrianGhcSelectBox
   ) ) where
 
 import           GHCup.List ( ListResult )
@@ -98,7 +99,7 @@ pattern TargetGhcEditBox = ResourceId 6
 pattern BootstrapGhcEditBox :: ResourceId
 pattern BootstrapGhcEditBox = ResourceId 7
 pattern HadrianGhcEditBox :: ResourceId
-pattern HadrianGhcEditBox = ResourceId 17
+pattern HadrianGhcEditBox = ResourceId 20
 pattern JobsEditBox :: ResourceId
 pattern JobsEditBox = ResourceId 8
 pattern BuildConfigEditBox :: ResourceId
@@ -126,6 +127,11 @@ pattern UpdateCabalCheckBox  = ResourceId 18
 pattern GitRefEditBox  :: ResourceId
 pattern GitRefEditBox  = ResourceId 19
 
+pattern BootstrapGhcSelectBox :: ResourceId
+pattern BootstrapGhcSelectBox = ResourceId 21
+pattern HadrianGhcSelectBox :: ResourceId
+pattern HadrianGhcSelectBox = ResourceId 22
+
 -- | Name data type. Uniquely identifies each widget in the TUI.
 -- some constructors might end up unused, but still is a good practise
 -- to have all of them defined, just in case

lib-tui/GHCup/Brick/Widgets/KeyInfo.hs

@@ -69,4 +69,4 @@ draw KeyBindings {..} =
             ]
           ]
         ]
-      <=> Brick.hBox [Brick.txt "Press c+ctrl to return to Navigation" <+> Brick.padRight Brick.Max (Brick.txt " ") <+> Brick.txt "Press Enter to go to the Tutorial"]
+      <=> Brick.hBox [Brick.txt "Press " <+> Common.keyToWidget bQuit <+> Brick.txt " to return to Navigation" <+> Brick.padRight Brick.Max (Brick.txt " ") <+> Brick.txt "Press Enter to go to the Tutorial"]