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

Add visuals for compile Menu

Browse Source
This commit is contained in:
Luis Morillo 2024-02-28 17:01:54 +01:00 committed by Julian Ospald
parent 33ace9557e
commit b619a65ede
No known key found for this signature in database
GPG Key ID: 4275CDA6A29BED43
8 changed files with 278 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
ghcup.cabal
View File

@ -334,6 +334,7 @@ library ghcup-tui
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.Widgets.Menus.AdvanceInstall
GHCup.Brick.Widgets.Menus.CompileGHC
GHCup.Brick.Actions GHCup.Brick.Actions
GHCup.Brick.App GHCup.Brick.App
GHCup.Brick.BrickState GHCup.Brick.BrickState

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

@ -28,6 +28,8 @@ import GHCup.Brick.BrickState
import GHCup.Brick.Widgets.SectionList import GHCup.Brick.Widgets.SectionList
import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu import qualified GHCup.Brick.Widgets.Menus.Context as ContextMenu
import GHCup.Brick.Widgets.Navigation (BrickInternalState) import GHCup.Brick.Widgets.Navigation (BrickInternalState)
import qualified GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
import qualified Brick import qualified Brick
import qualified Brick.Widgets.List as L import qualified Brick.Widgets.List as L
@ -73,7 +75,7 @@ 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.
@ -458,8 +460,9 @@ 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 advanceInstallMenu .= AdvanceInstall.create bQuit
compileGHCMenu .= CompileGHC.create bQuit
-- Set mode to context -- Set mode to context
mode .= ContextPanel mode .= ContextPanel
pure () pure ()

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

@ -25,7 +25,7 @@ module GHCup.Brick.App where
import qualified GHCup.Brick.Actions as Actions import qualified GHCup.Brick.Actions as Actions
import qualified GHCup.Brick.Attributes as Attributes import qualified GHCup.Brick.Attributes as Attributes
import GHCup.Brick.BrickState (BrickState (..), advanceInstallMenu, appKeys, appSettings, appState, contextMenu, mode) import GHCup.Brick.BrickState (BrickState (..), advanceInstallMenu, appKeys, appSettings, appState, contextMenu, mode, compileGHCMenu)
import GHCup.Brick.Common (Mode (..), Name (..)) import GHCup.Brick.Common (Mode (..), Name (..))
import qualified GHCup.Brick.Common as Common import qualified GHCup.Brick.Common as Common
import qualified GHCup.Brick.Widgets.KeyInfo as KeyInfo import qualified GHCup.Brick.Widgets.KeyInfo as KeyInfo
@ -64,6 +64,7 @@ import Optics.Operators ((^.))
import Optics.Optic ((%)) import Optics.Optic ((%))
import Optics.State (use) import Optics.State (use)
import Optics.State.Operators ((.=)) import Optics.State.Operators ((.=))
import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
app :: AttrMap -> AttrMap -> App BrickState () Name app :: AttrMap -> AttrMap -> App BrickState () Name
app attrs dimAttrs = app attrs dimAttrs =
@ -91,7 +92,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] AdvanceInstallPanel -> [AdvanceInstall.draw (st ^. advanceInstallMenu), navg]
CompileGHCPanel -> [CompileGHC.draw (st ^. compileGHCMenu), navg]
-- | On q, go back to navigation. -- | On q, go back to navigation.
@ -134,7 +136,7 @@ contextMenuHandler ev = do
&& 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) ) -> mode .= Common.AdvanceInstallPanel (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) ) -> mode .= Common.CompileGHCPanel
_ -> Common.zoom contextMenu $ ContextMenu.handler ev _ -> Common.zoom contextMenu $ ContextMenu.handler ev
-- --
advanceInstallHandler :: BrickEvent Name e -> EventM Name BrickState () advanceInstallHandler :: BrickEvent Name e -> EventM Name BrickState ()
@ -152,6 +154,21 @@ advanceInstallHandler ev = do
-> mode .= ContextPanel -> mode .= ContextPanel
_ -> Common.zoom advanceInstallMenu $ AdvanceInstall.handler ev _ -> Common.zoom advanceInstallMenu $ AdvanceInstall.handler ev
compileGHCHandler :: BrickEvent Name e -> EventM Name BrickState ()
compileGHCHandler ev = do
ctx <- use compileGHCMenu
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 compileGHCMenu $ CompileGHC.handler ev
eventHandler :: BrickEvent Name e -> EventM Name BrickState () eventHandler :: BrickEvent Name e -> EventM Name BrickState ()
eventHandler ev = do eventHandler ev = do
m <- use mode m <- use mode
@ -161,3 +178,4 @@ eventHandler ev = do
Navigation -> navigationHandler ev Navigation -> navigationHandler ev
ContextPanel -> contextMenuHandler ev ContextPanel -> contextMenuHandler ev
AdvanceInstallPanel -> advanceInstallHandler ev AdvanceInstallPanel -> advanceInstallHandler ev
CompileGHCPanel -> compileGHCHandler ev

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

@ -28,12 +28,13 @@ The linear relation above breaks if BrickState is defined in Common.
module GHCup.Brick.BrickState where module GHCup.Brick.BrickState where
import GHCup.Types ( KeyBindings ) 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 GHCup.Brick.Widgets.Menus.AdvanceInstall (AdvanceInstallMenu)
import Optics.TH (makeLenses) import GHCup.Brick.Widgets.Menus.CompileGHC (CompileGHCMenu)
import Optics.TH (makeLenses)
data BrickState = BrickState data BrickState = BrickState
@ -42,6 +43,7 @@ data BrickState = BrickState
, _appState :: BrickInternalState , _appState :: BrickInternalState
, _contextMenu :: ContextMenu , _contextMenu :: ContextMenu
, _advanceInstallMenu :: AdvanceInstallMenu , _advanceInstallMenu :: AdvanceInstallMenu
, _compileGHCMenu :: CompileGHCMenu
, _appKeys :: KeyBindings , _appKeys :: KeyBindings
, _mode :: Mode , _mode :: Mode
} }

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

@ -23,7 +23,30 @@ This module contains common values used across the library. Crucially it contain
-} -}
module GHCup.Brick.Common where module GHCup.Brick.Common (
installedSign,
setSign,
notInstalledSign,
showKey,
showMod,
keyToWidget,
separator,
frontwardLayer,
zoom,
defaultAppSettings,
lr,
showAllVersions,
Name(..),
Mode(..),
BrickData(..),
BrickSettings(..),
ResourceId (
UrlEditBox, SetCheckBox, IsolateEditBox, ForceCheckBox, AdditionalEditBox
, TargetGhcEditBox, BootstrapGhcEditBox, JobsEditBox, BuildConfigEditBox
, PatchesEditBox, CrossTargetEditBox, AddConfArgsEditBox, OvewrwiteVerEditBox
, BuildFlavourEditBox, BuildSystemEditBox, OkButton, AdvanceInstallButton
, CompilieButton
) ) where
import GHCup.List ( ListResult ) import GHCup.List ( ListResult )
import GHCup.Types ( Tool, KeyCombination (KeyCombination) ) import GHCup.Types ( Tool, KeyCombination (KeyCombination) )
@ -48,16 +71,45 @@ import qualified Brick.Widgets.Border.Style as Border
-- | A newtype for labeling resources in menus. It is bundled along with pattern synonyms -- | A newtype for labeling resources in menus. It is bundled along with pattern synonyms
newtype ResourceId = ResourceId Int deriving (Eq, Ord, Show) newtype ResourceId = ResourceId Int deriving (Eq, Ord, Show)
pattern OkButton :: ResourceId
pattern OkButton = ResourceId 0 pattern OkButton = ResourceId 0
pattern AdvanceInstallButton :: ResourceId
pattern AdvanceInstallButton = ResourceId 100 pattern AdvanceInstallButton = ResourceId 100
pattern CompilieButton :: ResourceId
pattern CompilieButton = ResourceId 101 pattern CompilieButton = ResourceId 101
pattern UrlEditBox :: ResourceId
pattern UrlEditBox = ResourceId 1 pattern UrlEditBox = ResourceId 1
pattern SetCheckBox :: ResourceId
pattern SetCheckBox = ResourceId 2 pattern SetCheckBox = ResourceId 2
pattern IsolateEditBox :: ResourceId
pattern IsolateEditBox = ResourceId 3 pattern IsolateEditBox = ResourceId 3
pattern ForceCheckBox :: ResourceId
pattern ForceCheckBox = ResourceId 4 pattern ForceCheckBox = ResourceId 4
pattern AdditionalEditBox :: ResourceId
pattern AdditionalEditBox = ResourceId 5 pattern AdditionalEditBox = ResourceId 5
pattern TargetGhcEditBox :: ResourceId
pattern TargetGhcEditBox = ResourceId 6
pattern BootstrapGhcEditBox :: ResourceId
pattern BootstrapGhcEditBox = ResourceId 7
pattern JobsEditBox :: ResourceId
pattern JobsEditBox = ResourceId 8
pattern BuildConfigEditBox :: ResourceId
pattern BuildConfigEditBox = ResourceId 9
pattern PatchesEditBox :: ResourceId
pattern PatchesEditBox = ResourceId 10
pattern CrossTargetEditBox :: ResourceId
pattern CrossTargetEditBox = ResourceId 11
pattern AddConfArgsEditBox :: ResourceId
pattern AddConfArgsEditBox = ResourceId 12
pattern OvewrwiteVerEditBox :: ResourceId
pattern OvewrwiteVerEditBox = ResourceId 13
pattern BuildFlavourEditBox :: ResourceId
pattern BuildFlavourEditBox = ResourceId 14
pattern BuildSystemEditBox :: ResourceId
pattern BuildSystemEditBox = ResourceId 15
-- | 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
@ -65,8 +117,9 @@ 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 Context Menu for a Tool | ContextBox -- ^ The resource for Context Menu
| AdvanceInstallBox -- ^ The Menu for AdvanceInstall | CompileGHCBox -- ^ The resource for CompileGHC Menu
| AdvanceInstallBox -- ^ The resource for AdvanceInstall Menu
| MenuElement ResourceId -- ^ Each element in a Menu. Resources must not be share for visible | 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 -- Menus, but MenuA and MenuB can share resources if they both are
-- invisible, or just one of them is visible. -- invisible, or just one of them is visible.
@ -79,6 +132,7 @@ data Mode = Navigation
| Tutorial | Tutorial
| ContextPanel | ContextPanel
| AdvanceInstallPanel | AdvanceInstallPanel
| CompileGHCPanel
deriving (Eq, Show, Ord) deriving (Eq, Show, Ord)
installedSign :: String installedSign :: String

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

@ -194,15 +194,14 @@ createEditableInput name validator = FieldInput initEdit validateEditContent ""
let let
borderBox = amp . Border.border . Brick.padRight Brick.Max borderBox = amp . Border.border . Brick.padRight Brick.Max
editorRender = Edit.renderEditor (Brick.txt . T.unlines) focus edi editorRender = Edit.renderEditor (Brick.txt . T.unlines) focus edi
isEditorEmpty = Edit.getEditContents edi == [mempty]
in case errMsg of in case errMsg of
Valid -> Valid | isEditorEmpty -> borderBox $ renderAsHelpMsg help
if Edit.getEditContents edi == [mempty] | otherwise -> borderBox editorRender
then borderBox $ renderAsHelpMsg help Invalid msg
else borderBox editorRender | focus && isEditorEmpty -> borderBox $ renderAsHelpMsg help
Invalid msg -> | focus -> borderBox editorRender
if focus | otherwise -> borderBox $ renderAsErrMsg msg
then borderBox editorRender
else borderBox $ renderAsErrMsg msg
validateEditContent = validator . T.unlines . Edit.getEditContents validateEditContent = validator . T.unlines . Edit.getEditContents
initEdit = Edit.editorText name (Just 1) "" initEdit = Edit.editorText name (Just 1) ""

177
lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs Normal file
View File

@ -0,0 +1,177 @@
{-# 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.CompileGHC (CompileGHCOptions, CompileGHCMenu, 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 (makeLenses)
import qualified GHCup.Brick.Common as Common
import GHCup.Types (KeyCombination, BuildSystem (Hadrian))
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)
import Data.Versions (Version, version)
import System.FilePath (isPathSeparator)
import Control.Applicative (Alternative((<|>)))
import Text.Read (readEither)
data CompileGHCOptions = CompileGHCOptions
{ _bootstrapGhc :: Either Version FilePath
, _jobs :: Maybe Int
, _buildConfig :: Maybe FilePath
, _patches :: Maybe (Either FilePath [URI])
, _crossTarget :: Maybe T.Text
, _addConfArgs :: [T.Text]
, _setCompile :: Bool
, _ovewrwiteVer :: Maybe Version
, _buildFlavour :: Maybe String
, _buildSystem :: Maybe BuildSystem
, _isolateDir :: Maybe FilePath
} deriving (Eq, Show)
makeLenses ''CompileGHCOptions
type CompileGHCMenu = Menu CompileGHCOptions Name
create :: KeyCombination -> CompileGHCMenu
create k = Menu.createMenu CompileGHCBox initialState k buttons fields
where
initialState =
CompileGHCOptions
(Right "")
Nothing
Nothing
Nothing
Nothing
[]
False
Nothing
Nothing
Nothing
Nothing
-- Brick's internal editor representation is [mempty].
emptyEditor i = T.null i || (i == "\n")
whenEmpty :: a -> (T.Text -> Either Menu.ErrorMessage a) -> T.Text -> Either Menu.ErrorMessage a
whenEmpty emptyval f i = if not (emptyEditor i) then f i else Right emptyval
bootstrapV :: T.Text -> Either Menu.ErrorMessage (Either Version FilePath)
bootstrapV i =
case not $ emptyEditor i of
True ->
let readVersion = bimap (const "Not a valid version") Left (version (T.init i)) -- Brick adds \n at the end, hence T.init
readPath
= if isPathSeparator (T.head i)
then pure $ Right (T.unpack i)
else Left "Not an absolute Path"
in if T.any isPathSeparator i
then readPath
else readVersion
False -> Left "Invalid Empty value"
versionV :: T.Text -> Either Menu.ErrorMessage (Maybe Version)
versionV = bimap (const "Not a valid version") Just . version . T.init -- Brick adds \n at the end, hence T.init
jobsV :: T.Text -> Either Menu.ErrorMessage (Maybe Int)
jobsV =
let parseInt = bimap (const "Invalid value. Must be an integer") Just . readEither @Int . T.unpack
in whenEmpty Nothing parseInt
patchesV :: T.Text -> Either Menu.ErrorMessage (Maybe (Either FilePath [URI]))
patchesV = whenEmpty Nothing readPatches
where
readUri :: T.Text -> Either String URI
readUri = first show . parseURI . UTF8.fromString . T.unpack
readPatches j =
let
x = (bimap T.unpack (fmap Left) $ filepathV j)
y = second (Just . Right) $ traverse readUri (T.split isSpace j)
in first T.pack $ x <|> y
filepathV :: T.Text -> Either Menu.ErrorMessage (Maybe FilePath)
filepathV = whenEmpty Nothing (Right . Just . T.unpack)
additionalValidator :: T.Text -> Either Menu.ErrorMessage [T.Text]
additionalValidator = Right . T.split isSpace
systemV :: T.Text -> Either Menu.ErrorMessage (Maybe BuildSystem)
systemV = whenEmpty Nothing readSys
where
readSys i
| T.toLower i == "hadrian" = Right $ Just Hadrian
| T.toLower i == "make" = Right $ Just Hadrian
| otherwise = Left "Not a valid Build System"
fields =
[ Menu.createEditableField (Common.MenuElement Common.BootstrapGhcEditBox) bootstrapV bootstrapGhc
& Menu.fieldLabelL .~ "bootstrap-ghc"
& Menu.fieldHelpMsgL .~ "The GHC version (or full path) to bootstrap with (must be installed)"
& Menu.fieldStatusL .~ Menu.Invalid "Invalid Empty value"
, Menu.createEditableField (Common.MenuElement Common.JobsEditBox) jobsV jobs
& Menu.fieldLabelL .~ "jobs"
& Menu.fieldHelpMsgL .~ "How many jobs to use for make"
, Menu.createEditableField (Common.MenuElement Common.BuildConfigEditBox) filepathV buildConfig
& Menu.fieldLabelL .~ "build config"
& Menu.fieldHelpMsgL .~ "Absolute path to build config file"
, Menu.createEditableField (Common.MenuElement Common.PatchesEditBox) patchesV patches
& Menu.fieldLabelL .~ "patches"
& Menu.fieldHelpMsgL .~ "Either a URI to a patch (https/http/file) or Absolute path to patch directory"
, Menu.createEditableField (Common.MenuElement Common.CrossTargetEditBox) (Right . Just) crossTarget
& Menu.fieldLabelL .~ "cross target"
& Menu.fieldHelpMsgL .~ "Build cross-compiler for this platform"
, Menu.createEditableField (Common.MenuElement Common.AdditionalEditBox) additionalValidator addConfArgs
& Menu.fieldLabelL .~ "CONFIGURE_ARGS"
& Menu.fieldHelpMsgL .~ "Additional arguments to bindist configure, prefix with '-- ' (longopts)"
, Menu.createCheckBoxField (Common.MenuElement Common.SetCheckBox) setCompile
& Menu.fieldLabelL .~ "set"
& Menu.fieldHelpMsgL .~ "Set as active version after install"
, Menu.createEditableField (Common.MenuElement Common.OvewrwiteVerEditBox) versionV ovewrwiteVer
& Menu.fieldLabelL .~ "overwrite-version"
& Menu.fieldHelpMsgL .~ "Allows to overwrite the finally installed VERSION with a different one"
, Menu.createEditableField (Common.MenuElement Common.BuildFlavourEditBox) (Right . Just . T.unpack) buildFlavour
& Menu.fieldLabelL .~ "flavour"
& Menu.fieldHelpMsgL .~ "Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
, Menu.createEditableField (Common.MenuElement Common.BuildSystemEditBox) systemV buildSystem
& Menu.fieldLabelL .~ "build system"
& Menu.fieldHelpMsgL .~ "Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"
, Menu.createEditableField (Common.MenuElement Common.IsolateEditBox) filepathV isolateDir
& Menu.fieldLabelL .~ "isolated"
& Menu.fieldHelpMsgL .~ "install in an isolated absolute directory instead of the default one"
]
buttons = [
Menu.createButtonField (Common.MenuElement Common.OkButton)
& Menu.fieldLabelL .~ "Compile"
& Menu.fieldHelpMsgL .~ "Compile GHC from source with options below"
]
handler :: BrickEvent Name e -> EventM Name CompileGHCMenu ()
handler = Menu.handlerMenu
draw :: CompileGHCMenu -> Widget Name
draw = Common.frontwardLayer "Compile GHC" . Menu.drawMenu

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

@ -27,6 +27,7 @@ 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 GHCup.Brick.Widgets.Menus.AdvanceInstall as AdvanceInstall
import qualified GHCup.Brick.Widgets.Menus.CompileGHC as CompileGHC
import qualified Brick import qualified Brick
import Control.Monad.Reader ( ReaderT(runReaderT) ) import Control.Monad.Reader ( ReaderT(runReaderT) )
@ -65,6 +66,7 @@ brickMain s = do
initial_list initial_list
(ContextMenu.create e exit_key) (ContextMenu.create e exit_key)
(AdvanceInstall.create (bQuit . keyBindings $ s )) (AdvanceInstall.create (bQuit . keyBindings $ s ))
(CompileGHC.create exit_key)
(keyBindings s) (keyBindings s)
Common.Navigation Common.Navigation
in Brick.defaultMain initapp initstate in Brick.defaultMain initapp initstate