brick-tabular-list-0.2.0.0: src/Brick/Widgets/TabularList/Grid.hs
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TupleSections #-}
-- | Grid tabular list is a uniform grid that supports cell-by-cell navigation.
--
--   
--
-- Read [Shared Traits of Tabular List Widgets]("Brick.Widgets.TabularList#g:SharedTraitsOfTabularListWidgets")
-- before reading further.
--
-- Because this list is designed to show an arbitrary number of columns, horizontal scrolling is supported through
-- cell-by-cell navigation.
--
-- Grid tabular list tries to show the current column in the center. If it can't show the current column in the center,
-- it shows the first column in the left corner or the last column in the right corner.
--
-- It should be fast enough to handle a large spreadsheet. It is also suitable for an interface to a database table.
module Brick.Widgets.TabularList.Grid (
-- * Data types
GridContents(..)
, GridContext(..)
, GridRenderers(..)
, GridSizes(..)
, GridTabularList(..)
-- * List construction
, gridTabularList
-- * Rendering
, renderGridTabularList
-- * Column navigation
, gridMoveLeft
, gridMoveRight
, gridMoveTo
, gridMoveToBeginning
, gridMoveToEnd
, gridMovePageUp
, gridMovePageDown
-- * Event handlers
, handleGridListEvent
, handleGridListEventVi
-- * Shared types
, module Brick.Widgets.TabularList.Types
) where
import Brick.Widgets.TabularList.Types
import Brick.Widgets.TabularList.Internal.Common
import Brick.Widgets.TabularList.Internal.Lens
-- base
import GHC.Generics (Generic)
import Data.Foldable (toList)
import Control.Monad (unless)
-- Third party libraries
import Optics.Core hiding (Empty)
import qualified Data.Sequence as S
import Data.Sequence (Seq(..))
import Data.Generics.Labels
-- Brick & Vty
import qualified Brick.Widgets.List as L
import Brick.Types
import Brick.Widgets.Core
import Brick.Widgets.Center
import Graphics.Vty (Event(..), Key(..), Modifier(..))
import Brick.Main (lookupViewport)
-- | Functions for getting contents of grid tabular list elements.
-- See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data GridContents n row cell rowH colH = GridContents {
cell :: row -> ColumnIndex -> Maybe cell
, rowHdr :: Maybe (row -> RowIndex -> Maybe rowH)
, colHdr :: Maybe (ColumnIndex -> Maybe colH)
} deriving Generic
-- | Context information for grid cells
data GridContext = GridContext {
row :: Position -- ^ Position among rows
, col :: Position -- ^ Position among columns
} deriving (Show, Generic)
-- | Rendering functions for elements of grid tabular list. See
--
-- * [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data GridRenderers n row cell rowH colH = GridRenderers {
drawCell :: ListFocused -> WidthDeficit -> GridContext -> row -> Maybe cell -> Widget n
, drawRowHdr :: Maybe (ListFocused -> WidthDeficit -> Position -> row -> Maybe rowH -> Widget n)
, drawColHdr :: Maybe (ListFocused -> WidthDeficit -> Position -> Maybe colH -> Widget n)
, drawColHdrRowHdr :: Maybe (ListFocused -> WidthDeficit -> Widget n)
} deriving Generic
-- | Sizes for elements of grid tabular list.
-- See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data GridSizes rowH = GridSizes {
row :: Seq Width -- ^ Widths for column headers and row columns
, rowHdr :: Maybe (RowHeaderWidth rowH) -- ^ Width for row headers
, colHdr :: Maybe Height -- ^ Height for column headers
} deriving Generic
-- | See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data GridTabularList n row cell rowH colH = GridTabularList {
list :: L.GenericList n Seq row -- ^ The underlying primitive list that comes from brick.
, sizes :: GridSizes rowH
, contents :: GridContents n row cell rowH colH
, currentColumn :: ColumnIndex
} deriving Generic
-- | Create a grid tabular list
gridTabularList :: n -- ^ The list name (must be unique)
-> Seq row -- ^ The initial list rows
-> ListItemHeight
-> GridSizes rowH
-> GridContents n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridTabularList n rows h sizes contents = GridTabularList {
list = L.list n rows h
, sizes = sizes
, contents = contents
, currentColumn = 0
}
data VisibleColumns =
-- | No column is visible
NoColumn
-- | Only current column is visible
| CurrentColumn
-- | The first column is shown at the left corner.
| AnchoredLeft {
right :: Int -- ^ The rightmost column that is visible
}
-- | The current column is shown in the center
| MiddleColumns {
-- | The leftmost visible column
left :: Int,
-- | The rightmost visible column
right :: Int,
-- | Slide the columns to the left by this offset to show the current column in the center
offset :: Int,
-- | Total widths of all visible columns.
totalWidth :: Int
}
-- | The last column is shown at the right corner.
| AnchoredRight {
-- | The leftmost visible column
left :: Int,
-- | Slide the columns to the left by this offset to show the last column at the right corner.
offset :: Int,
-- | Total widths of all visible columns.
totalWidth :: Int
}
deriving Show
-- | Calculate visible columns with the width available for columns. It tries to show the current column in the center.
-- If it can't show the current column in the center, the first column is shown at the left corner, or the last column
-- is shown at the right corner.
visibleColumns :: GridTabularList n row cell rowH colH -> AvailWidth -> VisibleColumns
visibleColumns l aW = let curCol = l ^. #currentColumn in
case S.splitAt curCol (l ^. #sizes % #row) of
-- If current column is outside the boundary of row columns, return `NoColumn`.
(_, Empty) -> NoColumn
(left, cW :<| right) -> if aW <= 0
-- If the available width is 0 or less than 0,
then NoColumn
-- If the available width is less than the current column's width,
else if cW >= aW
then CurrentColumn
-- Otherwise, calculate the leftmost visible column for the current column shown in the center.
else let
-- The amount of space to the left of the current column shown in the center.
lW = (aW - cW) `div` 2
-- The amount of space to the right of the current column shown in the center.
rW = aW - lW - cW
-- Calculate the leftmost visible column for the current column shown in the center.
leftForMiddle (l :|> w) idx accW = if accW+w < lW
-- If the leftmost visible column hasn't been reached, go to the left by one column.
then leftForMiddle l (idx-1) (accW+w)
-- If the leftmost visible column has been reached, calculate the rightmost visible column.
else rightForMiddle idx (accW+w) right (curCol+1) 0
-- If there aren't enough columns to the left of the current column shown in the center, calculate the rightmost
-- visible column for the first column shown at the left corner.
leftForMiddle Empty _ accW = rightForLeft right (curCol+1) (accW+cW)
-- Calculate the rightmost visible column for the current column shown in the center.
rightForMiddle li lAccW (w :<| r) ri accW = if accW+w < rW
-- If the rightmost visible column hasn't been reached, go to the right by one column.
then rightForMiddle li lAccW r (ri+1) (accW+w)
-- If the rightmost visible column has been reached, return 'MiddleColumns'.
else MiddleColumns { left = li, right = ri, offset = lAccW-lW, totalWidth = lAccW+cW+accW+w }
-- If there aren't enough columns to the right of the current column shown in the center, calculate the leftmost
-- visible column for the last column shown at the right corner.
rightForMiddle _ _ Empty _ accW = leftForRight left (curCol-1) (accW+cW)
-- Calculate the rightmost visible column for the first column shown at the left corner.
rightForLeft (w :<| r) idx accW = if accW+w < aW
-- If the rightmost visible column hasn't been reached, go to the right by one column.
then rightForLeft r (idx+1) (accW+w)
-- If the rightmost visible column has been reached, return 'AnchoredLeft'.
else AnchoredLeft idx
-- If there aren't enough columns to fill the available width with the first column at the left corner, return
-- 'AnchoredLeft' with the last column as the rightmost visible column.
rightForLeft Empty idx _ = AnchoredLeft (idx-1)
-- Calculate the leftmost visible column for the last column shown at the right corner.
leftForRight (l :|> w) idx accW = if accW+w < aW
-- If the leftmost visible column hasn't been reached, go to the left by one column.
then leftForRight l (idx-1) (accW+w)
-- If the leftmost visible column has been reached, return 'AnchoredRight'.
else AnchoredRight { left = idx, offset = accW+w-aW, totalWidth = accW+w }
-- If there aren't enough columns to fill the available width with the last column at the right corner, return
-- 'AnchoredLeft' with the last column as the rightmost visible column.
leftForRight Empty _ _ = AnchoredLeft $ length (l ^. #sizes % #row) - 1
in leftForMiddle left (curCol-1) 0
renderColumns :: GridTabularList n row cell rowH colH
-> VisibleColumns
-> (WidthDeficit -> ColumnIndex -> Width -> Widget n)
-> Widget n
renderColumns l vCs dC = Widget Greedy Fixed $ do
c <- getContext
let cWs = l ^. #sizes % #row
iH = l ^. #list % #listItemHeight
curCol = l ^. #currentColumn
aW = c^^.availWidthL
render $ case vCs of
NoColumn -> emptyWidget
CurrentColumn -> case S.lookup curCol cWs of
Nothing -> error $ "Current column, " <> show curCol <> " is outside the boundary of column widths."
Just cW -> dC (max 0 $ cW - aW) curCol aW
AnchoredLeft right -> hBox $ zipWith (dC 0) [0..] $ toList $ S.take (right+1) cWs
MiddleColumns {..} -> cropLeftBy offset $ setAvailableSize (totalWidth, iH) $
hBox $ zipWith (dC 0) [left..] $ toList $ S.take (right-left+1) $ S.drop left cWs
AnchoredRight {..} -> cropLeftBy offset $ setAvailableSize (totalWidth, iH) $
hBox $ zipWith (dC 0) [left..] $ toList $ S.drop left cWs
-- | Render grid tabular list
renderGridTabularList :: (Ord n, Show n)
=> GridRenderers n row cell rowH colH -- ^ Renderers
-> ListFocused
-> GridTabularList n row cell rowH colH -- ^ The list
-> Widget n
renderGridTabularList r lf l = Widget Greedy Greedy $ do
c <- getContext
let drawCell = r ^. #drawCell
cell = l ^. #contents % #cell
list = l ^. #list
curCol = l ^. #currentColumn
aW = c^^.availWidthL
aH = c^^.availHeightL
iH = list ^. #listItemHeight
wSet = setAvailableSize . (, iH)
colHdrRow vCs rhw' rhwd = case (l ^. #contents % #colHdr, l ^. #sizes % #colHdr, r ^. #drawColHdr) of
(Nothing, _, _) -> emptyWidget
(_, Nothing, _) -> emptyWidget
(_, _, Nothing) -> emptyWidget
(Just colH, Just colHdrH, Just dch) -> let
drawCol wd c w = setAvailableSize (w, colHdrH) $ dch lf wd (Position c (c == curCol)) $ colH c
chrw = case r ^. #drawColHdrRowHdr of
Nothing -> fill ' '
Just dchrw -> dchrw lf rhwd
in setAvailableSize (rhw', colHdrH) chrw <+> renderColumns l vCs drawCol
renderRow vCs i f r = let
drawCol wd c w = let gc = GridContext (Position i f) (Position c $ c == curCol)
in wSet w $ drawCell lf wd gc r $ cell r c
in renderColumns l vCs drawCol
renderList = let vCs = visibleColumns l aW in
render $ colHdrRow vCs 0 0 <=> L.renderListWithIndex (renderRow vCs) lf list
renderHdrList rh rhw drh = let
rhw' = min rhw aW
rhwd = max 0 $ rhw - aW
vCs = visibleColumns l $ aW - rhw'
renderHdrRow i f row = wSet rhw' (drh lf rhwd (Position i f) row $ rh row i) <+> renderRow vCs i f row
in render $ colHdrRow vCs rhw' rhwd <=> L.renderListWithIndex renderHdrRow lf list
case (l ^. #contents % #rowHdr, l ^. #sizes % #rowHdr, r ^. #drawRowHdr) of
(Nothing, _, _) -> renderList
(_, Nothing, _) -> renderList
(_, _, Nothing) -> renderList
(Just rh, Just (FixedRowHeader w), Just drh) -> renderHdrList rh w drh
(Just rh, Just (AvailRowHeader w), Just drh) -> renderHdrList rh (w aW) drh
(Just rh, Just (VisibleRowHeaders w), Just drh) -> renderHdrList rh (w aW $ visibleRowHdrs list aH rh) drh
-- | Move to the left by one column.
gridMoveLeft :: GridTabularList n row cell rowH colH -- ^ The list
-> GridTabularList n row cell rowH colH
gridMoveLeft gl = if null $ gl ^. #list % #listSelected
then gl
else gl & #currentColumn %~ max 0 . subtract 1
-- | Move to the right by one column.
gridMoveRight :: GridTabularList n row cell rowH colH -- ^ The list
-> GridTabularList n row cell rowH colH
gridMoveRight gl = if null $ gl ^. #list % #listSelected
then gl
else gl & #currentColumn %~ min (length (gl ^. #sizes % #row) - 1) . (+1)
-- | Move to the given column index
gridMoveTo :: ColumnIndex
-> GridTabularList n row cell rowH colH -- ^ The list
-> GridTabularList n row cell rowH colH
gridMoveTo n gl = if null $ gl ^. #list % #listSelected
then gl
else gl & #currentColumn .~ (max 0 . min (length (gl ^. #sizes % #row) - 1)) n
-- | Move to the first column.
gridMoveToBeginning :: GridTabularList n row cell rowH colH -- ^ The list
-> GridTabularList n row cell rowH colH
gridMoveToBeginning gl = if null $ gl ^. #list % #listSelected
then gl
else gl & #currentColumn .~ 0
-- | Move to the last column.
gridMoveToEnd :: GridTabularList n row cell rowH colH -- ^ The list
-> GridTabularList n row cell rowH colH
gridMoveToEnd gl = if null $ gl ^. #list % #listSelected
then gl
else gl & #currentColumn .~ length (gl ^. #sizes % #row) - 1
-- | 'GridRenderers' are needed because if row header renderer doesn't exist, width calculation is affected.
gridMovePage :: Ord n
=> GridRenderers n row cell rowH colH
-> (VisibleColumns -> EventM n (GridTabularList n row cell rowH colH) ())
-> EventM n (GridTabularList n row cell rowH colH) ()
gridMovePage r f = do
l <- get
unless (null $ l ^. #list % #listSelected) $ do
v <- lookupViewport $ l ^. #list % #listName
case v of
Nothing -> return ()
Just vp -> let
(aW, aH) = vp ^. #_vpSize
rhw = case (l ^. #contents % #rowHdr, l ^. #sizes % #rowHdr, r ^. #drawRowHdr) of
(Nothing, _, _) -> 0
(_, Nothing, _) -> 0
(_, _, Nothing) -> 0
(_, Just (FixedRowHeader w), _) -> w
(_, Just (AvailRowHeader w), _) -> w aW
(Just rowH, Just (VisibleRowHeaders w), _) -> w aW $ visibleRowHdrs (l ^. #list) aH rowH
in f $ visibleColumns l $ aW - rhw
-- | Move to the previous page of columns.
--
-- 'GridRenderers' are needed because if row header renderer doesn't exist, width calculation is affected.
gridMovePageUp :: Ord n
=> GridRenderers n row cell rowH colH -- ^ Renderers
-> EventM n (GridTabularList n row cell rowH colH) ()
gridMovePageUp r = gridMovePage r $ \case
NoColumn -> return ()
CurrentColumn -> modify gridMoveLeft
AnchoredLeft {} -> modify gridMoveToBeginning
MiddleColumns {..} -> modify $ gridMoveTo left
AnchoredRight {..} -> modify $ gridMoveTo left
-- | Move to the next page of columns.
--
-- 'GridRenderers' are needed because if row header renderer doesn't exist, width calculation is affected.
gridMovePageDown :: Ord n
=> GridRenderers n row cell rowH colH -- ^ Renderers
-> EventM n (GridTabularList n row cell rowH colH) ()
gridMovePageDown r = gridMovePage r $ \case
NoColumn -> return ()
CurrentColumn -> modify gridMoveRight
AnchoredLeft {..} -> modify $ gridMoveTo right
MiddleColumns {..} -> modify $ gridMoveTo right
AnchoredRight {} -> modify gridMoveToEnd
-- | Handle events for grid tabular list with navigation keys.
--
-- It adds the following keyboard shortcuts to 'L.handleListEvent'.
--
-- * Move to the left by one column (Left arrow key)
-- * Move to the right by one column (Right arrow key)
-- * Go to the first column (Ctrl+Home)
-- * Go to the last column (Ctrl+End)
-- * Move to the previous page of columns (Ctrl+PageUp)
-- * Move to the next page of columns (Ctrl+PageDown)
--
-- 'GridRenderers' are needed because if row header renderer doesn't exist, width calculation is affected.
handleGridListEvent :: Ord n
=> GridRenderers n row cell rowH colH -- ^ Renderers
-> Event -> EventM n (GridTabularList n row cell rowH colH) ()
handleGridListEvent r e = case e of
EvKey KLeft [] -> modify gridMoveLeft
EvKey KRight [] -> modify gridMoveRight
EvKey KHome [MCtrl] -> modify gridMoveToBeginning
EvKey KEnd [MCtrl] -> modify gridMoveToEnd
EvKey KPageUp [MCtrl] -> gridMovePageUp r
EvKey KPageDown [MCtrl] -> gridMovePageDown r
_ -> zoom #list (L.handleListEvent e)
-- | Handle events for grid tabular list with vim keys.
--
-- It adds the following keyboard shortcuts to 'L.handleListEventVi'.
--
-- * Move to the left by one column (h)
-- * Move to the right by one column (l)
-- * Go to the first column (H)
-- * Go to the last column (L)
-- * Move to the previous page of columns (Alt+h)
-- * Move to the next page of columns (Alt+l)
--
-- 'GridRenderers' are needed because if row header renderer doesn't exist, width calculation is affected.
handleGridListEventVi :: Ord n
=> GridRenderers n row cell rowH colH -- ^ Renderers
-> Event -> EventM n (GridTabularList n row cell rowH colH) ()
handleGridListEventVi r e = case e of
EvKey (KChar 'h') [] -> modify gridMoveLeft
EvKey (KChar 'l') [] -> modify gridMoveRight
EvKey (KChar 'H') [] -> modify gridMoveToBeginning
EvKey (KChar 'L') [] -> modify gridMoveToEnd
EvKey (KChar 'h') [MMeta] -> gridMovePageUp r
EvKey (KChar 'l') [MMeta] -> gridMovePageDown r
EvKey (KChar 'h') [MAlt] -> gridMovePageUp r
EvKey (KChar 'l') [MAlt] -> gridMovePageDown r
_ -> zoom #list (L.handleListEventVi (\_ -> return ()) e)