Context Menu visuals
This commit is contained in:
parent
3298f2293b
commit
16967bdc5f
@ -332,6 +332,7 @@ library ghcup-tui
|
||||
GHCup.Brick.Widgets.KeyInfo
|
||||
GHCup.Brick.Widgets.SectionList
|
||||
GHCup.Brick.Widgets.Menu
|
||||
GHCup.Brick.Widgets.Menus.Context
|
||||
GHCup.Brick.Actions
|
||||
GHCup.Brick.App
|
||||
GHCup.Brick.BrickState
|
||||
|
@ -26,6 +26,7 @@ import GHCup.Brick.Common (BrickData(..), BrickSettings(..), Name(..),
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
import GHCup.Brick.BrickState
|
||||
import GHCup.Brick.Widgets.SectionList
|
||||
import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
|
||||
import GHCup.Brick.Widgets.Navigation (BrickInternalState)
|
||||
|
||||
import qualified Brick
|
||||
@ -70,6 +71,8 @@ import Optics.State (use)
|
||||
import Optics.State.Operators ( (.=))
|
||||
import Optics.Operators ((.~),(%~))
|
||||
import Optics.Getter (view)
|
||||
import Optics.Optic ((%))
|
||||
import Optics (to)
|
||||
|
||||
|
||||
{- Core Logic.
|
||||
@ -86,14 +89,11 @@ This module defines the IO actions we can execute within the Brick App:
|
||||
-- This synchronises @BrickInternalState@ with @BrickData@
|
||||
-- and @BrickSettings@.
|
||||
updateList :: BrickData -> BrickState -> BrickState
|
||||
updateList appD BrickState{..} =
|
||||
updateList appD st@BrickState{..} =
|
||||
let newInternalState = constructList appD _appSettings (Just _appState)
|
||||
in BrickState { _appState = newInternalState
|
||||
, _appData = appD
|
||||
, _appSettings = _appSettings
|
||||
, _appKeys = _appKeys
|
||||
, _mode = Navigation
|
||||
}
|
||||
in st & appState .~ newInternalState
|
||||
& appData .~ appD
|
||||
& mode .~ Navigation
|
||||
|
||||
constructList :: BrickData
|
||||
-> BrickSettings
|
||||
@ -447,8 +447,20 @@ keyHandlers KeyBindings {..} =
|
||||
, (bUp, const "Up", Common.zoom appState moveUp)
|
||||
, (bDown, const "Down", Common.zoom appState moveDown)
|
||||
, (KeyCombination (Vty.KChar 'h') [], const "help", mode .= KeyInfo)
|
||||
, (KeyCombination Vty.KEnter [], const "advance options", createMenuforTool )
|
||||
]
|
||||
where
|
||||
createMenuforTool = do
|
||||
e <- use (appState % to sectionListSelectedElement)
|
||||
case e of
|
||||
Nothing -> pure ()
|
||||
Just (_, r) -> do
|
||||
-- Create new menus
|
||||
contextMenu .= ContextMenu.create r bQuit
|
||||
-- Set mode to context
|
||||
mode .= ContextPanel
|
||||
pure ()
|
||||
|
||||
--hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m ()
|
||||
hideShowHandler' f = do
|
||||
app_settings <- use appSettings
|
||||
|
@ -26,11 +26,12 @@ module GHCup.Brick.App where
|
||||
import GHCup.Types ( AppState(AppState, keyBindings), KeyCombination(KeyCombination) )
|
||||
import GHCup.Brick.Common ( Name(..), Mode(..))
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
import GHCup.Brick.BrickState (BrickState(..), appState, mode, appKeys, appSettings)
|
||||
import GHCup.Brick.BrickState (BrickState(..), appState, mode, appKeys, appSettings, contextMenu)
|
||||
import qualified GHCup.Brick.Attributes as Attributes
|
||||
import qualified GHCup.Brick.Widgets.Navigation as Navigation
|
||||
import qualified GHCup.Brick.Widgets.Tutorial as Tutorial
|
||||
import qualified GHCup.Brick.Widgets.KeyInfo as KeyInfo
|
||||
import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
|
||||
import qualified GHCup.Brick.Actions as Actions
|
||||
|
||||
import Brick
|
||||
@ -53,6 +54,11 @@ import Optics.State (use)
|
||||
import Optics.State.Operators ( (.=))
|
||||
import Optics.Operators ((^.))
|
||||
import qualified Data.Text as T
|
||||
import qualified GHCup.Brick.Widgets.Menu as Menu
|
||||
import Optics.Optic ((%))
|
||||
import qualified Brick.Focus as F
|
||||
import Optics.Getter (to)
|
||||
|
||||
|
||||
app :: AttrMap -> AttrMap -> App BrickState () Name
|
||||
app attrs dimAttrs =
|
||||
@ -79,7 +85,7 @@ drawUI dimAttrs st =
|
||||
Navigation -> [navg]
|
||||
Tutorial -> [Tutorial.draw, navg]
|
||||
KeyInfo -> [KeyInfo.draw (st ^. appKeys), navg]
|
||||
-- InstallPopUp -> [drawCompilePopUp (st ^. popUp), navg]
|
||||
ContextPanel -> [ContextMenu.draw (st ^. contextMenu), navg]
|
||||
|
||||
-- | On q, go back to navigation.
|
||||
-- On Enter, to go to tutorial
|
||||
@ -107,6 +113,22 @@ navigationHandler ev = do
|
||||
Nothing -> void $ Common.zoom appState $ Navigation.handler inner_event
|
||||
inner_event -> Common.zoom appState $ Navigation.handler inner_event
|
||||
|
||||
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 Vty.KEnter []), Just (Common.MenuElement Common.AdvanceInstallButton) ) -> pure ()
|
||||
(VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.CompilieButton) ) -> pure ()
|
||||
_ -> Common.zoom contextMenu $ ContextMenu.handler ev
|
||||
|
||||
eventHandler :: BrickEvent Name e -> EventM Name BrickState ()
|
||||
eventHandler ev = do
|
||||
@ -115,4 +137,4 @@ eventHandler ev = do
|
||||
KeyInfo -> keyInfoHandler ev
|
||||
Tutorial -> tutorialHandler ev
|
||||
Navigation -> navigationHandler ev
|
||||
-- InstallPopUp -> compilePopUpHandler ev
|
||||
ContextPanel -> contextMenuHandler ev
|
||||
|
@ -31,6 +31,7 @@ module GHCup.Brick.BrickState where
|
||||
import GHCup.Types ( KeyBindings )
|
||||
import GHCup.Brick.Common ( BrickData(..), BrickSettings(..), Mode(..))
|
||||
import GHCup.Brick.Widgets.Navigation ( BrickInternalState)
|
||||
import GHCup.Brick.Widgets.Menus.Context (ContextMenu)
|
||||
import Optics.TH (makeLenses)
|
||||
|
||||
|
||||
@ -38,6 +39,7 @@ data BrickState = BrickState
|
||||
{ _appData :: BrickData
|
||||
, _appSettings :: BrickSettings
|
||||
, _appState :: BrickInternalState
|
||||
, _contextMenu :: ContextMenu
|
||||
, _appKeys :: KeyBindings
|
||||
, _mode :: Mode
|
||||
}
|
||||
|
@ -65,7 +65,7 @@ data Name = AllTools -- ^ The main list widget
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
-- | Mode type. It helps to dispatch events to different handlers.
|
||||
data Mode = Navigation | KeyInfo | Tutorial deriving (Eq, Show, Ord)
|
||||
data Mode = Navigation | KeyInfo | Tutorial | ContextPanel deriving (Eq, Show, Ord)
|
||||
|
||||
installedSign :: String
|
||||
#if IS_WINDOWS
|
||||
|
@ -345,14 +345,14 @@ drawMenu menu =
|
||||
|
||||
-- A list of functions which draw a highlighted label with right padding at the left of a widget.
|
||||
amplifiers =
|
||||
let labelsWidgets = fmap (\b -> renderAslabel b) fieldLabels
|
||||
let labelsWidgets = fmap renderAslabel fieldLabels
|
||||
in fmap (\f b -> ((centerV . leftify (maxWidth + 10) $ f b) <+>) ) labelsWidgets
|
||||
drawFields = fmap drawField amplifiers
|
||||
fieldWidgets = zipWith (F.withFocusRing (menu ^. menuFocusRingL)) drawFields (menu ^. menuFieldsL)
|
||||
|
||||
buttonAmplifiers =
|
||||
let buttonAsWidgets = fmap (\b -> renderAslabel b) buttonLabels
|
||||
in fmap (\f b -> ((leftify (maxWidth + 10) . Border.border $ f b) <+>) ) buttonAsWidgets
|
||||
let buttonAsWidgets = fmap renderAslabel buttonLabels
|
||||
in fmap (\f b -> ((leftify (maxWidth + 10) . Border.border $ Brick.str (show b) <+> f b) <+>) ) buttonAsWidgets
|
||||
drawButtons = fmap drawField buttonAmplifiers
|
||||
buttonWidgets = zipWith (F.withFocusRing (menu ^. menuFocusRingL)) drawButtons (menu ^. menuButtonsL)
|
||||
|
||||
|
59
lib-tui/GHCup/Brick/Widgets/Menus/Context.hs
Normal file
59
lib-tui/GHCup/Brick/Widgets/Menus/Context.hs
Normal file
@ -0,0 +1,59 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module GHCup.Brick.Widgets.Menus.Context (ContextMenu, create, draw, handler) where
|
||||
|
||||
import Brick (
|
||||
Widget (..), BrickEvent, EventM,
|
||||
)
|
||||
import Data.Function ((&))
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
import qualified GHCup.Brick.Widgets.Menu as Menu
|
||||
import Prelude hiding (appendFile)
|
||||
|
||||
import qualified Data.Text as T
|
||||
|
||||
import Data.Versions (prettyVer)
|
||||
import GHCup (ListResult (..))
|
||||
import GHCup.Brick.Common (Name (..))
|
||||
import GHCup.Brick.Widgets.Menu (Menu)
|
||||
import GHCup.Types (KeyCombination, Tool (..))
|
||||
import Optics (to)
|
||||
import Optics.Operators ((.~), (^.))
|
||||
import Optics.Optic ((%))
|
||||
|
||||
type ContextMenu = Menu ListResult Name
|
||||
|
||||
create :: ListResult -> KeyCombination -> ContextMenu
|
||||
create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons []
|
||||
where
|
||||
advInstallButton =
|
||||
Menu.createButtonField (MenuElement Common.AdvanceInstallButton)
|
||||
& Menu.fieldLabelL .~ "Install"
|
||||
& Menu.fieldHelpMsgL .~ "Advance Installation Settings"
|
||||
compileButton =
|
||||
Menu.createButtonField (MenuElement Common.AdvanceInstallButton)
|
||||
& Menu.fieldLabelL .~ "Compile"
|
||||
& Menu.fieldHelpMsgL .~ "Compile tool from source (to be implemented)"
|
||||
buttons =
|
||||
case lTool lr of
|
||||
GHC -> [advInstallButton, compileButton]
|
||||
HLS -> [advInstallButton, compileButton]
|
||||
_ -> [advInstallButton]
|
||||
|
||||
draw :: ContextMenu -> Widget Name
|
||||
draw ctx =
|
||||
Common.frontwardLayer
|
||||
("Context Menu for " <> tool_str <> " " <> prettyVer (lVer $ ctx ^. Menu.menuStateL))
|
||||
(Menu.drawMenu ctx)
|
||||
where
|
||||
tool_str :: T.Text
|
||||
tool_str =
|
||||
case ctx ^. Menu.menuStateL % to lTool of
|
||||
GHC -> "GHC"
|
||||
GHCup -> "GHCup"
|
||||
Cabal -> "Cabal"
|
||||
HLS -> "HLS"
|
||||
Stack -> "Stack"
|
||||
|
||||
handler :: BrickEvent Name e -> EventM Name ContextMenu ()
|
||||
handler = Menu.handlerMenu
|
@ -23,7 +23,6 @@ import Brick
|
||||
(<+>),
|
||||
(<=>))
|
||||
import qualified Brick
|
||||
import Brick.Widgets.Border ( hBorder)
|
||||
import Brick.Widgets.Center ( center )
|
||||
import Prelude hiding ( appendFile )
|
||||
|
||||
|
@ -17,13 +17,15 @@ module GHCup.BrickMain where
|
||||
|
||||
import GHCup.Types
|
||||
( Settings(noColor),
|
||||
AppState(ghcupInfo, settings, keyBindings, loggerConfig) )
|
||||
AppState(ghcupInfo, settings, keyBindings, loggerConfig), KeyBindings (bQuit) )
|
||||
import GHCup.Prelude.Logger ( logError )
|
||||
import qualified GHCup.Brick.Actions as Actions
|
||||
import qualified GHCup.Brick.Common as Common
|
||||
import qualified GHCup.Brick.App as BrickApp
|
||||
import qualified GHCup.Brick.Attributes as Attributes
|
||||
import qualified GHCup.Brick.BrickState as AppState
|
||||
import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
|
||||
import qualified GHCup.Brick.Widgets.SectionList as Navigation
|
||||
import qualified Brick
|
||||
|
||||
import Control.Monad.Reader ( ReaderT(runReaderT) )
|
||||
@ -43,18 +45,28 @@ brickMain s = do
|
||||
|
||||
eAppData <- Actions.getAppData (Just $ ghcupInfo s)
|
||||
case eAppData of
|
||||
Right ad ->
|
||||
Brick.defaultMain
|
||||
(BrickApp.app (Attributes.defaultAttributes (noColor $ settings s))
|
||||
(Attributes.dimAttributes (noColor $ settings s)))
|
||||
(AppState.BrickState ad
|
||||
Common.defaultAppSettings
|
||||
(Actions.constructList ad Common.defaultAppSettings Nothing)
|
||||
(keyBindings (s :: AppState))
|
||||
Common.Navigation
|
||||
|
||||
)
|
||||
$> ()
|
||||
Right ad -> do
|
||||
let initial_list = Actions.constructList ad Common.defaultAppSettings Nothing
|
||||
current_element = Navigation.sectionListSelectedElement initial_list
|
||||
exit_key = bQuit . keyBindings $ s
|
||||
case current_element of
|
||||
Nothing -> do
|
||||
flip runReaderT s $ logError "Error building app state: empty ResultList"
|
||||
exitWith $ ExitFailure 2
|
||||
Just (_, e) ->
|
||||
let initapp =
|
||||
BrickApp.app
|
||||
(Attributes.defaultAttributes $ noColor $ settings s)
|
||||
(Attributes.dimAttributes $ noColor $ settings s)
|
||||
initstate =
|
||||
AppState.BrickState ad
|
||||
Common.defaultAppSettings
|
||||
initial_list
|
||||
(ContextMenu.create e exit_key)
|
||||
(keyBindings s)
|
||||
Common.Navigation
|
||||
in Brick.defaultMain initapp initstate
|
||||
$> ()
|
||||
Left e -> do
|
||||
flip runReaderT s $ logError $ "Error building app state: " <> T.pack (show e)
|
||||
exitWith $ ExitFailure 2
|
||||
|
Loading…
Reference in New Issue
Block a user