Better aesth for context menu
This commit is contained in:
parent
32c2cd2efa
commit
40f94fa016
@ -150,6 +150,14 @@ fieldHelpMsgL = lens g s
|
|||||||
where g (MenuField {..})= fieldInput ^. inputHelpL
|
where g (MenuField {..})= fieldInput ^. inputHelpL
|
||||||
s (MenuField{..}) msg = MenuField {fieldInput = fieldInput & inputHelpL .~ msg , ..}
|
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
|
instance Brick.Named (MenuField s n) n where
|
||||||
getName :: MenuField s n -> n
|
getName :: MenuField s n -> n
|
||||||
getName entry = entry & fieldName
|
getName entry = entry & fieldName
|
||||||
@ -330,12 +338,6 @@ drawMenu menu =
|
|||||||
<+> Brick.txt " to go back"
|
<+> Brick.txt " to go back"
|
||||||
]
|
]
|
||||||
where
|
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]
|
fieldLabels = [field & fieldLabel | field <- menu ^. menuFieldsL]
|
||||||
buttonLabels = [button & fieldLabel | button <- menu ^. menuButtonsL]
|
buttonLabels = [button & fieldLabel | button <- menu ^. menuButtonsL]
|
||||||
allLabels = fieldLabels ++ buttonLabels
|
allLabels = fieldLabels ++ buttonLabels
|
||||||
|
@ -6,20 +6,25 @@ import Brick (
|
|||||||
Widget (..), BrickEvent, EventM,
|
Widget (..), BrickEvent, EventM,
|
||||||
)
|
)
|
||||||
import Data.Function ((&))
|
import Data.Function ((&))
|
||||||
import qualified GHCup.Brick.Common as Common
|
|
||||||
import qualified GHCup.Brick.Widgets.Menu as Menu
|
|
||||||
import Prelude hiding (appendFile)
|
import Prelude hiding (appendFile)
|
||||||
|
|
||||||
import qualified Data.Text as T
|
|
||||||
|
|
||||||
import Data.Versions (prettyVer)
|
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.Common (Name (..))
|
||||||
import GHCup.Brick.Widgets.Menu (Menu)
|
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 (to)
|
||||||
import Optics.Operators ((.~), (^.))
|
import Optics.Operators ((.~), (^.))
|
||||||
import Optics.Optic ((%))
|
import Optics.Optic ((%))
|
||||||
|
import Data.Foldable (foldl')
|
||||||
|
|
||||||
type ContextMenu = Menu ListResult Name
|
type ContextMenu = Menu ListResult Name
|
||||||
|
|
||||||
@ -33,7 +38,7 @@ create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons []
|
|||||||
compileButton =
|
compileButton =
|
||||||
Menu.createButtonField (MenuElement Common.CompilieButton)
|
Menu.createButtonField (MenuElement Common.CompilieButton)
|
||||||
& Menu.fieldLabelL .~ "Compile"
|
& Menu.fieldLabelL .~ "Compile"
|
||||||
& Menu.fieldHelpMsgL .~ "Compile tool from source (to be implemented)"
|
& Menu.fieldHelpMsgL .~ "Compile tool from source"
|
||||||
buttons =
|
buttons =
|
||||||
case lTool lr of
|
case lTool lr of
|
||||||
GHC -> [advInstallButton, compileButton]
|
GHC -> [advInstallButton, compileButton]
|
||||||
@ -41,19 +46,33 @@ create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons []
|
|||||||
_ -> [advInstallButton]
|
_ -> [advInstallButton]
|
||||||
|
|
||||||
draw :: ContextMenu -> Widget Name
|
draw :: ContextMenu -> Widget Name
|
||||||
draw ctx =
|
draw menu =
|
||||||
Common.frontwardLayer
|
Common.frontwardLayer
|
||||||
("Context Menu for " <> tool_str <> " " <> prettyVer (lVer $ ctx ^. Menu.menuStateL))
|
("Context Menu for " <> tool_str <> " " <> prettyVer (lVer $ menu ^. Menu.menuStateL))
|
||||||
(Menu.drawMenu ctx)
|
$ Brick.vBox
|
||||||
where
|
[ Brick.vBox buttonWidgets
|
||||||
tool_str :: T.Text
|
, Brick.txt " "
|
||||||
tool_str =
|
, Brick.padRight Brick.Max $
|
||||||
case ctx ^. Menu.menuStateL % to lTool of
|
Brick.txt "Press "
|
||||||
GHC -> "GHC"
|
<+> Common.keyToWidget (menu ^. Menu.menuExitKeyL)
|
||||||
GHCup -> "GHCup"
|
<+> Brick.txt " to go back"
|
||||||
Cabal -> "Cabal"
|
]
|
||||||
HLS -> "HLS"
|
where
|
||||||
Stack -> "Stack"
|
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 :: BrickEvent Name e -> EventM Name ContextMenu ()
|
||||||
handler = Menu.handlerMenu
|
handler = Menu.handlerMenu
|
Loading…
Reference in New Issue
Block a user