Execute action only if inputs are valid + better UX

This commit is contained in:
Luis Morillo 2024-03-13 18:12:00 +01:00
parent cee4a0d610
commit 80a6c67cf3
3 changed files with 18 additions and 5 deletions

View File

@ -66,6 +66,7 @@ import Optics.State (use)
import Optics.State.Operators ((.=))
import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
import qualified GHCup.Brick.Widgets.Menus.CompileHLS as CompileHLS
import Control.Monad (when)
app :: AttrMap -> AttrMap -> App BrickState () Name
app attrs dimAttrs =
@ -174,7 +175,8 @@ compileGHCHandler ev = do
-> mode .= ContextPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
let iopts = ctx ^. Menu.menuStateL
Actions.withIOAction $ Actions.compileGHC iopts
when (Menu.isValidMenu ctx)
(Actions.withIOAction $ Actions.compileGHC iopts)
_ -> Common.zoom compileGHCMenu $ CompileGHC.handler ev
@ -193,7 +195,8 @@ compileHLSHandler ev = do
-> mode .= ContextPanel
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
let iopts = ctx ^. Menu.menuStateL
Actions.withIOAction $ Actions.compileHLS iopts
when (Menu.isValidMenu ctx)
(Actions.withIOAction $ Actions.compileHLS iopts)
_ -> Common.zoom compileHLSMenu $ CompileHLS.handler ev
eventHandler :: BrickEvent Name e -> EventM Name BrickState ()

View File

@ -93,7 +93,7 @@ idFormatter = const id
-- | An error message
type ErrorMessage = T.Text
data ErrorStatus = Valid | Invalid ErrorMessage
data ErrorStatus = Valid | Invalid ErrorMessage deriving (Eq)
-- | A lens which does nothing. Usefull to defined no-op fields
emptyLens :: Lens' s ()
@ -137,6 +137,8 @@ data MenuField s n where
, fieldName :: n
} -> MenuField s n
isValidField :: MenuField s n -> Bool
isValidField = (== Valid) . fieldStatus
makeLensesFor
[ ("fieldLabel", "fieldLabelL")
@ -226,7 +228,9 @@ type Button = MenuField
createButtonInput :: FieldInput () () n
createButtonInput = FieldInput () Right "" drawButton (const $ pure ())
where drawButton _ _ help _ amp = amp . centerV . renderAsHelpMsg $ help
where
drawButton True (Invalid err) _ _ amp = amp . centerV . renderAsErrMsg $ err
drawButton _ _ help _ amp = amp . centerV . renderAsHelpMsg $ help
createButtonField :: n -> Button s n
createButtonField = MenuField emptyLens createButtonInput "" Valid
@ -281,7 +285,6 @@ data Menu s n
, menuName :: n -- ^ The resource Name.
}
makeLensesFor
[ ("menuFields", "menuFieldsL"), ("menuState", "menuStateL")
, ("menuButtons", "menuButtonsL"), ("menuFocusRing", "menuFocusRingL")
@ -289,6 +292,9 @@ makeLensesFor
]
''Menu
isValidMenu :: Menu s n -> Bool
isValidMenu = all isValidField . menuFields
createMenu :: n -> s -> KeyCombination -> [Button s n] -> [MenuField s n] -> Menu s n
createMenu n initial exitK buttons fields = Menu fields initial buttons ring exitK n
where ring = F.focusRing $ [field & fieldName | field <- fields] ++ [button & fieldName | button <- buttons]
@ -307,6 +313,9 @@ handlerMenu ev =
Nothing -> pure ()
Just n -> do
updated_fields <- updateFields n (VtyEvent e) fields
if all isValidField updated_fields
then menuButtonsL %= fmap (fieldStatusL .~ Valid)
else menuButtonsL %= fmap (fieldStatusL .~ Invalid "Some fields are invalid")
menuFieldsL .= updated_fields
_ -> pure ()
where

View File

@ -196,6 +196,7 @@ create k = Menu.createMenu CompileGHCBox initialState k buttons fields
Menu.createButtonField (Common.MenuElement Common.OkButton)
& Menu.fieldLabelL .~ "Compile"
& Menu.fieldHelpMsgL .~ "Compile GHC from source with options below"
& Menu.fieldStatusL .~ Menu.Invalid "bootstrap GHC is mandatory"
]
handler :: BrickEvent Name e -> EventM Name CompileGHCMenu ()