hasufell
/
ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add visuals for Advance Install

This commit is contained in:
Luis Morillo 2024-02-28 10:29:39 +01:00
parent 6485e230cd
commit 3f80d41dd7
10 changed files with 212 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ghcup.cabal
View File

@ -332,6 +332,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

17
lib-tui/GHCup/Brick/Actions.hs
View File

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

89
lib-tui/GHCup/Brick/App.hs
View File

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

14
lib-tui/GHCup/Brick/BrickState.hs
View File

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

35
lib-tui/GHCup/Brick/Common.hs
View File

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

2
lib-tui/GHCup/Brick/Widgets/Menu.hs
View File

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

107
lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs Normal file
View File

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

2
lib-tui/GHCup/Brick/Widgets/Menus/Context.hs
View File

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

1
lib-tui/GHCup/Brick/Widgets/Tutorial.hs
View File

@ -20,7 +20,6 @@ import qualified GHCup.Brick.Attributes as Attributes
import Brick
( Padding(Max),
Widget(..),
(<+>),
(<=>))
import qualified Brick
import Brick.Widgets.Center ( center )

4
lib-tui/GHCup/BrickMain.hs
View File

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