From 2a2385731b689adebb3f8c509433ccabbc349bd4 Mon Sep 17 00:00:00 2001 From: Luis Morillo Date: Wed, 28 Feb 2024 10:29:39 +0100 Subject: [PATCH] Add visuals for Advance Install --- ghcup.cabal | 1 + lib-tui/GHCup/Brick/Actions.hs | 17 +-- lib-tui/GHCup/Brick/App.hs | 89 +++++++++------ lib-tui/GHCup/Brick/BrickState.hs | 14 ++- lib-tui/GHCup/Brick/Common.hs | 35 ++++-- lib-tui/GHCup/Brick/Widgets/Menu.hs | 2 +- .../Brick/Widgets/Menus/AdvanceInstall.hs | 107 ++++++++++++++++++ lib-tui/GHCup/Brick/Widgets/Menus/Context.hs | 2 +- lib-tui/GHCup/Brick/Widgets/Tutorial.hs | 1 - lib-tui/GHCup/BrickMain.hs | 4 +- 10 files changed, 212 insertions(+), 60 deletions(-) create mode 100644 lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs diff --git a/ghcup.cabal b/ghcup.cabal index 40701ba..4d2910e 100644 --- a/ghcup.cabal +++ b/ghcup.cabal @@ -333,6 +333,7 @@ library ghcup-tui GHCup.Brick.Widgets.SectionList GHCup.Brick.Widgets.Menu GHCup.Brick.Widgets.Menus.Context + GHCup.Brick.Widgets.Menus.AdvanceInstall GHCup.Brick.Actions GHCup.Brick.App GHCup.Brick.BrickState diff --git a/lib-tui/GHCup/Brick/Actions.hs b/lib-tui/GHCup/Brick/Actions.hs index 78a7bf5..ae16aed 100644 --- a/lib-tui/GHCup/Brick/Actions.hs +++ b/lib-tui/GHCup/Brick/Actions.hs @@ -72,7 +72,8 @@ import Optics.State.Operators ( (.=)) import Optics.Operators ((.~),(%~)) import Optics.Getter (view) import Optics.Optic ((%)) -import Optics (to) +import Optics ((^.), to) +import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall {- Core Logic. @@ -89,11 +90,12 @@ 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 st@BrickState{..} = - let newInternalState = constructList appD _appSettings (Just _appState) - in st & appState .~ newInternalState - & appData .~ appD - & mode .~ Navigation +updateList appD bst = + let newInternalState = constructList appD (bst ^. appSettings) (Just (bst ^. appState)) + in bst + & appState .~ newInternalState + & appData .~ appD + & mode .~ Navigation constructList :: BrickData -> BrickSettings @@ -456,7 +458,8 @@ keyHandlers KeyBindings {..} = Nothing -> pure () Just (_, r) -> do -- Create new menus - contextMenu .= ContextMenu.create r bQuit + contextMenu .= ContextMenu.create r bQuit + advanceInstallMenu .= AdvanceInstall.create bQuit -- Set mode to context mode .= ContextPanel pure () diff --git a/lib-tui/GHCup/Brick/App.hs b/lib-tui/GHCup/Brick/App.hs index c678c57..9132d40 100644 --- a/lib-tui/GHCup/Brick/App.hs +++ b/lib-tui/GHCup/Brick/App.hs @@ -23,42 +23,47 @@ module should only contain: 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, contextMenu) +import qualified GHCup.Brick.Actions as Actions import qualified GHCup.Brick.Attributes as Attributes -import qualified GHCup.Brick.Widgets.Navigation as Navigation -import qualified GHCup.Brick.Widgets.Tutorial as Tutorial +import GHCup.Brick.BrickState (BrickState (..), advanceInstallMenu, appKeys, appSettings, appState, contextMenu, mode) +import GHCup.Brick.Common (Mode (..), Name (..)) +import qualified GHCup.Brick.Common as Common 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 - ( BrickEvent(VtyEvent), - App(..), - AttrMap, - EventM, - Widget(..), - (<=>)) -import qualified Brick -import Control.Monad.Reader - ( void, MonadIO(liftIO) ) -import Data.List ( find, intercalate) -import Data.IORef (readIORef) -import Prelude hiding ( appendFile ) - -import qualified Graphics.Vty as Vty - -import Optics.State (use) -import Optics.State.Operators ( (.=)) -import Optics.Operators ((^.)) -import qualified Data.Text as T +import qualified GHCup.Brick.Widgets.Navigation as Navigation +import qualified GHCup.Brick.Widgets.Tutorial as Tutorial import qualified GHCup.Brick.Widgets.Menu as Menu -import Optics.Optic ((%)) -import qualified Brick.Focus as F -import Optics.Getter (to) +import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall +import GHCup.Types (AppState (AppState, keyBindings), KeyCombination (KeyCombination)) + +import qualified Brick.Focus as F +import Brick ( + App (..), + AttrMap, + BrickEvent (VtyEvent), + EventM, + Widget (..), + (<=>), + ) +import qualified Brick +import Control.Monad.Reader ( + MonadIO (liftIO), + void, + ) +import Data.IORef (readIORef) +import Data.List (find, intercalate) +import Prelude hiding (appendFile) + +import qualified Graphics.Vty as Vty + +import qualified Data.Text as T + +import Optics.Getter (to) +import Optics.Operators ((^.)) +import Optics.Optic ((%)) +import Optics.State (use) +import Optics.State.Operators ((.=)) app :: AttrMap -> AttrMap -> App BrickState () Name app attrs dimAttrs = @@ -86,6 +91,8 @@ drawUI dimAttrs st = Tutorial -> [Tutorial.draw, navg] KeyInfo -> [KeyInfo.draw (st ^. appKeys), navg] ContextPanel -> [ContextMenu.draw (st ^. contextMenu), navg] + AdvanceInstallPanel -> [AdvanceInstall.draw (st ^. advanceInstallMenu), navg] + -- | On q, go back to navigation. -- On Enter, to go to tutorial @@ -121,14 +128,29 @@ contextMenuHandler ev = do (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL case (ev, focusedElement) of (_ , Nothing) -> pure () - (VtyEvent (Vty.EvKey k m), Just n ) + (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.AdvanceInstallButton) ) -> mode .= Common.AdvanceInstallPanel (VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.CompilieButton) ) -> pure () _ -> Common.zoom contextMenu $ ContextMenu.handler ev +-- +advanceInstallHandler :: BrickEvent Name e -> EventM Name BrickState () +advanceInstallHandler ev = do + ctx <- use advanceInstallMenu + 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 .= ContextPanel + _ -> Common.zoom advanceInstallMenu $ AdvanceInstall.handler ev eventHandler :: BrickEvent Name e -> EventM Name BrickState () eventHandler ev = do @@ -138,3 +160,4 @@ eventHandler ev = do Tutorial -> tutorialHandler ev Navigation -> navigationHandler ev ContextPanel -> contextMenuHandler ev + AdvanceInstallPanel -> advanceInstallHandler ev diff --git a/lib-tui/GHCup/Brick/BrickState.hs b/lib-tui/GHCup/Brick/BrickState.hs index abc7d54..84583f4 100644 --- a/lib-tui/GHCup/Brick/BrickState.hs +++ b/lib-tui/GHCup/Brick/BrickState.hs @@ -32,16 +32,18 @@ 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 GHCup.Brick.Widgets.Menus.AdvanceInstall (AdvanceInstallMenu) import Optics.TH (makeLenses) data BrickState = BrickState - { _appData :: BrickData - , _appSettings :: BrickSettings - , _appState :: BrickInternalState - , _contextMenu :: ContextMenu - , _appKeys :: KeyBindings - , _mode :: Mode + { _appData :: BrickData + , _appSettings :: BrickSettings + , _appState :: BrickInternalState + , _contextMenu :: ContextMenu + , _advanceInstallMenu :: AdvanceInstallMenu + , _appKeys :: KeyBindings + , _mode :: Mode } --deriving Show diff --git a/lib-tui/GHCup/Brick/Common.hs b/lib-tui/GHCup/Brick/Common.hs index 8899fa9..7f08f57 100644 --- a/lib-tui/GHCup/Brick/Common.hs +++ b/lib-tui/GHCup/Brick/Common.hs @@ -52,20 +52,34 @@ pattern OkButton = ResourceId 0 pattern AdvanceInstallButton = ResourceId 100 pattern CompilieButton = ResourceId 101 +pattern UrlEditBox = ResourceId 1 +pattern SetCheckBox = ResourceId 2 +pattern IsolateEditBox = ResourceId 3 +pattern ForceCheckBox = ResourceId 4 +pattern AdditionalEditBox = ResourceId 5 -- | Name data type. Uniquely identifies each widget in the TUI. -- some constructors might end up unused, but still is a good practise -- to have all of them defined, just in case -data Name = AllTools -- ^ The main list widget - | Singular Tool -- ^ The particular list for each tool - | KeyInfoBox -- ^ The text box widget with action informacion - | TutorialBox -- ^ The tutorial widget - | ContextBox -- ^ The resource for the context menu - | MenuElement ResourceId -- ^ The resource for field/buttons in a menu +data Name = AllTools -- ^ The main list widget + | Singular Tool -- ^ The particular list for each tool + | KeyInfoBox -- ^ The text box widget with action informacion + | TutorialBox -- ^ The tutorial widget + | ContextBox -- ^ The Context Menu for a Tool + | AdvanceInstallBox -- ^ The Menu for AdvanceInstall + | MenuElement ResourceId -- ^ Each element in a Menu. Resources must not be share for visible + -- Menus, but MenuA and MenuB can share resources if they both are + -- invisible, or just one of them is visible. + deriving (Eq, Ord, Show) -- | Mode type. It helps to dispatch events to different handlers. -data Mode = Navigation | KeyInfo | Tutorial | ContextPanel deriving (Eq, Show, Ord) +data Mode = Navigation + | KeyInfo + | Tutorial + | ContextPanel + | AdvanceInstallPanel + deriving (Eq, Show, Ord) installedSign :: String #if IS_WINDOWS @@ -88,6 +102,7 @@ notInstalledSign = "X " notInstalledSign = "✗ " #endif + showKey :: Vty.Key -> String showKey (Vty.KChar c) = [c] showKey Vty.KUp = "↑" @@ -107,8 +122,8 @@ separator = Border.hBorder <+> Brick.str " o " <+> Border.hBorder -- | Used to create a layer on top of the main navigation widget (tutorial, info, menus...) frontwardLayer :: T.Text -> Brick.Widget n -> Brick.Widget n -frontwardLayer layer_name = - Brick.centerLayer +frontwardLayer layer_name = + Brick.centerLayer . Brick.hLimitPercent 75 . Brick.vLimitPercent 50 . Brick.withBorderStyle Border.unicode @@ -132,4 +147,4 @@ data BrickSettings = BrickSettings { _showAllVersions :: Bool} makeLenses ''BrickSettings defaultAppSettings :: BrickSettings -defaultAppSettings = BrickSettings { _showAllVersions = False} +defaultAppSettings = BrickSettings False diff --git a/lib-tui/GHCup/Brick/Widgets/Menu.hs b/lib-tui/GHCup/Brick/Widgets/Menu.hs index 2a2ad3f..6eef715 100644 --- a/lib-tui/GHCup/Brick/Widgets/Menu.hs +++ b/lib-tui/GHCup/Brick/Widgets/Menu.hs @@ -352,7 +352,7 @@ drawMenu menu = buttonAmplifiers = let buttonAsWidgets = fmap renderAslabel buttonLabels - in fmap (\f b -> ((leftify (maxWidth + 10) . Border.border $ Brick.str (show b) <+> f b) <+>) ) buttonAsWidgets + in fmap (\f b -> ((leftify (maxWidth + 10) . Border.border $ f b) <+>) ) buttonAsWidgets drawButtons = fmap drawField buttonAmplifiers buttonWidgets = zipWith (F.withFocusRing (menu ^. menuFocusRingL)) drawButtons (menu ^. menuButtonsL) diff --git a/lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs b/lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs new file mode 100644 index 0000000..343d909 --- /dev/null +++ b/lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -Wno-unused-record-wildcards #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE InstanceSigs #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} + +module GHCup.Brick.Widgets.Menus.AdvanceInstall (InstallOptions, AdvanceInstallMenu, create, handler, draw) where + +import GHCup.Brick.Widgets.Menu (Menu) +import qualified GHCup.Brick.Widgets.Menu as Menu +import GHCup.Brick.Common(Name(..)) +import Brick + ( BrickEvent(..), + EventM, + Widget(..)) +import Prelude hiding ( appendFile ) +import Optics.TH (makeLensesFor) +import qualified GHCup.Brick.Common as Common +import GHCup.Types (KeyCombination) +import URI.ByteString (URI) +import qualified Data.Text as T +import qualified Data.ByteString.UTF8 as UTF8 +import GHCup.Utils (parseURI) +import Data.Bifunctor (Bifunctor(..)) +import Data.Function ((&)) +import Optics ((.~)) +import Data.Char (isSpace) + +data InstallOptions = InstallOptions + { instBindist :: Maybe URI + , instSet :: Bool + , isolateDir :: Maybe FilePath + , forceInstall :: Bool + , addConfArgs :: [T.Text] + } deriving (Eq, Show) + +makeLensesFor [ + ("instBindist", "instBindistL") + , ("instSet", "instSetL") + , ("isolateDir", "isolateDirL") + , ("forceInstall", "forceInstallL") + , ("addConfArgs", "addConfArgsL") + ] + ''InstallOptions + +type AdvanceInstallMenu = Menu InstallOptions Name + +create :: KeyCombination -> AdvanceInstallMenu +create k = Menu.createMenu AdvanceInstallBox initialState k [ok] fields + where + initialState = InstallOptions Nothing False Nothing False [] + -- Brick's internal editor representation is [mempty]. + emptyEditor i = T.null i || (i == "\n") + + uriValidator :: T.Text -> Either Menu.ErrorMessage (Maybe URI) + uriValidator i = + case not $ emptyEditor i of + True -> bimap (T.pack . show) Just . parseURI . UTF8.fromString . T.unpack $ i + False -> Right Nothing + + filepathValidator :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath) + filepathValidator i = + case not $ emptyEditor i of + True -> Right . Just . T.unpack $ i + False -> Right Nothing + + additionalValidator :: T.Text -> Either Menu.ErrorMessage [T.Text] + additionalValidator = Right . T.split isSpace + + fields = + [ Menu.createEditableField (Common.MenuElement Common.UrlEditBox) uriValidator instBindistL + & Menu.fieldLabelL .~ "url" + & Menu.fieldHelpMsgL .~ "Install the specified version from this bindist" + , Menu.createCheckBoxField (Common.MenuElement Common.SetCheckBox) instSetL + & Menu.fieldLabelL .~ "set" + & Menu.fieldHelpMsgL .~ "Set as active version after install" + , Menu.createEditableField (Common.MenuElement Common.IsolateEditBox) filepathValidator isolateDirL + & Menu.fieldLabelL .~ "isolated" + & Menu.fieldHelpMsgL .~ "install in an isolated absolute directory instead of the default one" + , Menu.createCheckBoxField (Common.MenuElement Common.ForceCheckBox) forceInstallL + & Menu.fieldLabelL .~ "force" + & Menu.fieldHelpMsgL .~ "Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)" + , Menu.createEditableField (Common.MenuElement Common.AdditionalEditBox) additionalValidator addConfArgsL + & Menu.fieldLabelL .~ "CONFIGURE_ARGS" + & Menu.fieldHelpMsgL .~ "Additional arguments to bindist configure, prefix with '-- ' (longopts)" + ] + + ok = Menu.createButtonField (Common.MenuElement Common.OkButton) + & Menu.fieldLabelL .~ "Advance Install" + & Menu.fieldHelpMsgL .~ "Install with options below" + +handler :: BrickEvent Name e -> EventM Name AdvanceInstallMenu () +handler = Menu.handlerMenu + + +draw :: AdvanceInstallMenu -> Widget Name +draw = Common.frontwardLayer "Advance Install" . Menu.drawMenu diff --git a/lib-tui/GHCup/Brick/Widgets/Menus/Context.hs b/lib-tui/GHCup/Brick/Widgets/Menus/Context.hs index 9d6ed17..44b2d9f 100644 --- a/lib-tui/GHCup/Brick/Widgets/Menus/Context.hs +++ b/lib-tui/GHCup/Brick/Widgets/Menus/Context.hs @@ -31,7 +31,7 @@ create lr exit_key = Menu.createMenu Common.ContextBox lr exit_key buttons [] & Menu.fieldLabelL .~ "Install" & Menu.fieldHelpMsgL .~ "Advance Installation Settings" compileButton = - Menu.createButtonField (MenuElement Common.AdvanceInstallButton) + Menu.createButtonField (MenuElement Common.CompilieButton) & Menu.fieldLabelL .~ "Compile" & Menu.fieldHelpMsgL .~ "Compile tool from source (to be implemented)" buttons = diff --git a/lib-tui/GHCup/Brick/Widgets/Tutorial.hs b/lib-tui/GHCup/Brick/Widgets/Tutorial.hs index 6c47b55..cba19a2 100644 --- a/lib-tui/GHCup/Brick/Widgets/Tutorial.hs +++ b/lib-tui/GHCup/Brick/Widgets/Tutorial.hs @@ -20,7 +20,6 @@ import qualified GHCup.Brick.Attributes as Attributes import Brick ( Padding(Max), Widget(..), - (<+>), (<=>)) import qualified Brick import Brick.Widgets.Center ( center ) diff --git a/lib-tui/GHCup/BrickMain.hs b/lib-tui/GHCup/BrickMain.hs index 1c53bf5..fe481c3 100644 --- a/lib-tui/GHCup/BrickMain.hs +++ b/lib-tui/GHCup/BrickMain.hs @@ -17,7 +17,7 @@ module GHCup.BrickMain where import GHCup.Types ( Settings(noColor), - AppState(ghcupInfo, settings, keyBindings, loggerConfig), KeyBindings (bQuit) ) + AppState(ghcupInfo, settings, keyBindings, loggerConfig), KeyBindings (..) ) import GHCup.Prelude.Logger ( logError ) import qualified GHCup.Brick.Actions as Actions import qualified GHCup.Brick.Common as Common @@ -26,6 +26,7 @@ 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 GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall import qualified Brick import Control.Monad.Reader ( ReaderT(runReaderT) ) @@ -63,6 +64,7 @@ brickMain s = do Common.defaultAppSettings initial_list (ContextMenu.create e exit_key) + (AdvanceInstall.create (bQuit . keyBindings $ s )) (keyBindings s) Common.Navigation in Brick.defaultMain initapp initstate