{-# 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 #-} {- A general system for lists with sections Consider this code as private. GenericSectionList should not be used directly as the FocusRing should be align with the Vector containing the elements, otherwise you'd be focusing on a non-existent widget with unknown result (In theory the code is safe unless you have an empty section list). - To build a SectionList use the safe constructor sectionList - To access sections use the lens provider sectionL and the name of the section you'd like to access - You can modify Brick.Widget.List.GenericList within GenericSectionList via sectionL but do not modify the vector length -} module GHCup.Brick.Widgets.SectionList where import Brick ( BrickEvent(VtyEvent, MouseDown), EventM, Size(..), Widget(..), ViewportType (Vertical), (<=>)) import qualified Brick import Brick.Widgets.Border ( hBorder) import qualified Brick.Widgets.List as L import Brick.Focus (FocusRing) import qualified Brick.Focus as F import Data.Function ( (&)) import Data.Maybe ( fromMaybe ) import Data.Vector ( Vector ) import qualified GHCup.Brick.Common as Common import Prelude hiding ( appendFile ) import qualified Graphics.Vty as Vty import qualified Data.Vector as V import Optics.TH (makeLensesFor) import Optics.State (use) import Optics.State.Operators ( (%=), (<%=)) import Optics.Operators ((.~), (^.)) import Optics.Lens (Lens', lens) data GenericSectionList n t e = GenericSectionList { sectionListFocusRing :: FocusRing n -- ^ The FocusRing for all sections , sectionListElements :: !(Vector (L.GenericList n t e)) -- ^ A vector of brick's built-in list , sectionListName :: n -- ^ The section list name } makeLensesFor [("sectionListFocusRing", "sectionListFocusRingL"), ("sectionListElements", "sectionListElementsL"), ("sectionListName", "sectionListNameL")] ''GenericSectionList type SectionList n e = GenericSectionList n V.Vector e -- | Build a SectionList from nonempty list. If empty we could not defined sectionL lenses. sectionList :: Foldable t => n -- The name of the section list -> [(n, t e)] -- a list of tuples (section name, collection of elements) -> Int -> GenericSectionList n t e sectionList name elements height = GenericSectionList { sectionListFocusRing = F.focusRing [section_name | (section_name, _) <- elements] , sectionListElements = V.fromList [L.list section_name els height | (section_name, els) <- elements] , sectionListName = name } -- | This lens constructor, takes a name and looks if a section has such a name. -- Used to dispatch events to sections. It is a partial function only meant to -- be used with the FocusRing inside GenericSectionList sectionL :: Eq n => n -> Lens' (GenericSectionList n t e) (L.GenericList n t e) sectionL section_name = lens g s where is_section_name = (== section_name) . L.listName g section_list = let elms = section_list ^. sectionListElementsL zeroth = elms V.! 0 -- TODO: This crashes for empty vectors. in fromMaybe zeroth (V.find is_section_name elms) s gl@(GenericSectionList _ elms _) list = case V.findIndex is_section_name elms of Nothing -> gl Just i -> let new_elms = V.update elms (V.fromList [(i, list)]) in gl & sectionListElementsL .~ new_elms moveDown :: (L.Splittable t, Ord n, Foldable t) => EventM n (GenericSectionList n t e) () moveDown = do ring <- use sectionListFocusRingL case F.focusGetCurrent ring of Nothing -> pure () Just l -> do -- If it is the last element, move to the first element of the next focus; else, just handle regular list event. current_list <- use (sectionL l) let current_idx = L.listSelected current_list list_length = current_list & length if current_idx == Just (list_length - 1) then do new_focus <- sectionListFocusRingL <%= F.focusNext case F.focusGetCurrent new_focus of Nothing -> pure () -- |- Optic.Zoom.zoom doesn't typecheck but Lens.Micro.Mtl.zoom does. It is re-exported by Brick Just new_l -> Common.zoom (sectionL new_l) (Brick.modify L.listMoveToBeginning) else Common.zoom (sectionL l) $ Brick.modify L.listMoveDown moveUp :: (L.Splittable t, Ord n, Foldable t) => EventM n (GenericSectionList n t e) () moveUp = do ring <- use sectionListFocusRingL case F.focusGetCurrent ring of Nothing -> pure () Just l -> do -- If it is the first element, move to the last element of the prev focus; else, just handle regular list event. current_list <- use (sectionL l) let current_idx = L.listSelected current_list if current_idx == Just 0 then do new_focus <- sectionListFocusRingL <%= F.focusPrev case F.focusGetCurrent new_focus of Nothing -> pure () Just new_l -> Common.zoom (sectionL new_l) (Brick.modify L.listMoveToEnd) else Common.zoom (sectionL l) $ Brick.modify L.listMoveUp -- | Handle events for list cursor movement. Events handled are: -- -- * Up (up arrow key). If first element of section, then jump prev section -- * Down (down arrow key). If last element of section, then jump next section -- * Page Up (PgUp) -- * Page Down (PgDown) -- * Go to next section (Tab) -- * Go to prev section (BackTab) handleGenericListEvent :: (Foldable t, L.Splittable t, Ord n) => BrickEvent n a -> EventM n (GenericSectionList n t e) () handleGenericListEvent (VtyEvent (Vty.EvResize _ _)) = pure () handleGenericListEvent (VtyEvent (Vty.EvKey (Vty.KChar '\t') [])) = sectionListFocusRingL %= F.focusNext handleGenericListEvent (VtyEvent (Vty.EvKey Vty.KBackTab [])) = sectionListFocusRingL %= F.focusPrev handleGenericListEvent (MouseDown _ Vty.BScrollDown _ _) = moveDown handleGenericListEvent (MouseDown _ Vty.BScrollUp _ _) = moveUp handleGenericListEvent (VtyEvent (Vty.EvKey Vty.KDown [])) = moveDown handleGenericListEvent (VtyEvent (Vty.EvKey Vty.KUp [])) = moveUp handleGenericListEvent (VtyEvent ev) = do ring <- use sectionListFocusRingL case F.focusGetCurrent ring of Nothing -> pure () Just l -> Common.zoom (sectionL l) $ L.handleListEvent ev handleGenericListEvent _ = pure () -- This re-uses Brick.Widget.List.renderList renderSectionList :: (Traversable t, Ord n, Show n, Eq n, L.Splittable t) => (Bool -> e -> Widget n) -- ^ Rendering function of the list element, True for the selected element -> Bool -- ^ Whether the section list has focus -> GenericSectionList n t e -- ^ The section list to render -> Widget n renderSectionList render_elem section_focus (GenericSectionList focus elms sl_name) = Brick.Widget Brick.Greedy Brick.Greedy $ do c <- Brick.getContext let -- A section is focused if the whole thing is focused, and the inner list has focus section_is_focused l = section_focus && (Just (L.listName l) == F.focusGetCurrent focus) -- We need to limit the widget size when the length of the list is higher than the size of the terminal limit = min (Brick.windowHeight c) (Brick.availHeight c) s_idx = fromMaybe 0 $ V.findIndex section_is_focused elms 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, 0) elms Brick.render $ Brick.viewport sl_name Brick.Vertical $ Brick.translateBy (Brick.Location (0, min 0 (limit-off))) widget -- | Equivalent to listSelectedElement sectionListSelectedElement :: (Eq n, L.Splittable t, Traversable t, Semigroup (t e)) => GenericSectionList n t e -> Maybe (Int, e) sectionListSelectedElement generic_section_list = do current_focus <- generic_section_list ^. sectionListFocusRingL & F.focusGetCurrent let current_section = generic_section_list ^. sectionL current_focus L.listSelectedElement current_section