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

Add visuals for Advance Install

Browse Source
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.SectionList
GHCup.Brick.Widgets.Menu GHCup.Brick.Widgets.Menu
GHCup.Brick.Widgets.Menus.Context GHCup.Brick.Widgets.Menus.Context
GHCup.Brick.Widgets.Menus.AdvanceInstall
GHCup.Brick.Actions GHCup.Brick.Actions
GHCup.Brick.App GHCup.Brick.App
GHCup.Brick.BrickState 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.Operators ((.~),(%~))
import Optics.Getter (view) import Optics.Getter (view)
import Optics.Optic ((%)) import Optics.Optic ((%))
import Optics (to) import Optics ((^.), to)
import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
{- Core Logic. {- Core Logic.
@ -89,11 +90,12 @@ This module defines the IO actions we can execute within the Brick App:
-- This synchronises @BrickInternalState@ with @BrickData@ -- This synchronises @BrickInternalState@ with @BrickData@
-- and @BrickSettings@. -- and @BrickSettings@.
updateList :: BrickData -> BrickState -> BrickState updateList :: BrickData -> BrickState -> BrickState
updateList appD st@BrickState{..} = updateList appD bst =
let newInternalState = constructList appD _appSettings (Just _appState) let newInternalState = constructList appD (bst ^. appSettings) (Just (bst ^. appState))
in st & appState .~ newInternalState in bst
& appData .~ appD & appState .~ newInternalState
& mode .~ Navigation & appData .~ appD
& mode .~ Navigation
constructList :: BrickData constructList :: BrickData
-> BrickSettings -> BrickSettings
@ -456,7 +458,8 @@ keyHandlers KeyBindings {..} =
Nothing -> pure () Nothing -> pure ()
Just (_, r) -> do Just (_, r) -> do
-- Create new menus -- Create new menus
contextMenu .= ContextMenu.create r bQuit contextMenu .= ContextMenu.create r bQuit
advanceInstallMenu .= AdvanceInstall.create bQuit
-- Set mode to context -- Set mode to context
mode .= ContextPanel mode .= ContextPanel
pure () pure ()

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

@ -23,42 +23,47 @@ module should only contain:
module GHCup.Brick.App where module GHCup.Brick.App where
import GHCup.Types ( AppState(AppState, keyBindings), KeyCombination(KeyCombination) ) import qualified GHCup.Brick.Actions as Actions
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.Attributes as Attributes import qualified GHCup.Brick.Attributes as Attributes
import qualified GHCup.Brick.Widgets.Navigation as Navigation import GHCup.Brick.BrickState (BrickState (..), advanceInstallMenu, appKeys, appSettings, appState, contextMenu, mode)
import qualified GHCup.Brick.Widgets.Tutorial as Tutorial 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.KeyInfo as KeyInfo
import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
import qualified GHCup.Brick.Actions as Actions import qualified GHCup.Brick.Widgets.Navigation as Navigation
import qualified GHCup.Brick.Widgets.Tutorial as Tutorial
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.Menu as Menu import qualified GHCup.Brick.Widgets.Menu as Menu
import Optics.Optic ((%)) import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
import qualified Brick.Focus as F
import Optics.Getter (to)
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 :: AttrMap -> AttrMap -> App BrickState () Name
app attrs dimAttrs = app attrs dimAttrs =
@ -86,6 +91,8 @@ drawUI dimAttrs st =
Tutorial -> [Tutorial.draw, navg] Tutorial -> [Tutorial.draw, navg]
KeyInfo -> [KeyInfo.draw (st ^. appKeys), navg] KeyInfo -> [KeyInfo.draw (st ^. appKeys), navg]
ContextPanel -> [ContextMenu.draw (st ^. contextMenu), navg] ContextPanel -> [ContextMenu.draw (st ^. contextMenu), navg]
AdvanceInstallPanel -> [AdvanceInstall.draw (st ^. advanceInstallMenu), navg]
-- | On q, go back to navigation. -- | On q, go back to navigation.
-- On Enter, to go to tutorial -- On Enter, to go to tutorial
@ -121,14 +128,29 @@ contextMenuHandler ev = do
(KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL (KeyCombination exitKey mods) = ctx ^. Menu.menuExitKeyL
case (ev, focusedElement) of case (ev, focusedElement) of
(_ , Nothing) -> pure () (_ , Nothing) -> pure ()
(VtyEvent (Vty.EvKey k m), Just n ) (VtyEvent (Vty.EvKey k m), Just n)
| k == exitKey | k == exitKey
&& m == mods && m == mods
&& n `elem` [Menu.fieldName button | button <- buttons] && n `elem` [Menu.fieldName button | button <- buttons]
-> mode .= Navigation -> 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 () (VtyEvent (Vty.EvKey Vty.KEnter []), Just (Common.MenuElement Common.CompilieButton) ) -> pure ()
_ -> Common.zoom contextMenu $ ContextMenu.handler ev _ -> 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 :: BrickEvent Name e -> EventM Name BrickState ()
eventHandler ev = do eventHandler ev = do
@ -138,3 +160,4 @@ eventHandler ev = do
Tutorial -> tutorialHandler ev Tutorial -> tutorialHandler ev
Navigation -> navigationHandler ev Navigation -> navigationHandler ev
ContextPanel -> contextMenuHandler 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.Common ( BrickData(..), BrickSettings(..), Mode(..))
import GHCup.Brick.Widgets.Navigation ( BrickInternalState) import GHCup.Brick.Widgets.Navigation ( BrickInternalState)
import GHCup.Brick.Widgets.Menus.Context (ContextMenu) import GHCup.Brick.Widgets.Menus.Context (ContextMenu)
import GHCup.Brick.Widgets.Menus.AdvanceInstall (AdvanceInstallMenu)
import Optics.TH (makeLenses) import Optics.TH (makeLenses)
data BrickState = BrickState data BrickState = BrickState
{ _appData :: BrickData { _appData :: BrickData
, _appSettings :: BrickSettings , _appSettings :: BrickSettings
, _appState :: BrickInternalState , _appState :: BrickInternalState
, _contextMenu :: ContextMenu , _contextMenu :: ContextMenu
, _appKeys :: KeyBindings , _advanceInstallMenu :: AdvanceInstallMenu
, _mode :: Mode , _appKeys :: KeyBindings
, _mode :: Mode
} }
--deriving Show --deriving Show

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

@ -52,20 +52,34 @@ pattern OkButton = ResourceId 0
pattern AdvanceInstallButton = ResourceId 100 pattern AdvanceInstallButton = ResourceId 100
pattern CompilieButton = ResourceId 101 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. -- | Name data type. Uniquely identifies each widget in the TUI.
-- some constructors might end up unused, but still is a good practise -- some constructors might end up unused, but still is a good practise
-- to have all of them defined, just in case -- to have all of them defined, just in case
data Name = AllTools -- ^ The main list widget data Name = AllTools -- ^ The main list widget
| Singular Tool -- ^ The particular list for each tool | Singular Tool -- ^ The particular list for each tool
| KeyInfoBox -- ^ The text box widget with action informacion | KeyInfoBox -- ^ The text box widget with action informacion
| TutorialBox -- ^ The tutorial widget | TutorialBox -- ^ The tutorial widget
| ContextBox -- ^ The resource for the context menu | ContextBox -- ^ The Context Menu for a Tool
| MenuElement ResourceId -- ^ The resource for field/buttons in a menu | 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) deriving (Eq, Ord, Show)
-- | Mode type. It helps to dispatch events to different handlers. -- | 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 installedSign :: String
#if IS_WINDOWS #if IS_WINDOWS
@ -88,6 +102,7 @@ notInstalledSign = "X "
notInstalledSign = "✗ " notInstalledSign = "✗ "
#endif #endif
showKey :: Vty.Key -> String showKey :: Vty.Key -> String
showKey (Vty.KChar c) = [c] showKey (Vty.KChar c) = [c]
showKey Vty.KUp = "↑" 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...) -- | 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 :: T.Text -> Brick.Widget n -> Brick.Widget n
frontwardLayer layer_name = frontwardLayer layer_name =
Brick.centerLayer Brick.centerLayer
. Brick.hLimitPercent 75 . Brick.hLimitPercent 75
. Brick.vLimitPercent 50 . Brick.vLimitPercent 50
. Brick.withBorderStyle Border.unicode . Brick.withBorderStyle Border.unicode
@ -132,4 +147,4 @@ data BrickSettings = BrickSettings { _showAllVersions :: Bool}
makeLenses ''BrickSettings makeLenses ''BrickSettings
defaultAppSettings :: 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 = buttonAmplifiers =
let buttonAsWidgets = fmap renderAslabel buttonLabels 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 drawButtons = fmap drawField buttonAmplifiers
buttonWidgets = zipWith (F.withFocusRing (menu ^. menuFocusRingL)) drawButtons (menu ^. menuButtonsL) 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.fieldLabelL .~ "Install"
& Menu.fieldHelpMsgL .~ "Advance Installation Settings" & Menu.fieldHelpMsgL .~ "Advance Installation Settings"
compileButton = compileButton =
Menu.createButtonField (MenuElement Common.AdvanceInstallButton) 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 (to be implemented)"
buttons = buttons =

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

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

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

@ -17,7 +17,7 @@ module GHCup.BrickMain where
import GHCup.Types import GHCup.Types
( Settings(noColor), ( Settings(noColor),
AppState(ghcupInfo, settings, keyBindings, loggerConfig), KeyBindings (bQuit) ) AppState(ghcupInfo, settings, keyBindings, loggerConfig), KeyBindings (..) )
import GHCup.Prelude.Logger ( logError ) import GHCup.Prelude.Logger ( logError )
import qualified GHCup.Brick.Actions as Actions import qualified GHCup.Brick.Actions as Actions
import qualified GHCup.Brick.Common as Common 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.BrickState as AppState
import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
import qualified GHCup.Brick.Widgets.SectionList as Navigation import qualified GHCup.Brick.Widgets.SectionList as Navigation
import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
import qualified Brick import qualified Brick
import Control.Monad.Reader ( ReaderT(runReaderT) ) import Control.Monad.Reader ( ReaderT(runReaderT) )
@ -63,6 +64,7 @@ brickMain s = do
Common.defaultAppSettings Common.defaultAppSettings
initial_list initial_list
(ContextMenu.create e exit_key) (ContextMenu.create e exit_key)
(AdvanceInstall.create (bQuit . keyBindings $ s ))
(keyBindings s) (keyBindings s)
Common.Navigation Common.Navigation
in Brick.defaultMain initapp initstate in Brick.defaultMain initapp initstate