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 Optics.State.Operators ((.=))
|
||||||
import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
|
import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
|
||||||
import qualified GHCup.Brick.Widgets.Menus.CompileHLS as CompileHLS
|
import qualified GHCup.Brick.Widgets.Menus.CompileHLS as CompileHLS
|
||||||
|
import Control.Monad (when)
|
||||||
|
|
||||||
app :: AttrMap -> AttrMap -> App BrickState () Name
|
app :: AttrMap -> AttrMap -> App BrickState () Name
|
||||||
app attrs dimAttrs =
|
app attrs dimAttrs =
|
||||||
@ -174,7 +175,8 @@ compileGHCHandler ev = do
|
|||||||
-> mode .= ContextPanel
|
-> mode .= ContextPanel
|
||||||
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
|
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
|
||||||
let iopts = ctx ^. Menu.menuStateL
|
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
|
_ -> Common.zoom compileGHCMenu $ CompileGHC.handler ev
|
||||||
|
|
||||||
|
|
||||||
@ -193,7 +195,8 @@ compileHLSHandler ev = do
|
|||||||
-> mode .= ContextPanel
|
-> mode .= ContextPanel
|
||||||
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
|
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (MenuElement Common.OkButton)) -> do
|
||||||
let iopts = ctx ^. Menu.menuStateL
|
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
|
_ -> Common.zoom compileHLSMenu $ CompileHLS.handler ev
|
||||||
|
|
||||||
eventHandler :: BrickEvent Name e -> EventM Name BrickState ()
|
eventHandler :: BrickEvent Name e -> EventM Name BrickState ()
|
||||||
|
@ -93,7 +93,7 @@ idFormatter = const id
|
|||||||
|
|
||||||
-- | An error message
|
-- | An error message
|
||||||
type ErrorMessage = T.Text
|
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
|
-- | A lens which does nothing. Usefull to defined no-op fields
|
||||||
emptyLens :: Lens' s ()
|
emptyLens :: Lens' s ()
|
||||||
@ -137,6 +137,8 @@ data MenuField s n where
|
|||||||
, fieldName :: n
|
, fieldName :: n
|
||||||
} -> MenuField s n
|
} -> MenuField s n
|
||||||
|
|
||||||
|
isValidField :: MenuField s n -> Bool
|
||||||
|
isValidField = (== Valid) . fieldStatus
|
||||||
|
|
||||||
makeLensesFor
|
makeLensesFor
|
||||||
[ ("fieldLabel", "fieldLabelL")
|
[ ("fieldLabel", "fieldLabelL")
|
||||||
@ -226,7 +228,9 @@ type Button = MenuField
|
|||||||
|
|
||||||
createButtonInput :: FieldInput () () n
|
createButtonInput :: FieldInput () () n
|
||||||
createButtonInput = FieldInput () Right "" drawButton (const $ pure ())
|
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 :: n -> Button s n
|
||||||
createButtonField = MenuField emptyLens createButtonInput "" Valid
|
createButtonField = MenuField emptyLens createButtonInput "" Valid
|
||||||
@ -281,7 +285,6 @@ data Menu s n
|
|||||||
, menuName :: n -- ^ The resource Name.
|
, menuName :: n -- ^ The resource Name.
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
makeLensesFor
|
makeLensesFor
|
||||||
[ ("menuFields", "menuFieldsL"), ("menuState", "menuStateL")
|
[ ("menuFields", "menuFieldsL"), ("menuState", "menuStateL")
|
||||||
, ("menuButtons", "menuButtonsL"), ("menuFocusRing", "menuFocusRingL")
|
, ("menuButtons", "menuButtonsL"), ("menuFocusRing", "menuFocusRingL")
|
||||||
@ -289,6 +292,9 @@ makeLensesFor
|
|||||||
]
|
]
|
||||||
''Menu
|
''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 -> s -> KeyCombination -> [Button s n] -> [MenuField s n] -> Menu s n
|
||||||
createMenu n initial exitK buttons fields = Menu fields initial buttons ring exitK 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]
|
where ring = F.focusRing $ [field & fieldName | field <- fields] ++ [button & fieldName | button <- buttons]
|
||||||
@ -307,6 +313,9 @@ handlerMenu ev =
|
|||||||
Nothing -> pure ()
|
Nothing -> pure ()
|
||||||
Just n -> do
|
Just n -> do
|
||||||
updated_fields <- updateFields n (VtyEvent e) fields
|
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
|
menuFieldsL .= updated_fields
|
||||||
_ -> pure ()
|
_ -> pure ()
|
||||||
where
|
where
|
||||||
|
@ -196,6 +196,7 @@ create k = Menu.createMenu CompileGHCBox initialState k buttons fields
|
|||||||
Menu.createButtonField (Common.MenuElement Common.OkButton)
|
Menu.createButtonField (Common.MenuElement Common.OkButton)
|
||||||
& Menu.fieldLabelL .~ "Compile"
|
& Menu.fieldLabelL .~ "Compile"
|
||||||
& Menu.fieldHelpMsgL .~ "Compile GHC from source with options below"
|
& Menu.fieldHelpMsgL .~ "Compile GHC from source with options below"
|
||||||
|
& Menu.fieldStatusL .~ Menu.Invalid "bootstrap GHC is mandatory"
|
||||||
]
|
]
|
||||||
|
|
||||||
handler :: BrickEvent Name e -> EventM Name CompileGHCMenu ()
|
handler :: BrickEvent Name e -> EventM Name CompileGHCMenu ()
|
||||||
|
Loading…
Reference in New Issue
Block a user