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

simplify rendering for better ux

Browse Source
This commit is contained in:
Luis Morillo 2023-11-05 19:24:57 +01:00
parent 8f4246e716
commit 835352428a
1 changed files with 35 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
app/ghcup/BrickMain.hs
View File

@ -10,6 +10,7 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
module BrickMain where module BrickMain where
@ -32,7 +33,6 @@ import Brick
AttrMap, AttrMap,
EventM, EventM,
Size(..), Size(..),
Named(..),
Widget(..), Widget(..),
ViewportType (Vertical), ViewportType (Vertical),
(<+>), (<+>),
@ -62,7 +62,7 @@ import Data.IORef (IORef, readIORef, newIORef, writeIORef, modifyIORef
import Data.Vector ( Vector import Data.Vector ( Vector
) )
import Data.Versions import Data.Versions hiding (Lens')
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Exit import System.Exit
@ -114,9 +114,6 @@ makeLensesFor [("sectionListFocusRing", "sectionListFocusRingL"), ("sectionListE
type SectionList n e = GenericSectionList n V.Vector e type SectionList n e = GenericSectionList n V.Vector e
instance Named (GenericSectionList n t e) n where
getName = sectionListName
-- | Build a SectionList from nonempty list. If empty we could not defined sectionL lenses. -- | Build a SectionList from nonempty list. If empty we could not defined sectionL lenses.
sectionList :: Foldable t sectionList :: Foldable t
@ -206,29 +203,33 @@ handleGenericListEvent _ = pure ()
-- This re-uses Brick.Widget.List.renderList -- This re-uses Brick.Widget.List.renderList
renderSectionList :: (Traversable t, Ord n, Show n, Eq n, L.Splittable t) renderSectionList :: (Traversable t, Ord n, Show n, Eq n, L.Splittable t)
=> (Bool -> n -> Widget n) -- ^ Rendering function for separator between sections. True for selected before section => (Bool -> e -> Widget n) -- ^ Rendering function of the list element, True for the selected element
-> (Bool -> n -> Widget n -> Widget n) -- ^ Rendering function for the borders. True for selected section
-> (Bool -> e -> Widget n) -- ^ Rendering function of the list element, True for the selected element
-> Bool -- ^ Whether the section list has focus -> Bool -- ^ Whether the section list has focus
-> GenericSectionList n t e -- ^ The section list to render -> GenericSectionList n t e -- ^ The section list to render
-> Widget n -> Widget n
renderSectionList render_separator render_border render_elem section_focus (GenericSectionList focus elms sl_name) = renderSectionList render_elem section_focus (GenericSectionList focus elms sl_name) =
Widget Greedy Greedy $ render $ Brick.Widget Brick.Greedy Brick.Greedy $ do
Brick.viewport sl_name Vertical $ c <- Brick.getContext
V.foldl' (\wacc list -> let -- A section is focused if the whole thing is focused, and the inner list has focus
let has_focus_list = is_focused_section list section_is_focused l = section_focus && (Just (L.listName l) == F.focusGetCurrent focus)
list_name = L.listName list -- We need to limit the widget size when the length of the list is higher than the size of the terminal
in wacc limit = min (Brick.windowHeight c) (Brick.availHeight c)
<=> render_separator has_focus_list list_name s_idx = fromMaybe 0 $ V.findIndex section_is_focused elms
<=> inner_widget has_focus_list list_name list render_inner_list has_focus l = Brick.vLimit (length l) $ L.renderList (\b -> render_elem (b && has_focus)) has_focus l
(widget, off) =
V.ifoldl' (\wacc i list ->
let has_focus_list = section_is_focused list
(!acc_widget, !acc_off) = wacc
new_widget = if i == 0 then render_inner_list has_focus_list list else hBorder <=> render_inner_list has_focus_list list
new_off
| i < s_idx = 1 + L.listItemHeight list * length list
| i == s_idx = 1 + L.listItemHeight list * fromMaybe 0 (L.listSelected list)
| otherwise = 0
in (acc_widget <=> new_widget, acc_off + new_off)
) )
Brick.emptyWidget elms (Brick.emptyWidget, 0)
where elms
is_focused_section l = section_focus && Just (L.listName l) == F.focusGetCurrent focus Brick.render $ Brick.viewport sl_name Brick.Vertical $ Brick.translateBy (Brick.Location (0, min 0 (limit-off))) widget
inner_widget has_focus k l =
let w = render_border has_focus k (Brick.vLimit (length l) $ L.renderList render_elem has_focus l)
in if has_focus then Brick.visible w else w
-- | Equivalent to listSelectedElement -- | Equivalent to listSelectedElement
sectionListSelectedElement :: (Eq n, L.Splittable t, Traversable t, Semigroup (t e)) => GenericSectionList n t e -> Maybe (Int, e) sectionListSelectedElement :: (Eq n, L.Splittable t, Traversable t, Semigroup (t e)) => GenericSectionList n t e -> Maybe (Int, e)
@ -243,7 +244,6 @@ sectionListSelectedElement generic_section_list = do
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
| IODialog -- The pop up when installing a tool
| TutorialBox -- The tutorial widget | TutorialBox -- The tutorial widget
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
@ -318,7 +318,7 @@ keyHandlers KeyBindings {..} =
) )
, (bUp, const "Up", appState %= moveCursor 1 Up) , (bUp, const "Up", appState %= moveCursor 1 Up)
, (bDown, const "Down", appState %= moveCursor 1 Down) , (bDown, const "Down", appState %= moveCursor 1 Down)
, (Vty.KChar 'x', const "Tutorial", mode .= Tutorial) , (KeyCombination (Vty.KChar 'x') [], const "Tutorial", mode .= Tutorial)
] ]
where where
--hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m () --hideShowHandler' :: (BrickSettings -> Bool) -> (BrickSettings -> Bool) -> m ()
@ -350,7 +350,7 @@ ui dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..}
= Brick.padBottom Max = Brick.padBottom Max
( Brick.withBorderStyle unicode ( Brick.withBorderStyle unicode
$ borderWithLabel (Brick.str "GHCup") $ borderWithLabel (Brick.str "GHCup")
(center (header <=> renderList' _appState)) (center (header <=> hBorder <=> renderList' _appState))
) )
<=> footer <=> footer
where where
@ -371,14 +371,12 @@ ui dimAttrs BrickState{ _appSettings = as@BrickSettings{}, ..}
let allElements = V.concatMap L.listElements $ sectionListElements bis let allElements = V.concatMap L.listElements $ sectionListElements bis
minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) allElements minTagSize = V.maximum $ V.map (length . intercalate "," . fmap tagToString . lTag) allElements
minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) allElements minVerSize = V.maximum $ V.map (\ListResult{..} -> T.length $ tVerToText (GHCTargetVersion lCross lVer)) allElements
render_separator _ _ = hBorder in Brick.withDefAttr L.listAttr $ renderSectionList (renderItem minTagSize minVerSize) True bis
render_border _ _ = id
in Brick.withDefAttr L.listAttr $ renderSectionList render_separator render_border (renderItem minTagSize minVerSize) True bis
renderItem minTagSize minVerSize b listResult@ListResult{lTag = lTag', ..} = renderItem minTagSize minVerSize b listResult@ListResult{lTag = lTag', ..} =
let marks = if let marks = if
| lSet -> (Brick.withAttr (Brick.attrName "set") $ str setSign) | lSet -> (Brick.withAttr (Brick.attrName "set") $ Brick.str setSign)
| lInstalled -> (Brick.withAttr (Brick.attrName "installed") $ str installedSign) | lInstalled -> (Brick.withAttr (Brick.attrName "installed") $ Brick.str installedSign)
| otherwise -> (Brick.withAttr (Brick.attrName "not-installed") $ str notInstalledSign) | otherwise -> (Brick.withAttr (Brick.attrName "not-installed") $ Brick.str notInstalledSign)
ver = case lCross of ver = case lCross of
Nothing -> T.unpack . prettyVer $ lVer Nothing -> T.unpack . prettyVer $ lVer
Just c -> T.unpack (c <> "-" <> prettyVer lVer) Just c -> T.unpack (c <> "-" <> prettyVer lVer)
@ -529,7 +527,7 @@ navigationHandler ev = do
AppState { keyBindings = kb } <- liftIO $ readIORef settings' AppState { keyBindings = kb } <- liftIO $ readIORef settings'
case ev of case ev of
inner_event@(VtyEvent (Vty.EvKey key _)) -> inner_event@(VtyEvent (Vty.EvKey key _)) ->
case find (\(key', _, _) -> key' == key) (keyHandlers kb) of case find (\(key', _, _) -> key' == KeyCombination key []) (keyHandlers kb) of
Nothing -> void $ Brick.zoom (toLensVL appState) $ handleGenericListEvent inner_event Nothing -> void $ Brick.zoom (toLensVL appState) $ handleGenericListEvent inner_event
Just (_, _, handler) -> handler Just (_, _, handler) -> handler
inner_event -> Brick.zoom (toLensVL appState) $ handleGenericListEvent inner_event inner_event -> Brick.zoom (toLensVL appState) $ handleGenericListEvent inner_event
@ -611,7 +609,7 @@ replaceLR :: (ListResult -> Bool)
replaceLR filterF list_result s = replaceLR filterF list_result s =
let oldElem = s >>= sectionListSelectedElement -- Maybe (Int, e) let oldElem = s >>= sectionListSelectedElement -- Maybe (Int, e)
newVec = [(Singular $ lTool (head g), V.fromList g) | g <- groupBy ((==) `on` lTool ) (filter filterF list_result)] newVec = [(Singular $ lTool (head g), V.fromList g) | g <- groupBy ((==) `on` lTool ) (filter filterF list_result)]
newSectionList = sectionList AllTools newVec 0 newSectionList = sectionList AllTools newVec 1
in case oldElem of in case oldElem of
Just (_, el) -> selectBy (lTool el) (toolEqual el) newSectionList Just (_, el) -> selectBy (lTool el) (toolEqual el) newSectionList
Nothing -> selectLatest newSectionList Nothing -> selectLatest newSectionList
@ -631,7 +629,7 @@ filterVisible v e | lInstalled e = True
(Nightly `notElem` lTag e) (Nightly `notElem` lTag e)
install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m) install' :: (MonadReader AppState m, MonadIO m, MonadThrow m, MonadFail m, MonadMask m, MonadUnliftIO m, Alternative m)
=> (Int, ListResult) => (Int, ListResult)
-> m (Either String ()) -> m (Either String ())
install' (_, ListResult {..}) = do install' (_, ListResult {..}) = do