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

Better aesth for context menu

Browse Source
This commit is contained in:
Luis Morillo 2024-02-28 17:11:00 +01:00 committed by Julian Ospald
parent b619a65ede
commit 06ace5324f
No known key found for this signature in database
GPG Key ID: 4275CDA6A29BED43
2 changed files with 46 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -150,6 +150,14 @@ fieldHelpMsgL = lens g s
where g (MenuField {..})= fieldInput ^. inputHelpL
s (MenuField{..}) msg = MenuField {fieldInput = fieldInput & inputHelpL .~ msg , ..}
-- | How to draw a field given a formater
drawField :: Formatter n -> Bool -> MenuField s n -> Widget n
drawField amp focus (MenuField { fieldInput = FieldInput {..}, ..}) =
let input = inputRender focus fieldStatus inputHelp inputState (amp focus)
in if focus
then Brick.visible input
else input
instance Brick.Named (MenuField s n) n where
getName :: MenuField s n -> n
getName entry = entry & fieldName
@ -330,12 +338,6 @@ drawMenu menu =
<+> Brick.txt " to go back"
]
where
drawField amp focus (MenuField { fieldInput = FieldInput {..}, ..}) =
let input = inputRender focus fieldStatus inputHelp inputState (amp focus)
in if focus
then Brick.visible input
else input
fieldLabels = [field & fieldLabel | field <- menu ^. menuFieldsL]
buttonLabels = [button & fieldLabel | button <- menu ^. menuButtonsL]
allLabels = fieldLabels ++ buttonLabels

43
lib-tui/GHCup/Brick/Widgets/Menus/Context.hs
View File

@ -6,20 +6,25 @@ 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.List ( ListResult(..) )
import GHCup.Types (KeyCombination, Tool (..))
import qualified GHCup.Brick.Common as Common
import qualified GHCup.Brick.Widgets.Menu as Menu
import GHCup.Brick.Common (Name (..))
import GHCup.Brick.Widgets.Menu (Menu)
import GHCup.Types (KeyCombination, Tool (..))
import qualified Brick.Widgets.Core as Brick
import qualified Brick.Widgets.Border as Border
import qualified Brick.Focus as F
import Brick.Widgets.Core ((<+>))
import Optics (to)
import Optics.Operators ((.~), (^.))
import Optics.Optic ((%))
import Data.Foldable (foldl')
type ContextMenu = Menu ListResult Name
@ -33,7 +38,7 @@ create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons []
compileButton =
Menu.createButtonField (MenuElement Common.CompilieButton)
& Menu.fieldLabelL .~ "Compile"
& Menu.fieldHelpMsgL .~ "Compile tool from source (to be implemented)"
& Menu.fieldHelpMsgL .~ "Compile tool from source"
buttons =
case lTool lr of
GHC -> [advInstallButton, compileButton]
@ -41,14 +46,28 @@ create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons []
_ -> [advInstallButton]
draw :: ContextMenu -> Widget Name
draw ctx =
draw menu =
Common.frontwardLayer
("Context Menu for " <> tool_str <> " " <> prettyVer (lVer $ ctx ^. Menu.menuStateL))
(Menu.drawMenu ctx)
("Context Menu for " <> tool_str <> " " <> prettyVer (lVer $ menu ^. Menu.menuStateL))
$ Brick.vBox
[ Brick.vBox buttonWidgets
, Brick.txt " "
, Brick.padRight Brick.Max $
Brick.txt "Press "
<+> Common.keyToWidget (menu ^. Menu.menuExitKeyL)
<+> Brick.txt " to go back"
]
where
tool_str :: T.Text
buttonLabels = [button & Menu.fieldLabel | button <- menu ^. Menu.menuButtonsL]
maxWidth = foldl' max 5 (fmap Brick.textWidth buttonLabels)
buttonAmplifiers =
let buttonAsWidgets = fmap Menu.renderAslabel buttonLabels
in fmap (\f b -> ((Menu.leftify (maxWidth + 10) . Border.border $ f b) <+>) ) buttonAsWidgets
drawButtons = fmap Menu.drawField buttonAmplifiers
buttonWidgets = zipWith (F.withFocusRing (menu ^. Menu.menuFocusRingL)) drawButtons (menu ^. Menu.menuButtonsL)
tool_str =
case ctx ^. Menu.menuStateL % to lTool of
case menu ^. Menu.menuStateL % to lTool of
GHC -> "GHC"
GHCup -> "GHCup"
Cabal -> "Cabal"