Add visuals for Advance Install
This commit is contained in:
parent
16967bdc5f
commit
2a2385731b
@ -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
|
||||
|
@ -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 ()
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
107
lib-tui/GHCup/Brick/Widgets/Menus/AdvanceInstall.hs
Normal 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
|
@ -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 =
|
||||
|
@ -20,7 +20,6 @@ import qualified GHCup.Brick.Attributes as Attributes
|
||||
import Brick
|
||||
( Padding(Max),
|
||||
Widget(..),
|
||||
(<+>),
|
||||
(<=>))
|
||||
import qualified Brick
|
||||
import Brick.Widgets.Center ( center )
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user