Better aesth for context menu
This commit is contained in:
parent
b619a65ede
commit
06ace5324f
@ -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
|
||||
|
@ -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,19 +46,33 @@ 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)
|
||||
where
|
||||
tool_str :: T.Text
|
||||
tool_str =
|
||||
case ctx ^. Menu.menuStateL % to lTool of
|
||||
GHC -> "GHC"
|
||||
GHCup -> "GHCup"
|
||||
Cabal -> "Cabal"
|
||||
HLS -> "HLS"
|
||||
Stack -> "Stack"
|
||||
("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
|
||||
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 menu ^. 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
|
Loading…
Reference in New Issue
Block a user