Better aesth for context menu

lib-tui/GHCup/Brick/Widgets/Menu.hs

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

lib-tui/GHCup/Brick/Widgets/Menus/Context.hs

@@ -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))
+    ("Context Menu for " <> tool_str <> " " <> prettyVer (lVer $ menu ^. Menu.menuStateL))
-    (Menu.drawMenu ctx)
+    $ 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"