makes ctrl+c the shourtcut to exit menus + fix trailing new line in editor

2024-03-17 09:47:03 +01:00 · 2024-03-17 09:47:03 +01:00 · b375398416
commit b375398416
parent 04b29b0b98
7 changed files with 21 additions and 38 deletions
--- a/lib-tui/GHCup/Brick/Actions.hs
+++ b/lib-tui/GHCup/Brick/Actions.hs
@ -702,14 +702,15 @@ 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 menus
-        contextMenu .= ContextMenu.create r bQuit
-        advanceInstallMenu .= AdvanceInstall.create bQuit
-        compileGHCMenu .= CompileGHC.create bQuit
-        compileHLSMenu .= CompileHLS.create bQuit
+        contextMenu .= ContextMenu.create r exitKey
+        advanceInstallMenu .= AdvanceInstall.create exitKey
+        compileGHCMenu .= CompileGHC.create exitKey
+        compileHLSMenu .= CompileHLS.create exitKey
        -- Set mode to context
        mode           .= ContextPanel
    pure ()
--- a/lib-tui/GHCup/Brick/App.hs
+++ b/lib-tui/GHCup/Brick/App.hs
@ -102,7 +102,7 @@ drawUI dimAttrs st =
 --   On Enter, to go to tutorial
 keyInfoHandler :: BrickEvent Name e -> EventM Name BrickState ()
 keyInfoHandler ev = case ev of
-  VtyEvent (Vty.EvKey (Vty.KChar 'q') _ ) -> mode .= Navigation
+  VtyEvent (Vty.EvKey (Vty.KChar 'c') [Vty.MCtrl]) -> mode .= Navigation
  VtyEvent (Vty.EvKey Vty.KEnter _ )   -> mode .= Tutorial
  _ -> pure ()

@ -110,7 +110,7 @@ keyInfoHandler ev = case ev of
 tutorialHandler :: BrickEvent Name e -> EventM Name BrickState ()
 tutorialHandler ev =
  case ev of
-    VtyEvent (Vty.EvKey (Vty.KChar 'q') _ ) -> mode .= Navigation
+    VtyEvent (Vty.EvKey (Vty.KChar 'c') [Vty.MCtrl]) -> mode .= Navigation
    _ -> pure ()

 -- | Tab/Arrows to navigate.
@ -128,15 +128,10 @@ contextMenuHandler :: BrickEvent Name e -> EventM Name BrickState ()
 contextMenuHandler ev = do
  ctx <- use contextMenu
  let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
-      buttons = ctx ^. Menu.menuButtonsL
      (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
  case (ev, focusedElement) of
    (_ , Nothing) -> pure ()
-    (VtyEvent (Vty.EvKey k m), Just n)
-      |  k == exitKey
-          && m == mods
-          && n `elem` [Menu.fieldName button | button <- buttons]
-      -> mode .= Navigation
+    (VtyEvent (Vty.EvKey k m), Just n) |  k == exitKey && m == mods -> mode .= Navigation
    (VtyEvent (Vty.EvKey Vty.KEnter []),  Just (Common.MenuElement Common.AdvanceInstallButton) ) -> mode .= Common.AdvanceInstallPanel
    (VtyEvent (Vty.EvKey Vty.KEnter []),  Just (Common.MenuElement Common.CompileGHCButton) ) -> mode .= Common.CompileGHCPanel
    (VtyEvent (Vty.EvKey Vty.KEnter []),  Just (Common.MenuElement Common.CompileHLSButton) ) -> mode .= Common.CompileHLSPanel
@ -146,15 +141,10 @@ advanceInstallHandler :: BrickEvent Name e -> EventM Name BrickState ()
 advanceInstallHandler ev = do
  ctx <- use advanceInstallMenu
  let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
-      buttons = ctx ^. Menu.menuButtonsL
      (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
  case (ev, focusedElement) of
    (_ , Nothing) -> pure ()
-    (VtyEvent (Vty.EvKey k m), Just n)
-        | k == exitKey
-            && m == mods
-            && n `elem` [Menu.fieldName button | button <- buttons]
-        -> mode .= ContextPanel
+    (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
        Actions.withIOAction $ Actions.installWithOptions iopts
@ -164,15 +154,10 @@ compileGHCHandler :: BrickEvent Name e -> EventM Name BrickState ()
 compileGHCHandler ev = do
  ctx <- use compileGHCMenu
  let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
-      buttons = ctx ^. Menu.menuButtonsL
      (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
  case (ev, focusedElement) of
    (_ , Nothing) -> pure ()
-    (VtyEvent (Vty.EvKey k m), Just n)
-      | k == exitKey
-          && m == mods
-          && n `elem` [Menu.fieldName button | button <- buttons]
-      -> mode .= ContextPanel
+    (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)
@ -184,15 +169,10 @@ compileHLSHandler :: BrickEvent Name e -> EventM Name BrickState ()
 compileHLSHandler ev = do
  ctx <- use compileHLSMenu
  let focusedElement = ctx ^. Menu.menuFocusRingL % to F.focusGetCurrent
-      buttons = ctx ^. Menu.menuButtonsL
      (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
  case (ev, focusedElement) of
    (_ , Nothing) -> pure ()
-    (VtyEvent (Vty.EvKey k m), Just n)
-      | k == exitKey
-          && m == mods
-          && n `elem` [Menu.fieldName button | button <- buttons]
-      -> mode .= ContextPanel
+    (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)
--- a/lib-tui/GHCup/Brick/Widgets/KeyInfo.hs
+++ b/lib-tui/GHCup/Brick/Widgets/KeyInfo.hs
@ -69,4 +69,4 @@ draw KeyBindings {..} =
            ]
          ]
        ]
-      <=> Brick.hBox [Brick.txt "Press q to return to Navigation" <+> Brick.padRight Brick.Max (Brick.txt " ") <+> Brick.txt "Press Enter to go to the Tutorial"]
+      <=> 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"]
--- a/lib-tui/GHCup/Brick/Widgets/Menu.hs
+++ b/lib-tui/GHCup/Brick/Widgets/Menu.hs
@ -212,7 +212,7 @@ createEditableInput name validator = FieldInput initEdit validateEditContent ""
             | focus && isEditorEmpty -> borderBox $ renderAsHelpMsg help
             | focus     -> borderBox editorRender
             | otherwise -> borderBox $ renderAsErrMsg msg
-    validateEditContent = validator . T.unlines . Edit.getEditContents
+    validateEditContent = validator . T.init . T.unlines . Edit.getEditContents
    initEdit = Edit.editorText name (Just 1) ""

 createEditableField :: (Eq n, Ord n, Show n) => n -> (T.Text -> Either ErrorMessage a) -> Lens' s a  -> EditableField s n
@ -319,6 +319,7 @@ handlerMenu ev =
          menuFieldsL .= updated_fields
    _ -> pure ()
 where
+  -- runs the Event with the inner handler of MenuField.
  updateFields :: n -> BrickEvent n () -> [MenuField s n] -> EventM n (Menu s n) [MenuField s n]
  updateFields n e [] = pure []
  updateFields n e (x@(MenuField {fieldInput = i@(FieldInput {..}) , ..}):xs) =
--- a/lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs
+++ b/lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs
@ -103,7 +103,7 @@ create k = Menu.createMenu CompileGHCBox initialState k buttons fields
    bootstrapV i =
      case not $ emptyEditor i of
        True  ->
-          let readVersion = bimap (const "Not a valid version") Left (version (T.init i)) -- Brick adds \n at the end, hence T.init
+          let readVersion = bimap (const "Not a valid version") Left (version i)
              readPath = do
                mfilepath <- filepathV i
                case mfilepath of
@ -115,7 +115,7 @@ create k = Menu.createMenu CompileGHCBox initialState k buttons fields
        False -> Left "Invalid Empty value"

    versionV :: T.Text -> Either Menu.ErrorMessage (Maybe [VersionPattern])
-    versionV = whenEmpty Nothing (bimap T.pack Just . OptParse.overWriteVersionParser . T.unpack . T.init)  -- Brick adds \n at the end, hence T.init
+    versionV = whenEmpty Nothing (bimap T.pack Just . OptParse.overWriteVersionParser . T.unpack)

    jobsV :: T.Text -> Either Menu.ErrorMessage (Maybe Int)
    jobsV =
--- a/lib-tui/GHCup/Brick/Widgets/Tutorial.hs
+++ b/lib-tui/GHCup/Brick/Widgets/Tutorial.hs
@ -74,4 +74,4 @@ draw =
              ]
            , Brick.txt " "
            ])
-        <=> Brick.padRight Brick.Max (Brick.txt "Press q to exit the tutorial")
+        <=> Brick.padRight Brick.Max (Brick.txt "Press c+ctrl to exit the tutorial")
--- a/lib-tui/GHCup/BrickMain.hs
+++ b/lib-tui/GHCup/BrickMain.hs
@ -17,7 +17,7 @@ module GHCup.BrickMain where

 import GHCup.Types
    ( Settings(noColor),
-      AppState(ghcupInfo, settings, keyBindings, loggerConfig), KeyBindings (..) )
+      AppState(ghcupInfo, settings, keyBindings, loggerConfig), KeyBindings (..), KeyCombination (KeyCombination) )
 import GHCup.Prelude.Logger ( logError )
 import qualified GHCup.Brick.Actions as Actions
 import qualified GHCup.Brick.Common as Common
@ -29,6 +29,7 @@ import qualified GHCup.Brick.Widgets.SectionList as Navigation
 import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
 import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
 import qualified Brick
+import qualified Graphics.Vty as Vty

 import Control.Monad.Reader ( ReaderT(runReaderT) )
 import Data.Functor ( ($>) )
@ -51,7 +52,7 @@ brickMain s = do
    Right ad -> do
      let initial_list = Actions.constructList ad Common.defaultAppSettings Nothing
          current_element = Navigation.sectionListSelectedElement initial_list
-          exit_key = bQuit . keyBindings $ s
+          exit_key = KeyCombination (Vty.KChar 'c') [Vty.MCtrl] -- bQuit . keyBindings $ s
      case current_element of
        Nothing -> do
          flip runReaderT s $ logError "Error building app state: empty ResultList"
@ -66,7 +67,7 @@ brickMain s = do
                      Common.defaultAppSettings
                      initial_list
                      (ContextMenu.create e exit_key)
-                      (AdvanceInstall.create (bQuit . keyBindings $ s ))
+                      (AdvanceInstall.create exit_key)
                      (CompileGHC.create exit_key)
                      (CompileHLS.create exit_key)
                      (keyBindings s)