brick-tabular-list-1.0.0.1: src/Brick/Widgets/TabularList/Grid.hs
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-- | Grid tabular list is a uniform grid that supports cell-by-cell navigation.
--
--   
--
-- Because this list is designed to show arbitrary numbers 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
GridContext(..)
, GridColHdr(..)
, GridRenderers(..)
, GridWidths
, GridTabularList(..)
-- * List construction
, gridTabularList
-- * Rendering
, renderGridTabularList
-- * Column navigation #ColumnNavigation#
, 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 ( (&), (%), (%~), (.~), (^.) )
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 Graphics.Vty (Event(..), Key(..), Modifier(..))
import Brick.Main (lookupViewport)
-- | Context for grid cells
data GridContext = GridContext {
row :: FlatContext -- ^ Row context
, col :: FlatContext -- ^ Column context
} deriving (Show, Generic)
-- | Grid column header
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data GridColHdr n = GridColHdr {
draw :: ListFocused -> WidthDeficit -> FlatContext -> Widget n
, height :: Height -- ^ Height for column headers and column header row header
} deriving Generic
-- | Rendering functions for components of grid tabular list
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data GridRenderers n e r = GridRenderers {
drawCell :: ListFocused -> WidthDeficit -> GridContext -> e -> Widget n
, rowHdr :: Maybe (RowHdr n e r)
, colHdr :: Maybe (GridColHdr n)
, drawColHdrRowHdr :: DrawColHdrRowHdr n
} deriving Generic
-- | Widths for column headers and row columns.
type GridWidths = Seq Width
-- | * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
data GridTabularList n e = GridTabularList {
-- | The underlying primitive list that comes from brick
list :: L.GenericList n Seq e
, widths :: GridWidths
-- | Manipulating this field directly is unsafe. Use
-- [column navigation]("Brick.Widgets.TabularList.Grid#g:ColumnNavigation") functions to manipulate this. If you still
-- want to manipulate this directly, create a function that manipulates it, and test the function properly.
, currentColumn :: Index
} deriving Generic
-- | Create a grid tabular list
gridTabularList
:: n -- ^ The list name (must be unique)
-> Seq e -- ^ The initial list elements
-> ListItemHeight
-> GridWidths
-> GridTabularList n e
gridTabularList n rows h widths = GridTabularList {
list = L.list n rows h
, widths = widths
, 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 e -> AvailWidth -> VisibleColumns
visibleColumns l aW = let curCol = l ^. #currentColumn in
case S.splitAt curCol (l ^. #widths) 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,
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 ^. #widths) - 1
-- Calculate the leftmost visible column for the current column shown in the center.
in leftForMiddle left (curCol-1) 0
renderColumns
:: GridTabularList n e
-> VisibleColumns
-> (WidthDeficit -> Index -> Width -> Widget n)
-> Height
-> Widget n
renderColumns l vCs dC h = Widget Greedy Fixed $ do
c <- getContext
let cWs = l ^. #widths
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 {left, right, offset, totalWidth} -> cropLeftBy offset $ setAvailableSize (totalWidth, h) $
hBox $ zipWith (dC 0) [left..] $ toList $ S.take (right-left+1) $ S.drop left cWs
AnchoredRight {left, offset, totalWidth} -> cropLeftBy offset $ setAvailableSize (totalWidth, h) $
hBox $ zipWith (dC 0) [left..] $ toList $ S.drop left cWs
-- | Render grid tabular list
renderGridTabularList :: (Ord n, Show n)
=> GridRenderers n e r
-> ListFocused
-> GridTabularList n e -- ^ The list
-> Widget n
renderGridTabularList r lf l = Widget Greedy Greedy $ do
c <- getContext
let aW = c^^.availWidthL
aH = c^^.availHeightL
GridRenderers {drawCell} = r
GridTabularList {list=l', currentColumn=curCol} = l
iH = l' ^. #listItemHeight
colHdrRow vCs rhw' rhwd = case r ^. #colHdr of
Nothing -> emptyWidget
Just (GridColHdr {draw, height}) -> let
drawCol wd c w = setAvailableSize (w, height) $ draw lf wd (FlatContext c (c == curCol))
chrw = case r ^. #drawColHdrRowHdr of
Nothing -> fill ' '
Just dchrw -> dchrw lf rhwd
in setAvailableSize (rhw', height) chrw <+> renderColumns l vCs drawCol height
renderRow vCs i f r = let
drawCol wd c w = let gc = GridContext (FlatContext i f) (FlatContext c $ c == curCol)
in setAvailableSize (w, iH) $ drawCell lf wd gc r
in renderColumns l vCs drawCol iH
renderList = let vCs = visibleColumns l aW in
render $ colHdrRow vCs 0 0 <=> L.renderListWithIndex (renderRow vCs) lf l'
renderHdrList (RowHdr {draw, width, toRowHdr}) = let
rhw = width aW $ zipWithVisibleRowsAndIndexes l' aH toRowHdr
rhw' = min rhw aW
rhwd = max 0 $ rhw - aW
vCs = visibleColumns l $ aW - rhw'
renderHdrRow i f r = setAvailableSize (rhw', iH) (draw lf rhwd f $ toRowHdr r i) <+> renderRow vCs i f r
in render $ colHdrRow vCs rhw' rhwd <=> L.renderListWithIndex renderHdrRow lf l'
maybe renderList renderHdrList $ r ^. #rowHdr
-- | Move to the left by one column.
gridMoveLeft
:: GridTabularList n e -- ^ The list
-> GridTabularList n e
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 e -- ^ The list
-> GridTabularList n e
gridMoveRight gl = if null $ gl ^. #list % #listSelected
then gl
else gl & #currentColumn %~ min (length (gl ^. #widths) - 1) . (+1)
-- | Move to the given column index
gridMoveTo
:: Index
-> GridTabularList n e -- ^ The list
-> GridTabularList n e
gridMoveTo n gl = if null $ gl ^. #list % #listSelected
then gl
else gl & #currentColumn .~ (max 0 . min (length (gl ^. #widths) - 1)) n
-- | Move to the first column.
gridMoveToBeginning
:: GridTabularList n e -- ^ The list
-> GridTabularList n e
gridMoveToBeginning gl = if null $ gl ^. #list % #listSelected
then gl
else gl & #currentColumn .~ 0
-- | Move to the last column.
gridMoveToEnd
:: GridTabularList n e -- ^ The list
-> GridTabularList n e
gridMoveToEnd gl = if null $ gl ^. #list % #listSelected
then gl
else gl & #currentColumn .~ length (gl ^. #widths) - 1
-- | 'GridRenderers' are needed because if row header renderer doesn't exist, width calculation is affected.
gridMovePage :: Ord n
=> GridRenderers n e r
-> (VisibleColumns -> EventM n (GridTabularList n e) ())
-> EventM n (GridTabularList n e) ()
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 r ^. #rowHdr of
Nothing -> 0
Just (RowHdr {width, toRowHdr}) -> width aW $ zipWithVisibleRowsAndIndexes (l ^. #list) aH toRowHdr
in f $ visibleColumns l $ aW - rhw
-- | Move to the previous page of columns.
--
-- 'GridRenderers' are needed because if row header doesn't exist, width calculation is affected.
gridMovePageUp :: Ord n
=> GridRenderers n e r -- ^ Renderers
-> EventM n (GridTabularList n e) ()
gridMovePageUp r = gridMovePage r $ \case
NoColumn -> return ()
CurrentColumn -> modify gridMoveLeft
AnchoredLeft _ -> modify gridMoveToBeginning
MiddleColumns {left} -> modify $ gridMoveTo left
AnchoredRight {left} -> modify $ gridMoveTo left
-- | Move to the next page of columns.
--
-- 'GridRenderers' are needed because if row header doesn't exist, width calculation is affected.
gridMovePageDown :: Ord n
=> GridRenderers n e r -- ^ Renderers
-> EventM n (GridTabularList n e) ()
gridMovePageDown r = gridMovePage r $ \case
NoColumn -> return ()
CurrentColumn -> modify gridMoveRight
AnchoredLeft {right} -> modify $ gridMoveTo right
MiddleColumns {right} -> 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 doesn't exist, width calculation is affected.
handleGridListEvent :: Ord n
=> GridRenderers n e r -- ^ Renderers
-> Event -> EventM n (GridTabularList n e) ()
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 doesn't exist, width calculation is affected.
handleGridListEventVi :: Ord n
=> GridRenderers n e r -- ^ Renderers
-> Event -> EventM n (GridTabularList n e) ()
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)