Context Menu visuals

ghcup.cabal

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

lib-tui/GHCup/Brick/Actions.hs

@@ -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
+  in  st & appState .~ newInternalState
-                 , _appData     = appD
+         & appData .~ appD
-                 , _appSettings = _appSettings
+         & mode .~ Navigation
-                 , _appKeys     = _appKeys
-                 , _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

lib-tui/GHCup/Brick/App.hs

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

lib-tui/GHCup/Brick/BrickState.hs

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

lib-tui/GHCup/Brick/Common.hs

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

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

@@ -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
+      let buttonAsWidgets = fmap renderAslabel buttonLabels
-       in fmap (\f b -> ((leftify (maxWidth + 10) . Border.border $ f b) <+>) ) buttonAsWidgets
+       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)
 

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

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

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

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

lib-tui/GHCup/BrickMain.hs

@@ -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 ->
+    Right ad -> do
-      Brick.defaultMain
+      let initial_list = Actions.constructList ad Common.defaultAppSettings Nothing
-          (BrickApp.app (Attributes.defaultAttributes (noColor $ settings s))
+          current_element = Navigation.sectionListSelectedElement initial_list
-                        (Attributes.dimAttributes (noColor $ settings s)))
+          exit_key = bQuit . keyBindings $ s 
-          (AppState.BrickState ad
+      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)
+                      initial_list
-                    (keyBindings (s :: AppState))
+                      (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)