hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Context Menu visuals

Browse Source
This commit is contained in:
Luis Morillo 2024-02-28 09:37:17 +01:00 committed by Julian Ospald
parent 3298f2293b
commit 16967bdc5f
No known key found for this signature in database
GPG Key ID: 4275CDA6A29BED43
9 changed files with 135 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ghcup.cabal
View File

@ -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
lib-tui/GHCup/Brick/Actions.hs
View File

@ -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

28
lib-tui/GHCup/Brick/App.hs
View File

@ -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

2
lib-tui/GHCup/Brick/BrickState.hs
View File

@ -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
}

2
lib-tui/GHCup/Brick/Common.hs
View File

@ -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

6
lib-tui/GHCup/Brick/Widgets/Menu.hs
View File

@ -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
View 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

1
lib-tui/GHCup/Brick/Widgets/Tutorial.hs
View File

@ -23,7 +23,6 @@ import Brick
(<+>),
(<=>))
import qualified Brick
import Brick.Widgets.Border ( hBorder)
import Brick.Widgets.Center ( center )
import Prelude hiding ( appendFile )

32
lib-tui/GHCup/BrickMain.hs
View File

@ -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,17 +45,27 @@ 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
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
(Actions.constructList ad Common.defaultAppSettings Nothing)
(keyBindings (s :: AppState))
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)