{-# 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.
--
-- ![demo-01](grid-tabular-list-01.png) ![demo-02](grid-tabular-list-02.png) ![demo-03](grid-tabular-list-03.png)
--
-- 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 {
  GridContext -> FlatContext
row :: FlatContext -- ^ Row context
, GridContext -> FlatContext
col :: FlatContext -- ^ Column context
} deriving (Int -> GridContext -> ShowS
[GridContext] -> ShowS
GridContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GridContext] -> ShowS
$cshowList :: [GridContext] -> ShowS
show :: GridContext -> String
$cshow :: GridContext -> String
showsPrec :: Int -> GridContext -> ShowS
$cshowsPrec :: Int -> GridContext -> ShowS
Show, forall x. Rep GridContext x -> GridContext
forall x. GridContext -> Rep GridContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GridContext x -> GridContext
$cfrom :: forall x. GridContext -> Rep GridContext x
Generic)

-- | Grid column header
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data GridColHdr n = GridColHdr {
  forall n.
GridColHdr n -> ListFocused -> Int -> FlatContext -> Widget n
draw :: ListFocused -> WidthDeficit -> FlatContext -> Widget n
, forall n. GridColHdr n -> Int
height :: Height -- ^ Height for column headers and column header row header
} deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n x. Rep (GridColHdr n) x -> GridColHdr n
forall n x. GridColHdr n -> Rep (GridColHdr n) x
$cto :: forall n x. Rep (GridColHdr n) x -> GridColHdr n
$cfrom :: forall n x. GridColHdr n -> Rep (GridColHdr n) x
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 {
  forall n e r.
GridRenderers n e r
-> ListFocused -> Int -> GridContext -> e -> Widget n
drawCell :: ListFocused -> WidthDeficit -> GridContext -> e -> Widget n
, forall n e r. GridRenderers n e r -> Maybe (RowHdr n e r)
rowHdr :: Maybe (RowHdr n e r)
, forall n e r. GridRenderers n e r -> Maybe (GridColHdr n)
colHdr :: Maybe (GridColHdr n)
, forall n e r. GridRenderers n e r -> DrawColHdrRowHdr n
drawColHdrRowHdr :: DrawColHdrRowHdr n
} deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n e r x. Rep (GridRenderers n e r) x -> GridRenderers n e r
forall n e r x. GridRenderers n e r -> Rep (GridRenderers n e r) x
$cto :: forall n e r x. Rep (GridRenderers n e r) x -> GridRenderers n e r
$cfrom :: forall n e r x. GridRenderers n e r -> Rep (GridRenderers n e r) x
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
  forall n e. GridTabularList n e -> GenericList n Seq e
list :: L.GenericList n Seq e
, forall n e. GridTabularList n e -> GridWidths
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.
, forall n e. GridTabularList n e -> Int
currentColumn :: Index
} deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n e x. Rep (GridTabularList n e) x -> GridTabularList n e
forall n e x. GridTabularList n e -> Rep (GridTabularList n e) x
$cto :: forall n e x. Rep (GridTabularList n e) x -> GridTabularList n e
$cfrom :: forall n e x. GridTabularList n e -> Rep (GridTabularList n e) x
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 :: forall n e. n -> Seq e -> Int -> GridWidths -> GridTabularList n e
gridTabularList n
n Seq e
rows Int
h GridWidths
widths = GridTabularList {
  $sel:list:GridTabularList :: GenericList n Seq e
list = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
L.list n
n Seq e
rows Int
h
, $sel:widths:GridTabularList :: GridWidths
widths = GridWidths
widths
, $sel:currentColumn:GridTabularList :: Int
currentColumn = Int
0
}

data VisibleColumns =
  -- | No column is visible
  NoColumn
  -- | Only current column is visible
  | CurrentColumn
  -- | The first column is shown at the left corner.
  | AnchoredLeft {
      VisibleColumns -> Int
right :: Int -- ^ The rightmost column that is visible
  }
  -- | The current column is shown in the center
  | MiddleColumns {
    -- | The leftmost visible column
    VisibleColumns -> Int
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
    VisibleColumns -> Int
offset :: Int,
    -- | Total widths of all visible columns.
    VisibleColumns -> Int
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 Int -> VisibleColumns -> ShowS
[VisibleColumns] -> ShowS
VisibleColumns -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VisibleColumns] -> ShowS
$cshowList :: [VisibleColumns] -> ShowS
show :: VisibleColumns -> String
$cshow :: VisibleColumns -> String
showsPrec :: Int -> VisibleColumns -> ShowS
$cshowsPrec :: Int -> VisibleColumns -> ShowS
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 :: forall n e. GridTabularList n e -> Int -> VisibleColumns
visibleColumns GridTabularList n e
l Int
aW = let curCol :: Int
curCol = GridTabularList n e
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "currentColumn" a => a
#currentColumn in
  case forall a. Int -> Seq a -> (Seq a, Seq a)
S.splitAt Int
curCol (GridTabularList n e
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "widths" a => a
#widths) of
    -- If current column is outside the boundary of row columns, return `NoColumn`.
    (GridWidths
_, GridWidths
Empty) -> VisibleColumns
NoColumn
    (GridWidths
left, Int
cW :<| GridWidths
right) -> if Int
aW forall a. Ord a => a -> a -> ListFocused
<= Int
0
      -- If the available width is 0 or less than 0,
      then VisibleColumns
NoColumn
      -- If the available width is less than the current column's width,
      else if Int
cW forall a. Ord a => a -> a -> ListFocused
>= Int
aW
      then VisibleColumns
CurrentColumn
      -- Otherwise,
      else let
        -- The amount of space to the left of the current column shown in the center.
        lW :: Int
lW = (Int
aW forall a. Num a => a -> a -> a
- Int
cW) forall a. Integral a => a -> a -> a
`div` Int
2
        -- The amount of space to the right of the current column shown in the center.
        rW :: Int
rW = Int
aW forall a. Num a => a -> a -> a
- Int
lW forall a. Num a => a -> a -> a
- Int
cW
        -- Calculate the leftmost visible column for the current column shown in the center.
        leftForMiddle :: GridWidths -> Int -> Int -> VisibleColumns
leftForMiddle (GridWidths
l :|> Int
w) Int
idx Int
accW = if Int
accWforall a. Num a => a -> a -> a
+Int
w forall a. Ord a => a -> a -> ListFocused
< Int
lW
          -- If the leftmost visible column hasn't been reached, go to the left by one column.
          then GridWidths -> Int -> Int -> VisibleColumns
leftForMiddle GridWidths
l (Int
idxforall a. Num a => a -> a -> a
-Int
1) (Int
accWforall a. Num a => a -> a -> a
+Int
w)
          -- If the leftmost visible column has been reached, calculate the rightmost visible column.
          else Int -> Int -> GridWidths -> Int -> Int -> VisibleColumns
rightForMiddle Int
idx (Int
accWforall a. Num a => a -> a -> a
+Int
w) GridWidths
right (Int
curColforall a. Num a => a -> a -> a
+Int
1) Int
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 GridWidths
Empty Int
_ Int
accW = GridWidths -> Int -> Int -> VisibleColumns
rightForLeft GridWidths
right (Int
curColforall a. Num a => a -> a -> a
+Int
1) (Int
accWforall a. Num a => a -> a -> a
+Int
cW)
        -- Calculate the rightmost visible column for the current column shown in the center.
        rightForMiddle :: Int -> Int -> GridWidths -> Int -> Int -> VisibleColumns
rightForMiddle Int
li Int
lAccW (Int
w :<| GridWidths
r) Int
ri Int
accW = if Int
accWforall a. Num a => a -> a -> a
+Int
w forall a. Ord a => a -> a -> ListFocused
< Int
rW
          -- If the rightmost visible column hasn't been reached, go to the right by one column.
          then Int -> Int -> GridWidths -> Int -> Int -> VisibleColumns
rightForMiddle Int
li Int
lAccW GridWidths
r (Int
riforall a. Num a => a -> a -> a
+Int
1) (Int
accWforall a. Num a => a -> a -> a
+Int
w)
          -- If the rightmost visible column has been reached, return 'MiddleColumns'.
          else MiddleColumns { $sel:left:NoColumn :: Int
left = Int
li, $sel:right:NoColumn :: Int
right = Int
ri, $sel:offset:NoColumn :: Int
offset = Int
lAccWforall a. Num a => a -> a -> a
-Int
lW, $sel:totalWidth:NoColumn :: Int
totalWidth = Int
lAccWforall a. Num a => a -> a -> a
+Int
cWforall a. Num a => a -> a -> a
+Int
accWforall a. Num a => a -> a -> a
+Int
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 Int
_ Int
_ GridWidths
Empty Int
_ Int
accW = GridWidths -> Int -> Int -> VisibleColumns
leftForRight GridWidths
left (Int
curColforall a. Num a => a -> a -> a
-Int
1) (Int
accWforall a. Num a => a -> a -> a
+Int
cW)
        -- Calculate the rightmost visible column for the first column shown at the left corner.
        rightForLeft :: GridWidths -> Int -> Int -> VisibleColumns
rightForLeft (Int
w :<| GridWidths
r) Int
idx Int
accW = if Int
accWforall a. Num a => a -> a -> a
+Int
w forall a. Ord a => a -> a -> ListFocused
< Int
aW
          -- If the rightmost visible column hasn't been reached, go to the right by one column.
          then GridWidths -> Int -> Int -> VisibleColumns
rightForLeft GridWidths
r (Int
idxforall a. Num a => a -> a -> a
+Int
1) (Int
accWforall a. Num a => a -> a -> a
+Int
w)
          -- If the rightmost visible column has been reached, return 'AnchoredLeft'.
          else Int -> VisibleColumns
AnchoredLeft Int
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 GridWidths
Empty Int
idx Int
_ = Int -> VisibleColumns
AnchoredLeft (Int
idxforall a. Num a => a -> a -> a
-Int
1)
        -- Calculate the leftmost visible column for the last column shown at the right corner.
        leftForRight :: GridWidths -> Int -> Int -> VisibleColumns
leftForRight (GridWidths
l :|> Int
w) Int
idx Int
accW = if Int
accWforall a. Num a => a -> a -> a
+Int
w forall a. Ord a => a -> a -> ListFocused
< Int
aW
          -- If the leftmost visible column hasn't been reached, go to the left by one column.
          then GridWidths -> Int -> Int -> VisibleColumns
leftForRight GridWidths
l (Int
idxforall a. Num a => a -> a -> a
-Int
1) (Int
accWforall a. Num a => a -> a -> a
+Int
w)
          -- If the leftmost visible column has been reached, return 'AnchoredRight'.
          else AnchoredRight { $sel:left:NoColumn :: Int
left = Int
idx, $sel:offset:NoColumn :: Int
offset = Int
accWforall a. Num a => a -> a -> a
+Int
wforall a. Num a => a -> a -> a
-Int
aW, $sel:totalWidth:NoColumn :: Int
totalWidth = Int
accWforall a. Num a => a -> a -> a
+Int
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 GridWidths
Empty Int
_ Int
_ = Int -> VisibleColumns
AnchoredLeft forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (GridTabularList n e
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "widths" a => a
#widths) forall a. Num a => a -> a -> a
- Int
1
        -- Calculate the leftmost visible column for the current column shown in the center.
        in GridWidths -> Int -> Int -> VisibleColumns
leftForMiddle GridWidths
left (Int
curColforall a. Num a => a -> a -> a
-Int
1) Int
0

renderColumns
  :: GridTabularList n e
  -> VisibleColumns
  -> (WidthDeficit -> Index -> Width -> Widget n)
  -> Height
  -> Widget n
renderColumns :: forall n e.
GridTabularList n e
-> VisibleColumns
-> (Int -> Int -> Int -> Widget n)
-> Int
-> Widget n
renderColumns GridTabularList n e
l VisibleColumns
vCs Int -> Int -> Int -> Widget n
dC Int
h = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed forall a b. (a -> b) -> a -> b
$ do
  Context n
c <- forall n. RenderM n (Context n)
getContext
  let cWs :: GridWidths
cWs = GridTabularList n e
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "widths" a => a
#widths
      curCol :: Int
curCol = GridTabularList n e
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "currentColumn" a => a
#currentColumn
      aW :: Int
aW = Context n
cforall {s} {a}. s -> Getting a s a -> a
^^.forall n. Lens' (Context n) Int
availWidthL
  forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ case VisibleColumns
vCs of
    VisibleColumns
NoColumn -> forall n. Widget n
emptyWidget
    VisibleColumns
CurrentColumn -> case forall a. Int -> Seq a -> Maybe a
S.lookup Int
curCol GridWidths
cWs of
      Maybe Int
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Current column, " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
curCol forall a. Semigroup a => a -> a -> a
<> String
" is outside the boundary of column widths."
      Just Int
cW -> Int -> Int -> Int -> Widget n
dC (forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Int
cW forall a. Num a => a -> a -> a
- Int
aW) Int
curCol Int
aW
    AnchoredLeft Int
right -> forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int -> Int -> Int -> Widget n
dC Int
0) [Int
0..] forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. Int -> Seq a -> Seq a
S.take (Int
rightforall a. Num a => a -> a -> a
+Int
1) GridWidths
cWs
    MiddleColumns {Int
left :: Int
$sel:left:NoColumn :: VisibleColumns -> Int
left, Int
right :: Int
$sel:right:NoColumn :: VisibleColumns -> Int
right, Int
offset :: Int
$sel:offset:NoColumn :: VisibleColumns -> Int
offset, Int
totalWidth :: Int
$sel:totalWidth:NoColumn :: VisibleColumns -> Int
totalWidth} -> forall n. Int -> Widget n -> Widget n
cropLeftBy Int
offset forall a b. (a -> b) -> a -> b
$ forall n. (Int, Int) -> Widget n -> Widget n
setAvailableSize (Int
totalWidth, Int
h) forall a b. (a -> b) -> a -> b
$
      forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int -> Int -> Int -> Widget n
dC Int
0) [Int
left..] forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. Int -> Seq a -> Seq a
S.take (Int
rightforall a. Num a => a -> a -> a
-Int
leftforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ forall a. Int -> Seq a -> Seq a
S.drop Int
left GridWidths
cWs
    AnchoredRight {Int
left :: Int
$sel:left:NoColumn :: VisibleColumns -> Int
left, Int
offset :: Int
$sel:offset:NoColumn :: VisibleColumns -> Int
offset, Int
totalWidth :: Int
$sel:totalWidth:NoColumn :: VisibleColumns -> Int
totalWidth} -> forall n. Int -> Widget n -> Widget n
cropLeftBy Int
offset forall a b. (a -> b) -> a -> b
$ forall n. (Int, Int) -> Widget n -> Widget n
setAvailableSize (Int
totalWidth, Int
h) forall a b. (a -> b) -> a -> b
$
      forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int -> Int -> Int -> Widget n
dC Int
0) [Int
left..] forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. Int -> Seq a -> Seq a
S.drop Int
left GridWidths
cWs

-- | Render grid tabular list
renderGridTabularList :: (Ord n, Show n)
  => GridRenderers n e r
  -> ListFocused
  -> GridTabularList n e -- ^ The list
  -> Widget n
renderGridTabularList :: forall n e r.
(Ord n, Show n) =>
GridRenderers n e r
-> ListFocused -> GridTabularList n e -> Widget n
renderGridTabularList GridRenderers n e r
r ListFocused
lf GridTabularList n e
l = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy forall a b. (a -> b) -> a -> b
$ do
  Context n
c <- forall n. RenderM n (Context n)
getContext
  let aW :: Int
aW = Context n
cforall {s} {a}. s -> Getting a s a -> a
^^.forall n. Lens' (Context n) Int
availWidthL
      aH :: Int
aH = Context n
cforall {s} {a}. s -> Getting a s a -> a
^^.forall n. Lens' (Context n) Int
availHeightL
      GridRenderers {ListFocused -> Int -> GridContext -> e -> Widget n
drawCell :: ListFocused -> Int -> GridContext -> e -> Widget n
$sel:drawCell:GridRenderers :: forall n e r.
GridRenderers n e r
-> ListFocused -> Int -> GridContext -> e -> Widget n
drawCell} = GridRenderers n e r
r
      GridTabularList {$sel:list:GridTabularList :: forall n e. GridTabularList n e -> GenericList n Seq e
list=GenericList n Seq e
l', $sel:currentColumn:GridTabularList :: forall n e. GridTabularList n e -> Int
currentColumn=Int
curCol} = GridTabularList n e
l
      iH :: Int
iH = GenericList n Seq e
l' forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "listItemHeight" a => a
#listItemHeight
      colHdrRow :: VisibleColumns -> Int -> Int -> Widget n
colHdrRow VisibleColumns
vCs Int
rhw' Int
rhwd = case GridRenderers n e r
r forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "colHdr" a => a
#colHdr of
        Maybe (GridColHdr n)
Nothing -> forall n. Widget n
emptyWidget
        Just (GridColHdr {ListFocused -> Int -> FlatContext -> Widget n
draw :: ListFocused -> Int -> FlatContext -> Widget n
$sel:draw:GridColHdr :: forall n.
GridColHdr n -> ListFocused -> Int -> FlatContext -> Widget n
draw, Int
height :: Int
$sel:height:GridColHdr :: forall n. GridColHdr n -> Int
height}) -> let
          drawCol :: Int -> Int -> Int -> Widget n
drawCol Int
wd Int
c Int
w = forall n. (Int, Int) -> Widget n -> Widget n
setAvailableSize (Int
w, Int
height) forall a b. (a -> b) -> a -> b
$ ListFocused -> Int -> FlatContext -> Widget n
draw ListFocused
lf Int
wd (Int -> ListFocused -> FlatContext
FlatContext Int
c (Int
c forall a. Eq a => a -> a -> ListFocused
== Int
curCol))
          chrw :: Widget n
chrw = case GridRenderers n e r
r forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "drawColHdrRowHdr" a => a
#drawColHdrRowHdr of
            DrawColHdrRowHdr n
Nothing -> forall n. Char -> Widget n
fill Char
' '
            Just ListFocused -> Int -> Widget n
dchrw -> ListFocused -> Int -> Widget n
dchrw ListFocused
lf Int
rhwd
          in forall n. (Int, Int) -> Widget n -> Widget n
setAvailableSize (Int
rhw', Int
height) Widget n
chrw forall n. Widget n -> Widget n -> Widget n
<+> forall n e.
GridTabularList n e
-> VisibleColumns
-> (Int -> Int -> Int -> Widget n)
-> Int
-> Widget n
renderColumns GridTabularList n e
l VisibleColumns
vCs Int -> Int -> Int -> Widget n
drawCol Int
height
      renderRow :: VisibleColumns -> Int -> ListFocused -> e -> Widget n
renderRow VisibleColumns
vCs Int
i ListFocused
f e
r = let
        drawCol :: Int -> Int -> Int -> Widget n
drawCol Int
wd Int
c Int
w = let gc :: GridContext
gc = FlatContext -> FlatContext -> GridContext
GridContext (Int -> ListFocused -> FlatContext
FlatContext Int
i ListFocused
f) (Int -> ListFocused -> FlatContext
FlatContext Int
c forall a b. (a -> b) -> a -> b
$ Int
c forall a. Eq a => a -> a -> ListFocused
== Int
curCol)
          in forall n. (Int, Int) -> Widget n -> Widget n
setAvailableSize (Int
w, Int
iH) forall a b. (a -> b) -> a -> b
$ ListFocused -> Int -> GridContext -> e -> Widget n
drawCell ListFocused
lf Int
wd GridContext
gc e
r
        in forall n e.
GridTabularList n e
-> VisibleColumns
-> (Int -> Int -> Int -> Widget n)
-> Int
-> Widget n
renderColumns GridTabularList n e
l VisibleColumns
vCs Int -> Int -> Int -> Widget n
drawCol Int
iH
      renderList :: RenderM n (Result n)
renderList = let vCs :: VisibleColumns
vCs = forall n e. GridTabularList n e -> Int -> VisibleColumns
visibleColumns GridTabularList n e
l Int
aW in
        forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ VisibleColumns -> Int -> Int -> Widget n
colHdrRow VisibleColumns
vCs Int
0 Int
0 forall n. Widget n -> Widget n -> Widget n
<=> forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Int -> ListFocused -> e -> Widget n)
-> ListFocused -> GenericList n t e -> Widget n
L.renderListWithIndex (VisibleColumns -> Int -> ListFocused -> e -> Widget n
renderRow VisibleColumns
vCs) ListFocused
lf GenericList n Seq e
l'
      renderHdrList :: RowHdr n e r -> RenderM n (Result n)
renderHdrList (RowHdr {ListFocused -> Int -> ListFocused -> r -> Widget n
$sel:draw:RowHdr :: forall n e r.
RowHdr n e r -> ListFocused -> Int -> ListFocused -> r -> Widget n
draw :: ListFocused -> Int -> ListFocused -> r -> Widget n
draw, Int -> [r] -> Int
$sel:width:RowHdr :: forall n e r. RowHdr n e r -> Int -> [r] -> Int
width :: Int -> [r] -> Int
width, e -> Int -> r
$sel:toRowHdr:RowHdr :: forall n e r. RowHdr n e r -> e -> Int -> r
toRowHdr :: e -> Int -> r
toRowHdr}) = let
        rhw :: Int
rhw = Int -> [r] -> Int
width Int
aW forall a b. (a -> b) -> a -> b
$ forall n e c. GenericList n Seq e -> Int -> (e -> Int -> c) -> [c]
zipWithVisibleRowsAndIndexes GenericList n Seq e
l' Int
aH e -> Int -> r
toRowHdr
        rhw' :: Int
rhw' = forall a. Ord a => a -> a -> a
min Int
rhw Int
aW
        rhwd :: Int
rhwd = forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Int
rhw forall a. Num a => a -> a -> a
- Int
aW
        vCs :: VisibleColumns
vCs = forall n e. GridTabularList n e -> Int -> VisibleColumns
visibleColumns GridTabularList n e
l forall a b. (a -> b) -> a -> b
$ Int
aW forall a. Num a => a -> a -> a
- Int
rhw'
        renderHdrRow :: Int -> ListFocused -> e -> Widget n
renderHdrRow Int
i ListFocused
f e
r = forall n. (Int, Int) -> Widget n -> Widget n
setAvailableSize (Int
rhw', Int
iH) (ListFocused -> Int -> ListFocused -> r -> Widget n
draw ListFocused
lf Int
rhwd ListFocused
f forall a b. (a -> b) -> a -> b
$ e -> Int -> r
toRowHdr e
r Int
i) forall n. Widget n -> Widget n -> Widget n
<+> VisibleColumns -> Int -> ListFocused -> e -> Widget n
renderRow VisibleColumns
vCs Int
i ListFocused
f e
r
        in forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ VisibleColumns -> Int -> Int -> Widget n
colHdrRow VisibleColumns
vCs Int
rhw' Int
rhwd forall n. Widget n -> Widget n -> Widget n
<=> forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Int -> ListFocused -> e -> Widget n)
-> ListFocused -> GenericList n t e -> Widget n
L.renderListWithIndex Int -> ListFocused -> e -> Widget n
renderHdrRow ListFocused
lf GenericList n Seq e
l'
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe RenderM n (Result n)
renderList forall {r}. RowHdr n e r -> RenderM n (Result n)
renderHdrList forall a b. (a -> b) -> a -> b
$ GridRenderers n e r
r forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "rowHdr" a => a
#rowHdr

-- | Move to the left by one column.
gridMoveLeft
  :: GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveLeft :: forall n e. GridTabularList n e -> GridTabularList n e
gridMoveLeft GridTabularList n e
gl = if forall (t :: * -> *) a. Foldable t => t a -> ListFocused
null forall a b. (a -> b) -> a -> b
$ GridTabularList n e
gl forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "list" a => a
#list forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "listSelected" a => a
#listSelected
  then GridTabularList n e
gl
  else GridTabularList n e
gl forall a b. a -> (a -> b) -> b
& forall a. IsLabel "currentColumn" a => a
#currentColumn forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall a. Ord a => a -> a -> a
max Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
subtract Int
1

-- | Move to the right by one column.
gridMoveRight
  :: GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveRight :: forall n e. GridTabularList n e -> GridTabularList n e
gridMoveRight GridTabularList n e
gl = if forall (t :: * -> *) a. Foldable t => t a -> ListFocused
null forall a b. (a -> b) -> a -> b
$ GridTabularList n e
gl forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "list" a => a
#list forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "listSelected" a => a
#listSelected
  then GridTabularList n e
gl
  else GridTabularList n e
gl forall a b. a -> (a -> b) -> b
& forall a. IsLabel "currentColumn" a => a
#currentColumn forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall a. Ord a => a -> a -> a
min (forall (t :: * -> *) a. Foldable t => t a -> Int
length (GridTabularList n e
gl forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "widths" a => a
#widths) forall a. Num a => a -> a -> a
- Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+Int
1)

-- | Move to the given column index
gridMoveTo
  :: Index
  -> GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveTo :: forall n e. Int -> GridTabularList n e -> GridTabularList n e
gridMoveTo Int
n GridTabularList n e
gl = if forall (t :: * -> *) a. Foldable t => t a -> ListFocused
null forall a b. (a -> b) -> a -> b
$ GridTabularList n e
gl forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "list" a => a
#list forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "listSelected" a => a
#listSelected
  then GridTabularList n e
gl
  else GridTabularList n e
gl forall a b. a -> (a -> b) -> b
& forall a. IsLabel "currentColumn" a => a
#currentColumn forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (forall a. Ord a => a -> a -> a
max Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min (forall (t :: * -> *) a. Foldable t => t a -> Int
length (GridTabularList n e
gl forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "widths" a => a
#widths) forall a. Num a => a -> a -> a
- Int
1)) Int
n

-- | Move to the first column.
gridMoveToBeginning
  :: GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveToBeginning :: forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToBeginning GridTabularList n e
gl = if forall (t :: * -> *) a. Foldable t => t a -> ListFocused
null forall a b. (a -> b) -> a -> b
$ GridTabularList n e
gl forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "list" a => a
#list forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "listSelected" a => a
#listSelected
  then GridTabularList n e
gl
  else GridTabularList n e
gl forall a b. a -> (a -> b) -> b
& forall a. IsLabel "currentColumn" a => a
#currentColumn forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int
0

-- | Move to the last column.
gridMoveToEnd
  :: GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveToEnd :: forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToEnd GridTabularList n e
gl = if forall (t :: * -> *) a. Foldable t => t a -> ListFocused
null forall a b. (a -> b) -> a -> b
$ GridTabularList n e
gl forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "list" a => a
#list forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "listSelected" a => a
#listSelected
  then GridTabularList n e
gl
  else GridTabularList n e
gl forall a b. a -> (a -> b) -> b
& forall a. IsLabel "currentColumn" a => a
#currentColumn forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall (t :: * -> *) a. Foldable t => t a -> Int
length (GridTabularList n e
gl forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "widths" a => a
#widths) forall a. Num a => a -> a -> a
- Int
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 :: forall n e r.
Ord n =>
GridRenderers n e r
-> (VisibleColumns -> EventM n (GridTabularList n e) ())
-> EventM n (GridTabularList n e) ()
gridMovePage GridRenderers n e r
r VisibleColumns -> EventM n (GridTabularList n e) ()
f = do
  GridTabularList n e
l <- forall s (m :: * -> *). MonadState s m => m s
get
  forall (f :: * -> *). Applicative f => ListFocused -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> ListFocused
null forall a b. (a -> b) -> a -> b
$ GridTabularList n e
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "list" a => a
#list forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "listSelected" a => a
#listSelected) forall a b. (a -> b) -> a -> b
$ do
    Maybe Viewport
v <- forall n s. Ord n => n -> EventM n s (Maybe Viewport)
lookupViewport forall a b. (a -> b) -> a -> b
$ GridTabularList n e
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "list" a => a
#list forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a. IsLabel "listName" a => a
#listName
    case Maybe Viewport
v of
      Maybe Viewport
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Viewport
vp -> let
        (Int
aW, Int
aH) = Viewport
vp forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "_vpSize" a => a
#_vpSize
        rhw :: Int
rhw = case GridRenderers n e r
r forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "rowHdr" a => a
#rowHdr of
          Maybe (RowHdr n e r)
Nothing -> Int
0
          Just (RowHdr {Int -> [r] -> Int
width :: Int -> [r] -> Int
$sel:width:RowHdr :: forall n e r. RowHdr n e r -> Int -> [r] -> Int
width, e -> Int -> r
toRowHdr :: e -> Int -> r
$sel:toRowHdr:RowHdr :: forall n e r. RowHdr n e r -> e -> Int -> r
toRowHdr}) -> Int -> [r] -> Int
width Int
aW forall a b. (a -> b) -> a -> b
$ forall n e c. GenericList n Seq e -> Int -> (e -> Int -> c) -> [c]
zipWithVisibleRowsAndIndexes (GridTabularList n e
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "list" a => a
#list) Int
aH e -> Int -> r
toRowHdr
        in VisibleColumns -> EventM n (GridTabularList n e) ()
f forall a b. (a -> b) -> a -> b
$ forall n e. GridTabularList n e -> Int -> VisibleColumns
visibleColumns GridTabularList n e
l forall a b. (a -> b) -> a -> b
$ Int
aW forall a. Num a => a -> a -> a
- Int
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 :: forall n e r.
Ord n =>
GridRenderers n e r -> EventM n (GridTabularList n e) ()
gridMovePageUp GridRenderers n e r
r = forall n e r.
Ord n =>
GridRenderers n e r
-> (VisibleColumns -> EventM n (GridTabularList n e) ())
-> EventM n (GridTabularList n e) ()
gridMovePage GridRenderers n e r
r forall a b. (a -> b) -> a -> b
$ \case
  VisibleColumns
NoColumn -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  VisibleColumns
CurrentColumn -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall n e. GridTabularList n e -> GridTabularList n e
gridMoveLeft
  AnchoredLeft Int
_ -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToBeginning
  MiddleColumns {Int
left :: Int
$sel:left:NoColumn :: VisibleColumns -> Int
left} -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall n e. Int -> GridTabularList n e -> GridTabularList n e
gridMoveTo Int
left
  AnchoredRight {Int
left :: Int
$sel:left:NoColumn :: VisibleColumns -> Int
left} -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall n e. Int -> GridTabularList n e -> GridTabularList n e
gridMoveTo Int
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 :: forall n e r.
Ord n =>
GridRenderers n e r -> EventM n (GridTabularList n e) ()
gridMovePageDown GridRenderers n e r
r = forall n e r.
Ord n =>
GridRenderers n e r
-> (VisibleColumns -> EventM n (GridTabularList n e) ())
-> EventM n (GridTabularList n e) ()
gridMovePage GridRenderers n e r
r forall a b. (a -> b) -> a -> b
$ \case
  VisibleColumns
NoColumn -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  VisibleColumns
CurrentColumn -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall n e. GridTabularList n e -> GridTabularList n e
gridMoveRight
  AnchoredLeft {Int
right :: Int
$sel:right:NoColumn :: VisibleColumns -> Int
right} -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall n e. Int -> GridTabularList n e -> GridTabularList n e
gridMoveTo Int
right
  MiddleColumns {Int
right :: Int
$sel:right:NoColumn :: VisibleColumns -> Int
right} -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall n e. Int -> GridTabularList n e -> GridTabularList n e
gridMoveTo Int
right
  AnchoredRight {} -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall n e. GridTabularList n e -> GridTabularList n e
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 :: forall n e r.
Ord n =>
GridRenderers n e r -> Event -> EventM n (GridTabularList n e) ()
handleGridListEvent GridRenderers n e r
r Event
e = case Event
e of
  EvKey Key
KLeft [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall n e. GridTabularList n e -> GridTabularList n e
gridMoveLeft
  EvKey Key
KRight [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall n e. GridTabularList n e -> GridTabularList n e
gridMoveRight
  EvKey Key
KHome [Modifier
MCtrl] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToBeginning
  EvKey Key
KEnd [Modifier
MCtrl] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToEnd
  EvKey Key
KPageUp [Modifier
MCtrl] -> forall n e r.
Ord n =>
GridRenderers n e r -> EventM n (GridTabularList n e) ()
gridMovePageUp GridRenderers n e r
r
  EvKey Key
KPageDown [Modifier
MCtrl] -> forall n e r.
Ord n =>
GridRenderers n e r -> EventM n (GridTabularList n e) ()
gridMovePageDown GridRenderers n e r
r
  Event
_ -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom forall a. IsLabel "list" a => a
#list (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
L.handleListEvent Event
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 :: forall n e r.
Ord n =>
GridRenderers n e r -> Event -> EventM n (GridTabularList n e) ()
handleGridListEventVi GridRenderers n e r
r Event
e = case Event
e of
  EvKey (KChar Char
'h') [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall n e. GridTabularList n e -> GridTabularList n e
gridMoveLeft
  EvKey (KChar Char
'l') [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall n e. GridTabularList n e -> GridTabularList n e
gridMoveRight
  EvKey (KChar Char
'H') [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToBeginning
  EvKey (KChar Char
'L') [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToEnd
  EvKey (KChar Char
'h') [Modifier
MMeta] -> forall n e r.
Ord n =>
GridRenderers n e r -> EventM n (GridTabularList n e) ()
gridMovePageUp GridRenderers n e r
r
  EvKey (KChar Char
'l') [Modifier
MMeta] -> forall n e r.
Ord n =>
GridRenderers n e r -> EventM n (GridTabularList n e) ()
gridMovePageDown GridRenderers n e r
r
  EvKey (KChar Char
'h') [Modifier
MAlt] -> forall n e r.
Ord n =>
GridRenderers n e r -> EventM n (GridTabularList n e) ()
gridMovePageUp GridRenderers n e r
r
  EvKey (KChar Char
'l') [Modifier
MAlt] -> forall n e r.
Ord n =>
GridRenderers n e r -> EventM n (GridTabularList n e) ()
gridMovePageDown GridRenderers n e r
r
  Event
_ -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom forall a. IsLabel "list" a => a
#list (forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
(Event -> EventM n (GenericList n t e) ())
-> Event -> EventM n (GenericList n t e) ()
L.handleListEventVi (\Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()) Event
e)