diff --git a/lib-tui/GHCup/Brick/App.hs b/lib-tui/GHCup/Brick/App.hs index 35309a8..fc1fc7a 100644 --- a/lib-tui/GHCup/Brick/App.hs +++ b/lib-tui/GHCup/Brick/App.hs @@ -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 () diff --git a/lib-tui/GHCup/Brick/Widgets/Menu.hs b/lib-tui/GHCup/Brick/Widgets/Menu.hs index 4a3a39b..6443abc 100644 --- a/lib-tui/GHCup/Brick/Widgets/Menu.hs +++ b/lib-tui/GHCup/Brick/Widgets/Menu.hs @@ -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 diff --git a/lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs b/lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs index 8b24383..0acc182 100644 --- a/lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs +++ b/lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs @@ -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 ()