Execute action only if inputs are valid + better UX
This commit is contained in:
parent
cee4a0d610
commit
80a6c67cf3
@ -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 ()
|
||||
|
@ -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
|
||||
|
@ -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 ()
|
||||
|
Loading…
Reference in New Issue
Block a user