{-# 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.
--
-- ![ ](grid-tabular-list-01.png) ![ ](grid-tabular-list-02.png) ![ ](grid-tabular-list-03.png)
--
-- 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 {
  forall n row cell rowH colH.
GridContents n row cell rowH colH
-> row -> ColumnIndex -> Maybe cell
cell :: row -> ColumnIndex -> Maybe cell
, forall n row cell rowH colH.
GridContents n row cell rowH colH
-> Maybe (row -> ColumnIndex -> Maybe rowH)
rowHdr :: Maybe (row -> RowIndex -> Maybe rowH)
, forall n row cell rowH colH.
GridContents n row cell rowH colH
-> Maybe (ColumnIndex -> Maybe colH)
colHdr :: Maybe (ColumnIndex -> Maybe colH)
} deriving (forall x.
 GridContents n row cell rowH colH
 -> Rep (GridContents n row cell rowH colH) x)
-> (forall x.
    Rep (GridContents n row cell rowH colH) x
    -> GridContents n row cell rowH colH)
-> Generic (GridContents n row cell rowH colH)
forall x.
Rep (GridContents n row cell rowH colH) x
-> GridContents n row cell rowH colH
forall x.
GridContents n row cell rowH colH
-> Rep (GridContents n row cell rowH colH) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n row cell rowH colH x.
Rep (GridContents n row cell rowH colH) x
-> GridContents n row cell rowH colH
forall n row cell rowH colH x.
GridContents n row cell rowH colH
-> Rep (GridContents n row cell rowH colH) x
$cto :: forall n row cell rowH colH x.
Rep (GridContents n row cell rowH colH) x
-> GridContents n row cell rowH colH
$cfrom :: forall n row cell rowH colH x.
GridContents n row cell rowH colH
-> Rep (GridContents n row cell rowH colH) x
Generic

-- | Context information for grid cells
data GridContext = GridContext {
  GridContext -> Position
row :: Position -- ^ Position among rows
, GridContext -> Position
col :: Position -- ^ Position among columns
} deriving (ColumnIndex -> GridContext -> ShowS
[GridContext] -> ShowS
GridContext -> String
(ColumnIndex -> GridContext -> ShowS)
-> (GridContext -> String)
-> ([GridContext] -> ShowS)
-> Show GridContext
forall a.
(ColumnIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GridContext] -> ShowS
$cshowList :: [GridContext] -> ShowS
show :: GridContext -> String
$cshow :: GridContext -> String
showsPrec :: ColumnIndex -> GridContext -> ShowS
$cshowsPrec :: ColumnIndex -> GridContext -> ShowS
Show, (forall x. GridContext -> Rep GridContext x)
-> (forall x. Rep GridContext x -> GridContext)
-> Generic GridContext
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)

-- | 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 {
  forall n row cell rowH colH.
GridRenderers n row cell rowH colH
-> ListFocused
-> ColumnIndex
-> GridContext
-> row
-> Maybe cell
-> Widget n
drawCell :: ListFocused -> WidthDeficit -> GridContext -> row -> Maybe cell -> Widget n
, forall n row cell rowH colH.
GridRenderers n row cell rowH colH
-> Maybe
     (ListFocused
      -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
drawRowHdr :: Maybe (ListFocused -> WidthDeficit -> Position -> row -> Maybe rowH -> Widget n)
, forall n row cell rowH colH.
GridRenderers n row cell rowH colH
-> Maybe
     (ListFocused -> ColumnIndex -> Position -> Maybe colH -> Widget n)
drawColHdr :: Maybe (ListFocused -> WidthDeficit -> Position -> Maybe colH -> Widget n)
} deriving (forall x.
 GridRenderers n row cell rowH colH
 -> Rep (GridRenderers n row cell rowH colH) x)
-> (forall x.
    Rep (GridRenderers n row cell rowH colH) x
    -> GridRenderers n row cell rowH colH)
-> Generic (GridRenderers n row cell rowH colH)
forall x.
Rep (GridRenderers n row cell rowH colH) x
-> GridRenderers n row cell rowH colH
forall x.
GridRenderers n row cell rowH colH
-> Rep (GridRenderers n row cell rowH colH) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n row cell rowH colH x.
Rep (GridRenderers n row cell rowH colH) x
-> GridRenderers n row cell rowH colH
forall n row cell rowH colH x.
GridRenderers n row cell rowH colH
-> Rep (GridRenderers n row cell rowH colH) x
$cto :: forall n row cell rowH colH x.
Rep (GridRenderers n row cell rowH colH) x
-> GridRenderers n row cell rowH colH
$cfrom :: forall n row cell rowH colH x.
GridRenderers n row cell rowH colH
-> Rep (GridRenderers n row cell rowH colH) x
Generic

-- | Sizes for elements of grid tabular list.
-- See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data GridSizes rowH = GridSizes {
  forall rowH. GridSizes rowH -> Seq ColumnIndex
row :: Seq Width -- ^ Widths for column headers and row columns
, forall rowH. GridSizes rowH -> Maybe (RowHeaderWidth rowH)
rowHdr :: Maybe (RowHeaderWidth rowH) -- ^ Width for row headers
, forall rowH. GridSizes rowH -> Maybe ColumnIndex
colHdr :: Maybe Height -- ^ Height for column headers
} deriving (forall x. GridSizes rowH -> Rep (GridSizes rowH) x)
-> (forall x. Rep (GridSizes rowH) x -> GridSizes rowH)
-> Generic (GridSizes rowH)
forall x. Rep (GridSizes rowH) x -> GridSizes rowH
forall x. GridSizes rowH -> Rep (GridSizes rowH) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall rowH x. Rep (GridSizes rowH) x -> GridSizes rowH
forall rowH x. GridSizes rowH -> Rep (GridSizes rowH) x
$cto :: forall rowH x. Rep (GridSizes rowH) x -> GridSizes rowH
$cfrom :: forall rowH x. GridSizes rowH -> Rep (GridSizes rowH) x
Generic

-- | See [List Type Variables]("Brick.Widgets.TabularList#g:ListTypeVariables").
data GridTabularList n row cell rowH colH = GridTabularList {
  forall n row cell rowH colH.
GridTabularList n row cell rowH colH -> GenericList n Seq row
list :: L.GenericList n Seq row -- ^ The underlying primitive list that comes from brick.
, forall n row cell rowH colH.
GridTabularList n row cell rowH colH -> GridSizes rowH
sizes :: GridSizes rowH
, forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridContents n row cell rowH colH
contents :: GridContents n row cell rowH colH
, forall n row cell rowH colH.
GridTabularList n row cell rowH colH -> ColumnIndex
currentColumn :: ColumnIndex
} deriving (forall x.
 GridTabularList n row cell rowH colH
 -> Rep (GridTabularList n row cell rowH colH) x)
-> (forall x.
    Rep (GridTabularList n row cell rowH colH) x
    -> GridTabularList n row cell rowH colH)
-> Generic (GridTabularList n row cell rowH colH)
forall x.
Rep (GridTabularList n row cell rowH colH) x
-> GridTabularList n row cell rowH colH
forall x.
GridTabularList n row cell rowH colH
-> Rep (GridTabularList n row cell rowH colH) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n row cell rowH colH x.
Rep (GridTabularList n row cell rowH colH) x
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH x.
GridTabularList n row cell rowH colH
-> Rep (GridTabularList n row cell rowH colH) x
$cto :: forall n row cell rowH colH x.
Rep (GridTabularList n row cell rowH colH) x
-> GridTabularList n row cell rowH colH
$cfrom :: forall n row cell rowH colH x.
GridTabularList n row cell rowH colH
-> Rep (GridTabularList n row cell rowH colH) x
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 :: forall n row rowH cell colH.
n
-> Seq row
-> ColumnIndex
-> GridSizes rowH
-> GridContents n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridTabularList n
n Seq row
rows ColumnIndex
h GridSizes rowH
sizes GridContents n row cell rowH colH
contents = GridTabularList :: forall n row cell rowH colH.
GenericList n Seq row
-> GridSizes rowH
-> GridContents n row cell rowH colH
-> ColumnIndex
-> GridTabularList n row cell rowH colH
GridTabularList {
  $sel:list:GridTabularList :: GenericList n Seq row
list = n -> Seq row -> ColumnIndex -> GenericList n Seq row
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> ColumnIndex -> GenericList n t e
L.list n
n Seq row
rows ColumnIndex
h
, $sel:sizes:GridTabularList :: GridSizes rowH
sizes = GridSizes rowH
sizes
, $sel:contents:GridTabularList :: GridContents n row cell rowH colH
contents = GridContents n row cell rowH colH
contents
, $sel:currentColumn:GridTabularList :: ColumnIndex
currentColumn = ColumnIndex
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 -> ColumnIndex
right :: Int -- ^ The rightmost column that is visible
  }
  -- | The current column is shown in the center
  | MiddleColumns {
    -- | The leftmost visible column
    VisibleColumns -> ColumnIndex
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 -> ColumnIndex
offset :: Int,
    -- | Total widths of all visible columns.
    VisibleColumns -> ColumnIndex
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 ColumnIndex -> VisibleColumns -> ShowS
[VisibleColumns] -> ShowS
VisibleColumns -> String
(ColumnIndex -> VisibleColumns -> ShowS)
-> (VisibleColumns -> String)
-> ([VisibleColumns] -> ShowS)
-> Show VisibleColumns
forall a.
(ColumnIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VisibleColumns] -> ShowS
$cshowList :: [VisibleColumns] -> ShowS
show :: VisibleColumns -> String
$cshow :: VisibleColumns -> String
showsPrec :: ColumnIndex -> VisibleColumns -> ShowS
$cshowsPrec :: ColumnIndex -> VisibleColumns -> ShowS
Show

-- | Calculate visible columns from the width available for columns. If there aren't enough columns to the left side
-- to show the current column in the center, LeftAnchor is returned. If there are enough columns to the left side of
-- the current column, then check whether there are enough columns of the right side of the current column to show the
-- current column in the center. If there are enough columns to the right side, MiddleColumns is returned. If there
-- aren't enough columns to the right side, then try to calculate the leftmost visible column for AnchoredRight.
-- If there aren't enough columns to fill the availble width for AnchoredRight, then AnchoredLeft is returned.
visibleColumns :: GridTabularList n row cell rowH colH -> AvailWidth -> VisibleColumns
visibleColumns :: forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> ColumnIndex -> VisibleColumns
visibleColumns GridTabularList n row cell rowH colH
l ColumnIndex
aW = let curCol :: ColumnIndex
curCol = GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens NoIx (GridTabularList n row cell rowH colH) ColumnIndex
-> ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "currentColumn"
  (Optic'
     A_Lens NoIx (GridTabularList n row cell rowH colH) ColumnIndex)
Optic'
  A_Lens NoIx (GridTabularList n row cell rowH colH) ColumnIndex
#currentColumn in
  case ColumnIndex
-> Seq ColumnIndex -> (Seq ColumnIndex, Seq ColumnIndex)
forall a. ColumnIndex -> Seq a -> (Seq a, Seq a)
S.splitAt ColumnIndex
curCol (GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Seq ColumnIndex)
-> Seq ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "sizes"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GridSizes rowH)
     (GridSizes rowH))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
#sizes Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
-> Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Seq ColumnIndex)
     (Seq ColumnIndex)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Seq ColumnIndex)
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
% IsLabel
  "row"
  (Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Seq ColumnIndex)
     (Seq ColumnIndex))
Optic
  A_Lens
  NoIx
  (GridSizes rowH)
  (GridSizes rowH)
  (Seq ColumnIndex)
  (Seq ColumnIndex)
#row) of
    (Seq ColumnIndex
_, Seq ColumnIndex
Empty) -> VisibleColumns
NoColumn
    (Seq ColumnIndex
left, ColumnIndex
cW :<| Seq ColumnIndex
right) -> if ColumnIndex
aW ColumnIndex -> ColumnIndex -> ListFocused
forall a. Ord a => a -> a -> ListFocused
<= ColumnIndex
0
      then VisibleColumns
NoColumn
      else if ColumnIndex
cW ColumnIndex -> ColumnIndex -> ListFocused
forall a. Ord a => a -> a -> ListFocused
>= ColumnIndex
aW
      then VisibleColumns
CurrentColumn
      else let
        lW :: ColumnIndex
lW = (ColumnIndex
aW ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
- ColumnIndex
cW) ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Integral a => a -> a -> a
`div` ColumnIndex
2
        rW :: ColumnIndex
rW = ColumnIndex
aW ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
- ColumnIndex
lW ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
- ColumnIndex
cW
        leftForMiddle :: Seq ColumnIndex -> ColumnIndex -> ColumnIndex -> VisibleColumns
leftForMiddle (Seq ColumnIndex
l :|> ColumnIndex
w) ColumnIndex
idx ColumnIndex
accW = if ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
w ColumnIndex -> ColumnIndex -> ListFocused
forall a. Ord a => a -> a -> ListFocused
< ColumnIndex
lW
          then Seq ColumnIndex -> ColumnIndex -> ColumnIndex -> VisibleColumns
leftForMiddle Seq ColumnIndex
l (ColumnIndex
idxColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
-ColumnIndex
1) (ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
w)
          else ColumnIndex
-> ColumnIndex
-> Seq ColumnIndex
-> ColumnIndex
-> ColumnIndex
-> VisibleColumns
rightForMiddle ColumnIndex
idx (ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
w) Seq ColumnIndex
right (ColumnIndex
curColColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
1) ColumnIndex
0
        leftForMiddle Seq ColumnIndex
Empty ColumnIndex
_ ColumnIndex
accW = Seq ColumnIndex -> ColumnIndex -> ColumnIndex -> VisibleColumns
rightForLeft Seq ColumnIndex
right (ColumnIndex
curColColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
1) (ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
cW)
        rightForMiddle :: ColumnIndex
-> ColumnIndex
-> Seq ColumnIndex
-> ColumnIndex
-> ColumnIndex
-> VisibleColumns
rightForMiddle ColumnIndex
li ColumnIndex
lAccW (ColumnIndex
w :<| Seq ColumnIndex
r) ColumnIndex
ri ColumnIndex
accW = if ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
w ColumnIndex -> ColumnIndex -> ListFocused
forall a. Ord a => a -> a -> ListFocused
< ColumnIndex
rW
          then ColumnIndex
-> ColumnIndex
-> Seq ColumnIndex
-> ColumnIndex
-> ColumnIndex
-> VisibleColumns
rightForMiddle ColumnIndex
li ColumnIndex
lAccW Seq ColumnIndex
r (ColumnIndex
riColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
1) (ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
w)
          else MiddleColumns :: ColumnIndex
-> ColumnIndex -> ColumnIndex -> ColumnIndex -> VisibleColumns
MiddleColumns { $sel:left:NoColumn :: ColumnIndex
left = ColumnIndex
li, $sel:right:NoColumn :: ColumnIndex
right = ColumnIndex
ri, $sel:offset:NoColumn :: ColumnIndex
offset = ColumnIndex
lAccWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
-ColumnIndex
lW, $sel:totalWidth:NoColumn :: ColumnIndex
totalWidth = ColumnIndex
lAccWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
cWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
w }
        rightForMiddle ColumnIndex
_ ColumnIndex
_ Seq ColumnIndex
Empty ColumnIndex
_ ColumnIndex
accW = Seq ColumnIndex -> ColumnIndex -> ColumnIndex -> VisibleColumns
leftForRight Seq ColumnIndex
left (ColumnIndex
curColColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
-ColumnIndex
1) (ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
cW)
        rightForLeft :: Seq ColumnIndex -> ColumnIndex -> ColumnIndex -> VisibleColumns
rightForLeft (ColumnIndex
w :<| Seq ColumnIndex
r) ColumnIndex
idx ColumnIndex
accW = if ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
w ColumnIndex -> ColumnIndex -> ListFocused
forall a. Ord a => a -> a -> ListFocused
< ColumnIndex
aW
          then Seq ColumnIndex -> ColumnIndex -> ColumnIndex -> VisibleColumns
rightForLeft Seq ColumnIndex
r (ColumnIndex
idxColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
1) (ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
w)
          else ColumnIndex -> VisibleColumns
AnchoredLeft ColumnIndex
idx
        rightForLeft Seq ColumnIndex
Empty ColumnIndex
idx ColumnIndex
_ = ColumnIndex -> VisibleColumns
AnchoredLeft (ColumnIndex
idxColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
-ColumnIndex
1)
        leftForRight :: Seq ColumnIndex -> ColumnIndex -> ColumnIndex -> VisibleColumns
leftForRight (Seq ColumnIndex
l :|> ColumnIndex
w) ColumnIndex
idx ColumnIndex
accW = if ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
w ColumnIndex -> ColumnIndex -> ListFocused
forall a. Ord a => a -> a -> ListFocused
< ColumnIndex
aW
          then Seq ColumnIndex -> ColumnIndex -> ColumnIndex -> VisibleColumns
leftForRight Seq ColumnIndex
l (ColumnIndex
idxColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
-ColumnIndex
1) (ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
w)
          else AnchoredRight :: ColumnIndex -> ColumnIndex -> ColumnIndex -> VisibleColumns
AnchoredRight { $sel:left:NoColumn :: ColumnIndex
left = ColumnIndex
idx, $sel:offset:NoColumn :: ColumnIndex
offset = ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
wColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
-ColumnIndex
aW, $sel:totalWidth:NoColumn :: ColumnIndex
totalWidth = ColumnIndex
accWColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
w }
        leftForRight Seq ColumnIndex
Empty ColumnIndex
_ ColumnIndex
_ = ColumnIndex -> VisibleColumns
AnchoredLeft (ColumnIndex -> VisibleColumns) -> ColumnIndex -> VisibleColumns
forall a b. (a -> b) -> a -> b
$ Seq ColumnIndex -> ColumnIndex
forall (t :: * -> *) a. Foldable t => t a -> ColumnIndex
length (GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Seq ColumnIndex)
-> Seq ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "sizes"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GridSizes rowH)
     (GridSizes rowH))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
#sizes Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
-> Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Seq ColumnIndex)
     (Seq ColumnIndex)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Seq ColumnIndex)
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
% IsLabel
  "row"
  (Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Seq ColumnIndex)
     (Seq ColumnIndex))
Optic
  A_Lens
  NoIx
  (GridSizes rowH)
  (GridSizes rowH)
  (Seq ColumnIndex)
  (Seq ColumnIndex)
#row) ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
- ColumnIndex
1
        in Seq ColumnIndex -> ColumnIndex -> ColumnIndex -> VisibleColumns
leftForMiddle Seq ColumnIndex
left (ColumnIndex
curColColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
-ColumnIndex
1) ColumnIndex
0

renderColumns :: GridTabularList n row cell rowH colH
  -> VisibleColumns
  -> (WidthDeficit -> ColumnIndex -> Width -> Widget n)
  -> Widget n
renderColumns :: forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> VisibleColumns
-> (ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n)
-> Widget n
renderColumns GridTabularList n row cell rowH colH
l VisibleColumns
vCs ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n
dC = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
  Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
  let cWs :: Seq ColumnIndex
cWs = GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Seq ColumnIndex)
-> Seq ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "sizes"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GridSizes rowH)
     (GridSizes rowH))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
#sizes Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
-> Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Seq ColumnIndex)
     (Seq ColumnIndex)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Seq ColumnIndex)
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
% IsLabel
  "row"
  (Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Seq ColumnIndex)
     (Seq ColumnIndex))
Optic
  A_Lens
  NoIx
  (GridSizes rowH)
  (GridSizes rowH)
  (Seq ColumnIndex)
  (Seq ColumnIndex)
#row
      iH :: ColumnIndex
iH = GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens NoIx (GridTabularList n row cell rowH colH) ColumnIndex
-> ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "list"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row)
     (GenericList n Seq row))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
#list Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
-> Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     ColumnIndex
     ColumnIndex
-> Optic'
     A_Lens NoIx (GridTabularList n row cell rowH colH) ColumnIndex
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
% IsLabel
  "listItemHeight"
  (Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     ColumnIndex
     ColumnIndex)
Optic
  A_Lens
  NoIx
  (GenericList n Seq row)
  (GenericList n Seq row)
  ColumnIndex
  ColumnIndex
#listItemHeight
      curCol :: ColumnIndex
curCol = GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens NoIx (GridTabularList n row cell rowH colH) ColumnIndex
-> ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "currentColumn"
  (Optic'
     A_Lens NoIx (GridTabularList n row cell rowH colH) ColumnIndex)
Optic'
  A_Lens NoIx (GridTabularList n row cell rowH colH) ColumnIndex
#currentColumn
      aW :: ColumnIndex
aW = Context n
cContext n
-> Getting ColumnIndex (Context n) ColumnIndex -> ColumnIndex
forall {s} {a}. s -> Getting a s a -> a
^^.Getting ColumnIndex (Context n) ColumnIndex
forall n. Lens' (Context n) ColumnIndex
availWidthL
  Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ case VisibleColumns
vCs of
    VisibleColumns
NoColumn -> Widget n
forall n. Widget n
emptyWidget
    VisibleColumns
CurrentColumn -> case ColumnIndex -> Seq ColumnIndex -> Maybe ColumnIndex
forall a. ColumnIndex -> Seq a -> Maybe a
S.lookup ColumnIndex
curCol Seq ColumnIndex
cWs of
      Maybe ColumnIndex
Nothing -> String -> Widget n
forall a. HasCallStack => String -> a
error (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String
"Current column, " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ColumnIndex -> String
forall a. Show a => a -> String
show ColumnIndex
curCol String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is outside the boundary of column widths."
      Just ColumnIndex
cW -> ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n
dC (ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Ord a => a -> a -> a
max ColumnIndex
0 (ColumnIndex -> ColumnIndex) -> ColumnIndex -> ColumnIndex
forall a b. (a -> b) -> a -> b
$ ColumnIndex
cW ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
- ColumnIndex
aW) ColumnIndex
curCol ColumnIndex
aW
    AnchoredLeft ColumnIndex
right -> [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (ColumnIndex -> ColumnIndex -> Widget n)
-> [ColumnIndex] -> [ColumnIndex] -> [Widget n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n
dC ColumnIndex
0) [ColumnIndex
0..] ([ColumnIndex] -> [Widget n]) -> [ColumnIndex] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ Seq ColumnIndex -> [ColumnIndex]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq ColumnIndex -> [ColumnIndex])
-> Seq ColumnIndex -> [ColumnIndex]
forall a b. (a -> b) -> a -> b
$ ColumnIndex -> Seq ColumnIndex -> Seq ColumnIndex
forall a. ColumnIndex -> Seq a -> Seq a
S.take (ColumnIndex
rightColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
1) Seq ColumnIndex
cWs
    MiddleColumns {ColumnIndex
totalWidth :: ColumnIndex
offset :: ColumnIndex
right :: ColumnIndex
left :: ColumnIndex
$sel:totalWidth:NoColumn :: VisibleColumns -> ColumnIndex
$sel:offset:NoColumn :: VisibleColumns -> ColumnIndex
$sel:left:NoColumn :: VisibleColumns -> ColumnIndex
$sel:right:NoColumn :: VisibleColumns -> ColumnIndex
..} -> ColumnIndex -> Widget n -> Widget n
forall n. ColumnIndex -> Widget n -> Widget n
cropLeftBy ColumnIndex
offset (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ (ColumnIndex, ColumnIndex) -> Widget n -> Widget n
forall n. (ColumnIndex, ColumnIndex) -> Widget n -> Widget n
setAvailableSize (ColumnIndex
totalWidth, ColumnIndex
iH) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
      [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (ColumnIndex -> ColumnIndex -> Widget n)
-> [ColumnIndex] -> [ColumnIndex] -> [Widget n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n
dC ColumnIndex
0) [ColumnIndex
left..] ([ColumnIndex] -> [Widget n]) -> [ColumnIndex] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ Seq ColumnIndex -> [ColumnIndex]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq ColumnIndex -> [ColumnIndex])
-> Seq ColumnIndex -> [ColumnIndex]
forall a b. (a -> b) -> a -> b
$ ColumnIndex -> Seq ColumnIndex -> Seq ColumnIndex
forall a. ColumnIndex -> Seq a -> Seq a
S.take (ColumnIndex
rightColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
-ColumnIndex
leftColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
1) (Seq ColumnIndex -> Seq ColumnIndex)
-> Seq ColumnIndex -> Seq ColumnIndex
forall a b. (a -> b) -> a -> b
$ ColumnIndex -> Seq ColumnIndex -> Seq ColumnIndex
forall a. ColumnIndex -> Seq a -> Seq a
S.drop ColumnIndex
left Seq ColumnIndex
cWs
    AnchoredRight {ColumnIndex
totalWidth :: ColumnIndex
offset :: ColumnIndex
left :: ColumnIndex
$sel:totalWidth:NoColumn :: VisibleColumns -> ColumnIndex
$sel:offset:NoColumn :: VisibleColumns -> ColumnIndex
$sel:left:NoColumn :: VisibleColumns -> ColumnIndex
..} -> ColumnIndex -> Widget n -> Widget n
forall n. ColumnIndex -> Widget n -> Widget n
cropLeftBy ColumnIndex
offset (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ (ColumnIndex, ColumnIndex) -> Widget n -> Widget n
forall n. (ColumnIndex, ColumnIndex) -> Widget n -> Widget n
setAvailableSize (ColumnIndex
totalWidth, ColumnIndex
iH) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
      [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (ColumnIndex -> ColumnIndex -> Widget n)
-> [ColumnIndex] -> [ColumnIndex] -> [Widget n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n
dC ColumnIndex
0) [ColumnIndex
left..] ([ColumnIndex] -> [Widget n]) -> [ColumnIndex] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ Seq ColumnIndex -> [ColumnIndex]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq ColumnIndex -> [ColumnIndex])
-> Seq ColumnIndex -> [ColumnIndex]
forall a b. (a -> b) -> a -> b
$ ColumnIndex -> Seq ColumnIndex -> Seq ColumnIndex
forall a. ColumnIndex -> Seq a -> Seq a
S.drop ColumnIndex
left Seq ColumnIndex
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 :: forall n row cell rowH colH.
(Ord n, Show n) =>
GridRenderers n row cell rowH colH
-> ListFocused -> GridTabularList n row cell rowH colH -> Widget n
renderGridTabularList GridRenderers n row cell rowH colH
r ListFocused
lf GridTabularList n row cell rowH colH
l = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
  Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
  let drawCell :: ListFocused
-> ColumnIndex -> GridContext -> row -> Maybe cell -> Widget n
drawCell = GridRenderers n row cell rowH colH
r GridRenderers n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridRenderers n row cell rowH colH)
     (ListFocused
      -> ColumnIndex -> GridContext -> row -> Maybe cell -> Widget n)
-> ListFocused
-> ColumnIndex
-> GridContext
-> row
-> Maybe cell
-> Widget n
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "drawCell"
  (Optic'
     A_Lens
     NoIx
     (GridRenderers n row cell rowH colH)
     (ListFocused
      -> ColumnIndex -> GridContext -> row -> Maybe cell -> Widget n))
Optic'
  A_Lens
  NoIx
  (GridRenderers n row cell rowH colH)
  (ListFocused
   -> ColumnIndex -> GridContext -> row -> Maybe cell -> Widget n)
#drawCell
      cell :: row -> ColumnIndex -> Maybe cell
cell = GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (row -> ColumnIndex -> Maybe cell)
-> row
-> ColumnIndex
-> Maybe cell
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "contents"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GridContents n row cell rowH colH)
     (GridContents n row cell rowH colH))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridContents n row cell rowH colH)
  (GridContents n row cell rowH colH)
#contents Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridContents n row cell rowH colH)
  (GridContents n row cell rowH colH)
-> Optic
     A_Lens
     NoIx
     (GridContents n row cell rowH colH)
     (GridContents n row cell rowH colH)
     (row -> ColumnIndex -> Maybe cell)
     (row -> ColumnIndex -> Maybe cell)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (row -> ColumnIndex -> Maybe cell)
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
% IsLabel
  "cell"
  (Optic
     A_Lens
     NoIx
     (GridContents n row cell rowH colH)
     (GridContents n row cell rowH colH)
     (row -> ColumnIndex -> Maybe cell)
     (row -> ColumnIndex -> Maybe cell))
Optic
  A_Lens
  NoIx
  (GridContents n row cell rowH colH)
  (GridContents n row cell rowH colH)
  (row -> ColumnIndex -> Maybe cell)
  (row -> ColumnIndex -> Maybe cell)
#cell
      list :: GenericList n Seq row
list = GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row)
-> GenericList n Seq row
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "list"
  (Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row))
Optic'
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
#list
      curCol :: ColumnIndex
curCol = GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens NoIx (GridTabularList n row cell rowH colH) ColumnIndex
-> ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "currentColumn"
  (Optic'
     A_Lens NoIx (GridTabularList n row cell rowH colH) ColumnIndex)
Optic'
  A_Lens NoIx (GridTabularList n row cell rowH colH) ColumnIndex
#currentColumn
      aW :: ColumnIndex
aW = Context n
cContext n
-> Getting ColumnIndex (Context n) ColumnIndex -> ColumnIndex
forall {s} {a}. s -> Getting a s a -> a
^^.Getting ColumnIndex (Context n) ColumnIndex
forall n. Lens' (Context n) ColumnIndex
availWidthL
      aH :: ColumnIndex
aH = Context n
cContext n
-> Getting ColumnIndex (Context n) ColumnIndex -> ColumnIndex
forall {s} {a}. s -> Getting a s a -> a
^^.Getting ColumnIndex (Context n) ColumnIndex
forall n. Lens' (Context n) ColumnIndex
availHeightL
      iH :: ColumnIndex
iH = GenericList n Seq row
list GenericList n Seq row
-> Optic' A_Lens NoIx (GenericList n Seq row) ColumnIndex
-> ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "listItemHeight"
  (Optic' A_Lens NoIx (GenericList n Seq row) ColumnIndex)
Optic' A_Lens NoIx (GenericList n Seq row) ColumnIndex
#listItemHeight
      wSet :: ColumnIndex -> Widget n -> Widget n
wSet = (ColumnIndex, ColumnIndex) -> Widget n -> Widget n
forall n. (ColumnIndex, ColumnIndex) -> Widget n -> Widget n
setAvailableSize ((ColumnIndex, ColumnIndex) -> Widget n -> Widget n)
-> (ColumnIndex -> (ColumnIndex, ColumnIndex))
-> ColumnIndex
-> Widget n
-> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, ColumnIndex
iH)
      colHdrRow :: VisibleColumns -> ColumnIndex -> Widget n
colHdrRow VisibleColumns
vCs ColumnIndex
rhw = case (GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe (ColumnIndex -> Maybe colH))
-> Maybe (ColumnIndex -> Maybe colH)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "contents"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GridContents n row cell rowH colH)
     (GridContents n row cell rowH colH))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridContents n row cell rowH colH)
  (GridContents n row cell rowH colH)
#contents Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridContents n row cell rowH colH)
  (GridContents n row cell rowH colH)
-> Optic
     A_Lens
     NoIx
     (GridContents n row cell rowH colH)
     (GridContents n row cell rowH colH)
     (Maybe (ColumnIndex -> Maybe colH))
     (Maybe (ColumnIndex -> Maybe colH))
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe (ColumnIndex -> Maybe colH))
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
% IsLabel
  "colHdr"
  (Optic
     A_Lens
     NoIx
     (GridContents n row cell rowH colH)
     (GridContents n row cell rowH colH)
     (Maybe (ColumnIndex -> Maybe colH))
     (Maybe (ColumnIndex -> Maybe colH)))
Optic
  A_Lens
  NoIx
  (GridContents n row cell rowH colH)
  (GridContents n row cell rowH colH)
  (Maybe (ColumnIndex -> Maybe colH))
  (Maybe (ColumnIndex -> Maybe colH))
#colHdr, GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
-> Maybe ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "sizes"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GridSizes rowH)
     (GridSizes rowH))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
#sizes Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
-> Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
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
% IsLabel
  "colHdr"
  (Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex))
Optic
  A_Lens
  NoIx
  (GridSizes rowH)
  (GridSizes rowH)
  (Maybe ColumnIndex)
  (Maybe ColumnIndex)
#colHdr, GridRenderers n row cell rowH colH
r GridRenderers n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridRenderers n row cell rowH colH)
     (Maybe
        (ListFocused -> ColumnIndex -> Position -> Maybe colH -> Widget n))
-> Maybe
     (ListFocused -> ColumnIndex -> Position -> Maybe colH -> Widget n)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "drawColHdr"
  (Optic'
     A_Lens
     NoIx
     (GridRenderers n row cell rowH colH)
     (Maybe
        (ListFocused
         -> ColumnIndex -> Position -> Maybe colH -> Widget n)))
Optic'
  A_Lens
  NoIx
  (GridRenderers n row cell rowH colH)
  (Maybe
     (ListFocused -> ColumnIndex -> Position -> Maybe colH -> Widget n))
#drawColHdr) of
        (Maybe (ColumnIndex -> Maybe colH)
Nothing, Maybe ColumnIndex
_, Maybe
  (ListFocused -> ColumnIndex -> Position -> Maybe colH -> Widget n)
_) -> Widget n
forall n. Widget n
emptyWidget
        (Maybe (ColumnIndex -> Maybe colH)
_, Maybe ColumnIndex
Nothing, Maybe
  (ListFocused -> ColumnIndex -> Position -> Maybe colH -> Widget n)
_) -> Widget n
forall n. Widget n
emptyWidget
        (Maybe (ColumnIndex -> Maybe colH)
_, Maybe ColumnIndex
_, Maybe
  (ListFocused -> ColumnIndex -> Position -> Maybe colH -> Widget n)
Nothing) -> Widget n
forall n. Widget n
emptyWidget
        (Just ColumnIndex -> Maybe colH
colH, Just ColumnIndex
colHdrH, Just ListFocused -> ColumnIndex -> Position -> Maybe colH -> Widget n
dch) -> let
          wSet :: ColumnIndex -> Widget n -> Widget n
wSet = (ColumnIndex, ColumnIndex) -> Widget n -> Widget n
forall n. (ColumnIndex, ColumnIndex) -> Widget n -> Widget n
setAvailableSize ((ColumnIndex, ColumnIndex) -> Widget n -> Widget n)
-> (ColumnIndex -> (ColumnIndex, ColumnIndex))
-> ColumnIndex
-> Widget n
-> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, ColumnIndex
colHdrH)
          drawCol :: ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n
drawCol ColumnIndex
wd ColumnIndex
c ColumnIndex
w = ColumnIndex -> Widget n -> Widget n
forall n. ColumnIndex -> Widget n -> Widget n
wSet ColumnIndex
w (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ListFocused -> ColumnIndex -> Position -> Maybe colH -> Widget n
dch ListFocused
lf ColumnIndex
wd (ColumnIndex -> ListFocused -> Position
Position ColumnIndex
c (ColumnIndex
c ColumnIndex -> ColumnIndex -> ListFocused
forall a. Eq a => a -> a -> ListFocused
== ColumnIndex
curCol)) (Maybe colH -> Widget n) -> Maybe colH -> Widget n
forall a b. (a -> b) -> a -> b
$ ColumnIndex -> Maybe colH
colH ColumnIndex
c
          in ColumnIndex -> Widget n -> Widget n
forall n. ColumnIndex -> Widget n -> Widget n
wSet ColumnIndex
rhw (Char -> Widget n
forall n. Char -> Widget n
fill Char
' ') Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> GridTabularList n row cell rowH colH
-> VisibleColumns
-> (ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n)
-> Widget n
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> VisibleColumns
-> (ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n)
-> Widget n
renderColumns GridTabularList n row cell rowH colH
l VisibleColumns
vCs ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n
drawCol
      renderRow :: VisibleColumns -> ColumnIndex -> ListFocused -> row -> Widget n
renderRow VisibleColumns
vCs ColumnIndex
i ListFocused
f row
r = let
        drawCol :: ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n
drawCol ColumnIndex
wd ColumnIndex
c ColumnIndex
w = let gc :: GridContext
gc = Position -> Position -> GridContext
GridContext (ColumnIndex -> ListFocused -> Position
Position ColumnIndex
i ListFocused
f) (ColumnIndex -> ListFocused -> Position
Position ColumnIndex
c (ListFocused -> Position) -> ListFocused -> Position
forall a b. (a -> b) -> a -> b
$ ColumnIndex
c ColumnIndex -> ColumnIndex -> ListFocused
forall a. Eq a => a -> a -> ListFocused
== ColumnIndex
curCol)
          in ColumnIndex -> Widget n -> Widget n
forall n. ColumnIndex -> Widget n -> Widget n
wSet ColumnIndex
w (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ListFocused
-> ColumnIndex -> GridContext -> row -> Maybe cell -> Widget n
drawCell ListFocused
lf ColumnIndex
wd GridContext
gc row
r (Maybe cell -> Widget n) -> Maybe cell -> Widget n
forall a b. (a -> b) -> a -> b
$ row -> ColumnIndex -> Maybe cell
cell row
r ColumnIndex
c
        in GridTabularList n row cell rowH colH
-> VisibleColumns
-> (ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n)
-> Widget n
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> VisibleColumns
-> (ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n)
-> Widget n
renderColumns GridTabularList n row cell rowH colH
l VisibleColumns
vCs ColumnIndex -> ColumnIndex -> ColumnIndex -> Widget n
drawCol
      renderList :: RenderM n (Result n)
renderList = let vCs :: VisibleColumns
vCs = GridTabularList n row cell rowH colH
-> ColumnIndex -> VisibleColumns
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> ColumnIndex -> VisibleColumns
visibleColumns GridTabularList n row cell rowH colH
l ColumnIndex
aW in
        Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ VisibleColumns -> ColumnIndex -> Widget n
colHdrRow VisibleColumns
vCs ColumnIndex
0 Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> (ColumnIndex -> ListFocused -> row -> Widget n)
-> ListFocused -> GenericList n Seq row -> Widget n
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(ColumnIndex -> ListFocused -> e -> Widget n)
-> ListFocused -> GenericList n t e -> Widget n
L.renderListWithIndex (VisibleColumns -> ColumnIndex -> ListFocused -> row -> Widget n
renderRow VisibleColumns
vCs) ListFocused
lf GenericList n Seq row
list
      renderHdrList :: (row -> ColumnIndex -> t)
-> ColumnIndex
-> (ListFocused -> ColumnIndex -> Position -> row -> t -> Widget n)
-> RenderM n (Result n)
renderHdrList row -> ColumnIndex -> t
rh ColumnIndex
rhw ListFocused -> ColumnIndex -> Position -> row -> t -> Widget n
drh = let
        rhw' :: ColumnIndex
rhw' = ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Ord a => a -> a -> a
min ColumnIndex
rhw ColumnIndex
aW
        rhwd :: ColumnIndex
rhwd = ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Ord a => a -> a -> a
max ColumnIndex
0 (ColumnIndex -> ColumnIndex) -> ColumnIndex -> ColumnIndex
forall a b. (a -> b) -> a -> b
$ ColumnIndex
rhw ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
- ColumnIndex
aW
        vCs :: VisibleColumns
vCs = GridTabularList n row cell rowH colH
-> ColumnIndex -> VisibleColumns
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> ColumnIndex -> VisibleColumns
visibleColumns GridTabularList n row cell rowH colH
l (ColumnIndex -> VisibleColumns) -> ColumnIndex -> VisibleColumns
forall a b. (a -> b) -> a -> b
$ ColumnIndex
aW ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
- ColumnIndex
rhw'
        renderHdrRow :: ColumnIndex -> ListFocused -> row -> Widget n
renderHdrRow ColumnIndex
i ListFocused
f row
row = ColumnIndex -> Widget n -> Widget n
forall n. ColumnIndex -> Widget n -> Widget n
wSet ColumnIndex
rhw' (ListFocused -> ColumnIndex -> Position -> row -> t -> Widget n
drh ListFocused
lf ColumnIndex
rhwd (ColumnIndex -> ListFocused -> Position
Position ColumnIndex
i ListFocused
f) row
row (t -> Widget n) -> t -> Widget n
forall a b. (a -> b) -> a -> b
$ row -> ColumnIndex -> t
rh row
row ColumnIndex
i) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> VisibleColumns -> ColumnIndex -> ListFocused -> row -> Widget n
renderRow VisibleColumns
vCs ColumnIndex
i ListFocused
f row
row
        in Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ VisibleColumns -> ColumnIndex -> Widget n
colHdrRow VisibleColumns
vCs ColumnIndex
rhw' Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> (ColumnIndex -> ListFocused -> row -> Widget n)
-> ListFocused -> GenericList n Seq row -> Widget n
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(ColumnIndex -> ListFocused -> e -> Widget n)
-> ListFocused -> GenericList n t e -> Widget n
L.renderListWithIndex ColumnIndex -> ListFocused -> row -> Widget n
renderHdrRow ListFocused
lf GenericList n Seq row
list
  case (GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe (row -> ColumnIndex -> Maybe rowH))
-> Maybe (row -> ColumnIndex -> Maybe rowH)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "contents"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GridContents n row cell rowH colH)
     (GridContents n row cell rowH colH))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridContents n row cell rowH colH)
  (GridContents n row cell rowH colH)
#contents Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridContents n row cell rowH colH)
  (GridContents n row cell rowH colH)
-> Optic
     A_Lens
     NoIx
     (GridContents n row cell rowH colH)
     (GridContents n row cell rowH colH)
     (Maybe (row -> ColumnIndex -> Maybe rowH))
     (Maybe (row -> ColumnIndex -> Maybe rowH))
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe (row -> ColumnIndex -> Maybe rowH))
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
% IsLabel
  "rowHdr"
  (Optic
     A_Lens
     NoIx
     (GridContents n row cell rowH colH)
     (GridContents n row cell rowH colH)
     (Maybe (row -> ColumnIndex -> Maybe rowH))
     (Maybe (row -> ColumnIndex -> Maybe rowH)))
Optic
  A_Lens
  NoIx
  (GridContents n row cell rowH colH)
  (GridContents n row cell rowH colH)
  (Maybe (row -> ColumnIndex -> Maybe rowH))
  (Maybe (row -> ColumnIndex -> Maybe rowH))
#rowHdr, GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe (RowHeaderWidth rowH))
-> Maybe (RowHeaderWidth rowH)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "sizes"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GridSizes rowH)
     (GridSizes rowH))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
#sizes Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
-> Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Maybe (RowHeaderWidth rowH))
     (Maybe (RowHeaderWidth rowH))
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe (RowHeaderWidth rowH))
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
% IsLabel
  "rowHdr"
  (Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Maybe (RowHeaderWidth rowH))
     (Maybe (RowHeaderWidth rowH)))
Optic
  A_Lens
  NoIx
  (GridSizes rowH)
  (GridSizes rowH)
  (Maybe (RowHeaderWidth rowH))
  (Maybe (RowHeaderWidth rowH))
#rowHdr, GridRenderers n row cell rowH colH
r GridRenderers n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridRenderers n row cell rowH colH)
     (Maybe
        (ListFocused
         -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n))
-> Maybe
     (ListFocused
      -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "drawRowHdr"
  (Optic'
     A_Lens
     NoIx
     (GridRenderers n row cell rowH colH)
     (Maybe
        (ListFocused
         -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)))
Optic'
  A_Lens
  NoIx
  (GridRenderers n row cell rowH colH)
  (Maybe
     (ListFocused
      -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n))
#drawRowHdr) of
    (Maybe (row -> ColumnIndex -> Maybe rowH)
Nothing, Maybe (RowHeaderWidth rowH)
_, Maybe
  (ListFocused
   -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
_) -> RenderM n (Result n)
renderList
    (Maybe (row -> ColumnIndex -> Maybe rowH)
_, Maybe (RowHeaderWidth rowH)
Nothing, Maybe
  (ListFocused
   -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
_) -> RenderM n (Result n)
renderList
    (Maybe (row -> ColumnIndex -> Maybe rowH)
_, Maybe (RowHeaderWidth rowH)
_, Maybe
  (ListFocused
   -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
Nothing) -> RenderM n (Result n)
renderList
    (Just row -> ColumnIndex -> Maybe rowH
rh, Just (FixedRowHeader ColumnIndex
w), Just ListFocused
-> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n
drh) -> (row -> ColumnIndex -> Maybe rowH)
-> ColumnIndex
-> (ListFocused
    -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
-> RenderM n (Result n)
forall {t}.
(row -> ColumnIndex -> t)
-> ColumnIndex
-> (ListFocused -> ColumnIndex -> Position -> row -> t -> Widget n)
-> RenderM n (Result n)
renderHdrList row -> ColumnIndex -> Maybe rowH
rh ColumnIndex
w ListFocused
-> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n
drh
    (Just row -> ColumnIndex -> Maybe rowH
rh, Just (AvailRowHeader ColumnIndex -> ColumnIndex
w), Just ListFocused
-> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n
drh) -> (row -> ColumnIndex -> Maybe rowH)
-> ColumnIndex
-> (ListFocused
    -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
-> RenderM n (Result n)
forall {t}.
(row -> ColumnIndex -> t)
-> ColumnIndex
-> (ListFocused -> ColumnIndex -> Position -> row -> t -> Widget n)
-> RenderM n (Result n)
renderHdrList row -> ColumnIndex -> Maybe rowH
rh (ColumnIndex -> ColumnIndex
w ColumnIndex
aW) ListFocused
-> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n
drh
    (Just row -> ColumnIndex -> Maybe rowH
rh, Just (VisibleRowHeaders ColumnIndex -> [rowH] -> ColumnIndex
w), Just ListFocused
-> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n
drh) -> (row -> ColumnIndex -> Maybe rowH)
-> ColumnIndex
-> (ListFocused
    -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
-> RenderM n (Result n)
forall {t}.
(row -> ColumnIndex -> t)
-> ColumnIndex
-> (ListFocused -> ColumnIndex -> Position -> row -> t -> Widget n)
-> RenderM n (Result n)
renderHdrList row -> ColumnIndex -> Maybe rowH
rh (ColumnIndex -> [rowH] -> ColumnIndex
w ColumnIndex
aW ([rowH] -> ColumnIndex) -> [rowH] -> ColumnIndex
forall a b. (a -> b) -> a -> b
$ GenericList n Seq row
-> ColumnIndex -> (row -> ColumnIndex -> Maybe rowH) -> [rowH]
forall n row rowH.
GenericList n Seq row
-> ColumnIndex -> (row -> ColumnIndex -> Maybe rowH) -> [rowH]
visibleRowHdrs GenericList n Seq row
list ColumnIndex
aH row -> ColumnIndex -> Maybe rowH
rh) ListFocused
-> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n
drh

-- | Move to the left by one column.
gridMoveLeft :: GridTabularList n row cell rowH colH -- ^ The list
  -> GridTabularList n row cell rowH colH
gridMoveLeft :: forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveLeft GridTabularList n row cell rowH colH
gl = if Maybe ColumnIndex -> ListFocused
forall (t :: * -> *) a. Foldable t => t a -> ListFocused
null (Maybe ColumnIndex -> ListFocused)
-> Maybe ColumnIndex -> ListFocused
forall a b. (a -> b) -> a -> b
$ GridTabularList n row cell rowH colH
gl GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
-> Maybe ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "list"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row)
     (GenericList n Seq row))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
#list Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
-> Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
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
% IsLabel
  "listSelected"
  (Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex))
Optic
  A_Lens
  NoIx
  (GenericList n Seq row)
  (GenericList n Seq row)
  (Maybe ColumnIndex)
  (Maybe ColumnIndex)
#listSelected
  then GridTabularList n row cell rowH colH
gl
  else GridTabularList n row cell rowH colH
gl GridTabularList n row cell rowH colH
-> (GridTabularList n row cell rowH colH
    -> GridTabularList n row cell rowH colH)
-> GridTabularList n row cell rowH colH
forall a b. a -> (a -> b) -> b
& IsLabel
  "currentColumn"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     ColumnIndex
     ColumnIndex)
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  ColumnIndex
  ColumnIndex
#currentColumn Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  ColumnIndex
  ColumnIndex
-> (ColumnIndex -> ColumnIndex)
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Ord a => a -> a -> a
max ColumnIndex
0 (ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex) -> ColumnIndex -> ColumnIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
subtract ColumnIndex
1

-- | Move to the right by one column.
gridMoveRight :: GridTabularList n row cell rowH colH -- ^ The list
  -> GridTabularList n row cell rowH colH
gridMoveRight :: forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveRight GridTabularList n row cell rowH colH
gl = if Maybe ColumnIndex -> ListFocused
forall (t :: * -> *) a. Foldable t => t a -> ListFocused
null (Maybe ColumnIndex -> ListFocused)
-> Maybe ColumnIndex -> ListFocused
forall a b. (a -> b) -> a -> b
$ GridTabularList n row cell rowH colH
gl GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
-> Maybe ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "list"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row)
     (GenericList n Seq row))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
#list Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
-> Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
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
% IsLabel
  "listSelected"
  (Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex))
Optic
  A_Lens
  NoIx
  (GenericList n Seq row)
  (GenericList n Seq row)
  (Maybe ColumnIndex)
  (Maybe ColumnIndex)
#listSelected
  then GridTabularList n row cell rowH colH
gl
  else GridTabularList n row cell rowH colH
gl GridTabularList n row cell rowH colH
-> (GridTabularList n row cell rowH colH
    -> GridTabularList n row cell rowH colH)
-> GridTabularList n row cell rowH colH
forall a b. a -> (a -> b) -> b
& IsLabel
  "currentColumn"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     ColumnIndex
     ColumnIndex)
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  ColumnIndex
  ColumnIndex
#currentColumn Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  ColumnIndex
  ColumnIndex
-> (ColumnIndex -> ColumnIndex)
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Ord a => a -> a -> a
min (Seq ColumnIndex -> ColumnIndex
forall (t :: * -> *) a. Foldable t => t a -> ColumnIndex
length (GridTabularList n row cell rowH colH
gl GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Seq ColumnIndex)
-> Seq ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "sizes"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GridSizes rowH)
     (GridSizes rowH))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
#sizes Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
-> Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Seq ColumnIndex)
     (Seq ColumnIndex)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Seq ColumnIndex)
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
% IsLabel
  "row"
  (Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Seq ColumnIndex)
     (Seq ColumnIndex))
Optic
  A_Lens
  NoIx
  (GridSizes rowH)
  (GridSizes rowH)
  (Seq ColumnIndex)
  (Seq ColumnIndex)
#row) ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
- ColumnIndex
1) (ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex) -> ColumnIndex -> ColumnIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
+ColumnIndex
1)

-- | Move to the given column index
gridMoveTo :: ColumnIndex
  -> GridTabularList n row cell rowH colH -- ^ The list
  -> GridTabularList n row cell rowH colH
gridMoveTo :: forall n row cell rowH colH.
ColumnIndex
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveTo ColumnIndex
n GridTabularList n row cell rowH colH
gl = if Maybe ColumnIndex -> ListFocused
forall (t :: * -> *) a. Foldable t => t a -> ListFocused
null (Maybe ColumnIndex -> ListFocused)
-> Maybe ColumnIndex -> ListFocused
forall a b. (a -> b) -> a -> b
$ GridTabularList n row cell rowH colH
gl GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
-> Maybe ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "list"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row)
     (GenericList n Seq row))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
#list Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
-> Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
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
% IsLabel
  "listSelected"
  (Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex))
Optic
  A_Lens
  NoIx
  (GenericList n Seq row)
  (GenericList n Seq row)
  (Maybe ColumnIndex)
  (Maybe ColumnIndex)
#listSelected
  then GridTabularList n row cell rowH colH
gl
  else GridTabularList n row cell rowH colH
gl GridTabularList n row cell rowH colH
-> (GridTabularList n row cell rowH colH
    -> GridTabularList n row cell rowH colH)
-> GridTabularList n row cell rowH colH
forall a b. a -> (a -> b) -> b
& IsLabel
  "currentColumn"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     ColumnIndex
     ColumnIndex)
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  ColumnIndex
  ColumnIndex
#currentColumn Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  ColumnIndex
  ColumnIndex
-> ColumnIndex
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Ord a => a -> a -> a
max ColumnIndex
0 (ColumnIndex -> ColumnIndex)
-> (ColumnIndex -> ColumnIndex) -> ColumnIndex -> ColumnIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Ord a => a -> a -> a
min (Seq ColumnIndex -> ColumnIndex
forall (t :: * -> *) a. Foldable t => t a -> ColumnIndex
length (GridTabularList n row cell rowH colH
gl GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Seq ColumnIndex)
-> Seq ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "sizes"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GridSizes rowH)
     (GridSizes rowH))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
#sizes Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
-> Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Seq ColumnIndex)
     (Seq ColumnIndex)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Seq ColumnIndex)
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
% IsLabel
  "row"
  (Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Seq ColumnIndex)
     (Seq ColumnIndex))
Optic
  A_Lens
  NoIx
  (GridSizes rowH)
  (GridSizes rowH)
  (Seq ColumnIndex)
  (Seq ColumnIndex)
#row) ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
- ColumnIndex
1)) ColumnIndex
n

-- | Move to the first column.
gridMoveToBeginning :: GridTabularList n row cell rowH colH -- ^ The list
  -> GridTabularList n row cell rowH colH
gridMoveToBeginning :: forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveToBeginning GridTabularList n row cell rowH colH
gl = if Maybe ColumnIndex -> ListFocused
forall (t :: * -> *) a. Foldable t => t a -> ListFocused
null (Maybe ColumnIndex -> ListFocused)
-> Maybe ColumnIndex -> ListFocused
forall a b. (a -> b) -> a -> b
$ GridTabularList n row cell rowH colH
gl GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
-> Maybe ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "list"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row)
     (GenericList n Seq row))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
#list Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
-> Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
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
% IsLabel
  "listSelected"
  (Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex))
Optic
  A_Lens
  NoIx
  (GenericList n Seq row)
  (GenericList n Seq row)
  (Maybe ColumnIndex)
  (Maybe ColumnIndex)
#listSelected
  then GridTabularList n row cell rowH colH
gl
  else GridTabularList n row cell rowH colH
gl GridTabularList n row cell rowH colH
-> (GridTabularList n row cell rowH colH
    -> GridTabularList n row cell rowH colH)
-> GridTabularList n row cell rowH colH
forall a b. a -> (a -> b) -> b
& IsLabel
  "currentColumn"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     ColumnIndex
     ColumnIndex)
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  ColumnIndex
  ColumnIndex
#currentColumn Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  ColumnIndex
  ColumnIndex
-> ColumnIndex
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ColumnIndex
0

-- | Move to the last column.
gridMoveToEnd :: GridTabularList n row cell rowH colH -- ^ The list
  -> GridTabularList n row cell rowH colH 
gridMoveToEnd :: forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveToEnd GridTabularList n row cell rowH colH
gl = if Maybe ColumnIndex -> ListFocused
forall (t :: * -> *) a. Foldable t => t a -> ListFocused
null (Maybe ColumnIndex -> ListFocused)
-> Maybe ColumnIndex -> ListFocused
forall a b. (a -> b) -> a -> b
$ GridTabularList n row cell rowH colH
gl GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
-> Maybe ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "list"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row)
     (GenericList n Seq row))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
#list Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
-> Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
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
% IsLabel
  "listSelected"
  (Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex))
Optic
  A_Lens
  NoIx
  (GenericList n Seq row)
  (GenericList n Seq row)
  (Maybe ColumnIndex)
  (Maybe ColumnIndex)
#listSelected
  then GridTabularList n row cell rowH colH
gl
  else GridTabularList n row cell rowH colH
gl GridTabularList n row cell rowH colH
-> (GridTabularList n row cell rowH colH
    -> GridTabularList n row cell rowH colH)
-> GridTabularList n row cell rowH colH
forall a b. a -> (a -> b) -> b
& IsLabel
  "currentColumn"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     ColumnIndex
     ColumnIndex)
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  ColumnIndex
  ColumnIndex
#currentColumn Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  ColumnIndex
  ColumnIndex
-> ColumnIndex
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Seq ColumnIndex -> ColumnIndex
forall (t :: * -> *) a. Foldable t => t a -> ColumnIndex
length (GridTabularList n row cell rowH colH
gl GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Seq ColumnIndex)
-> Seq ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "sizes"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GridSizes rowH)
     (GridSizes rowH))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
#sizes Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
-> Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Seq ColumnIndex)
     (Seq ColumnIndex)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Seq ColumnIndex)
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
% IsLabel
  "row"
  (Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Seq ColumnIndex)
     (Seq ColumnIndex))
Optic
  A_Lens
  NoIx
  (GridSizes rowH)
  (GridSizes rowH)
  (Seq ColumnIndex)
  (Seq ColumnIndex)
#row) ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
- ColumnIndex
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 :: forall n row cell rowH colH.
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 GridRenderers n row cell rowH colH
r VisibleColumns
-> EventM n (GridTabularList n row cell rowH colH) ()
f = do
  GridTabularList n row cell rowH colH
l <- EventM
  n
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
forall s (m :: * -> *). MonadState s m => m s
get
  ListFocused
-> EventM n (GridTabularList n row cell rowH colH) ()
-> EventM n (GridTabularList n row cell rowH colH) ()
forall (f :: * -> *). Applicative f => ListFocused -> f () -> f ()
unless (Maybe ColumnIndex -> ListFocused
forall (t :: * -> *) a. Foldable t => t a -> ListFocused
null (Maybe ColumnIndex -> ListFocused)
-> Maybe ColumnIndex -> ListFocused
forall a b. (a -> b) -> a -> b
$ GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
-> Maybe ColumnIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "list"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row)
     (GenericList n Seq row))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
#list Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
-> Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex)
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe ColumnIndex)
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
% IsLabel
  "listSelected"
  (Optic
     A_Lens
     NoIx
     (GenericList n Seq row)
     (GenericList n Seq row)
     (Maybe ColumnIndex)
     (Maybe ColumnIndex))
Optic
  A_Lens
  NoIx
  (GenericList n Seq row)
  (GenericList n Seq row)
  (Maybe ColumnIndex)
  (Maybe ColumnIndex)
#listSelected) (EventM n (GridTabularList n row cell rowH colH) ()
 -> EventM n (GridTabularList n row cell rowH colH) ())
-> EventM n (GridTabularList n row cell rowH colH) ()
-> EventM n (GridTabularList n row cell rowH colH) ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe Viewport
v <- n
-> EventM n (GridTabularList n row cell rowH colH) (Maybe Viewport)
forall n s. Ord n => n -> EventM n s (Maybe Viewport)
lookupViewport (n
 -> EventM
      n (GridTabularList n row cell rowH colH) (Maybe Viewport))
-> n
-> EventM n (GridTabularList n row cell rowH colH) (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic' A_Lens NoIx (GridTabularList n row cell rowH colH) n -> n
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "list"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row)
     (GenericList n Seq row))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
#list Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
-> Optic
     A_Lens NoIx (GenericList n Seq row) (GenericList n Seq row) n n
-> Optic' A_Lens NoIx (GridTabularList n row cell rowH colH) n
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
% IsLabel
  "listName"
  (Optic
     A_Lens NoIx (GenericList n Seq row) (GenericList n Seq row) n n)
Optic
  A_Lens NoIx (GenericList n Seq row) (GenericList n Seq row) n n
#listName
    case Maybe Viewport
v of
      Maybe Viewport
Nothing -> () -> EventM n (GridTabularList n row cell rowH colH) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Viewport
vp -> let
        (ColumnIndex
aW, ColumnIndex
aH) = Viewport
vp Viewport
-> Optic' A_Lens NoIx Viewport (ColumnIndex, ColumnIndex)
-> (ColumnIndex, ColumnIndex)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "_vpSize" (Optic' A_Lens NoIx Viewport (ColumnIndex, ColumnIndex))
Optic' A_Lens NoIx Viewport (ColumnIndex, ColumnIndex)
#_vpSize
        rhw :: ColumnIndex
rhw = case (GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe (row -> ColumnIndex -> Maybe rowH))
-> Maybe (row -> ColumnIndex -> Maybe rowH)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "contents"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GridContents n row cell rowH colH)
     (GridContents n row cell rowH colH))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridContents n row cell rowH colH)
  (GridContents n row cell rowH colH)
#contents Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridContents n row cell rowH colH)
  (GridContents n row cell rowH colH)
-> Optic
     A_Lens
     NoIx
     (GridContents n row cell rowH colH)
     (GridContents n row cell rowH colH)
     (Maybe (row -> ColumnIndex -> Maybe rowH))
     (Maybe (row -> ColumnIndex -> Maybe rowH))
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe (row -> ColumnIndex -> Maybe rowH))
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
% IsLabel
  "rowHdr"
  (Optic
     A_Lens
     NoIx
     (GridContents n row cell rowH colH)
     (GridContents n row cell rowH colH)
     (Maybe (row -> ColumnIndex -> Maybe rowH))
     (Maybe (row -> ColumnIndex -> Maybe rowH)))
Optic
  A_Lens
  NoIx
  (GridContents n row cell rowH colH)
  (GridContents n row cell rowH colH)
  (Maybe (row -> ColumnIndex -> Maybe rowH))
  (Maybe (row -> ColumnIndex -> Maybe rowH))
#rowHdr, GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe (RowHeaderWidth rowH))
-> Maybe (RowHeaderWidth rowH)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "sizes"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GridSizes rowH)
     (GridSizes rowH))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
#sizes Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GridSizes rowH)
  (GridSizes rowH)
-> Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Maybe (RowHeaderWidth rowH))
     (Maybe (RowHeaderWidth rowH))
-> Optic'
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (Maybe (RowHeaderWidth rowH))
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
% IsLabel
  "rowHdr"
  (Optic
     A_Lens
     NoIx
     (GridSizes rowH)
     (GridSizes rowH)
     (Maybe (RowHeaderWidth rowH))
     (Maybe (RowHeaderWidth rowH)))
Optic
  A_Lens
  NoIx
  (GridSizes rowH)
  (GridSizes rowH)
  (Maybe (RowHeaderWidth rowH))
  (Maybe (RowHeaderWidth rowH))
#rowHdr, GridRenderers n row cell rowH colH
r GridRenderers n row cell rowH colH
-> Optic'
     A_Lens
     NoIx
     (GridRenderers n row cell rowH colH)
     (Maybe
        (ListFocused
         -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n))
-> Maybe
     (ListFocused
      -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "drawRowHdr"
  (Optic'
     A_Lens
     NoIx
     (GridRenderers n row cell rowH colH)
     (Maybe
        (ListFocused
         -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)))
Optic'
  A_Lens
  NoIx
  (GridRenderers n row cell rowH colH)
  (Maybe
     (ListFocused
      -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n))
#drawRowHdr) of
          (Maybe (row -> ColumnIndex -> Maybe rowH)
Nothing, Maybe (RowHeaderWidth rowH)
_, Maybe
  (ListFocused
   -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
_) -> ColumnIndex
0
          (Maybe (row -> ColumnIndex -> Maybe rowH)
_, Maybe (RowHeaderWidth rowH)
Nothing, Maybe
  (ListFocused
   -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
_) -> ColumnIndex
0
          (Maybe (row -> ColumnIndex -> Maybe rowH)
_, Maybe (RowHeaderWidth rowH)
_, Maybe
  (ListFocused
   -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
Nothing) -> ColumnIndex
0
          (Maybe (row -> ColumnIndex -> Maybe rowH)
_, Just (FixedRowHeader ColumnIndex
w), Maybe
  (ListFocused
   -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
_) -> ColumnIndex
w
          (Maybe (row -> ColumnIndex -> Maybe rowH)
_, Just (AvailRowHeader ColumnIndex -> ColumnIndex
w), Maybe
  (ListFocused
   -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
_) -> ColumnIndex -> ColumnIndex
w ColumnIndex
aW
          (Just row -> ColumnIndex -> Maybe rowH
rowH, Just (VisibleRowHeaders ColumnIndex -> [rowH] -> ColumnIndex
w), Maybe
  (ListFocused
   -> ColumnIndex -> Position -> row -> Maybe rowH -> Widget n)
_) -> ColumnIndex -> [rowH] -> ColumnIndex
w ColumnIndex
aW ([rowH] -> ColumnIndex) -> [rowH] -> ColumnIndex
forall a b. (a -> b) -> a -> b
$ GenericList n Seq row
-> ColumnIndex -> (row -> ColumnIndex -> Maybe rowH) -> [rowH]
forall n row rowH.
GenericList n Seq row
-> ColumnIndex -> (row -> ColumnIndex -> Maybe rowH) -> [rowH]
visibleRowHdrs (GridTabularList n row cell rowH colH
l GridTabularList n row cell rowH colH
-> Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row)
     (GenericList n Seq row)
-> GenericList n Seq row
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "list"
  (Optic
     A_Lens
     NoIx
     (GridTabularList n row cell rowH colH)
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row)
     (GenericList n Seq row))
Optic
  A_Lens
  NoIx
  (GridTabularList n row cell rowH colH)
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
  (GenericList n Seq row)
#list) ColumnIndex
aH row -> ColumnIndex -> Maybe rowH
rowH
        in VisibleColumns
-> EventM n (GridTabularList n row cell rowH colH) ()
f (VisibleColumns
 -> EventM n (GridTabularList n row cell rowH colH) ())
-> VisibleColumns
-> EventM n (GridTabularList n row cell rowH colH) ()
forall a b. (a -> b) -> a -> b
$ GridTabularList n row cell rowH colH
-> ColumnIndex -> VisibleColumns
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> ColumnIndex -> VisibleColumns
visibleColumns GridTabularList n row cell rowH colH
l (ColumnIndex -> VisibleColumns) -> ColumnIndex -> VisibleColumns
forall a b. (a -> b) -> a -> b
$ ColumnIndex
aW ColumnIndex -> ColumnIndex -> ColumnIndex
forall a. Num a => a -> a -> a
- ColumnIndex
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 :: forall n row cell rowH colH.
Ord n =>
GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
gridMovePageUp GridRenderers n row cell rowH colH
r = GridRenderers n row cell rowH colH
-> (VisibleColumns
    -> EventM n (GridTabularList n row cell rowH colH) ())
-> EventM n (GridTabularList n row cell rowH colH) ()
forall n row cell rowH colH.
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 GridRenderers n row cell rowH colH
r ((VisibleColumns
  -> EventM n (GridTabularList n row cell rowH colH) ())
 -> EventM n (GridTabularList n row cell rowH colH) ())
-> (VisibleColumns
    -> EventM n (GridTabularList n row cell rowH colH) ())
-> EventM n (GridTabularList n row cell rowH colH) ()
forall a b. (a -> b) -> a -> b
$ \case
  VisibleColumns
NoColumn -> () -> EventM n (GridTabularList n row cell rowH colH) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  VisibleColumns
CurrentColumn -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveLeft
  AnchoredLeft {} -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveToBeginning
  MiddleColumns {ColumnIndex
totalWidth :: ColumnIndex
offset :: ColumnIndex
right :: ColumnIndex
left :: ColumnIndex
$sel:totalWidth:NoColumn :: VisibleColumns -> ColumnIndex
$sel:offset:NoColumn :: VisibleColumns -> ColumnIndex
$sel:left:NoColumn :: VisibleColumns -> ColumnIndex
$sel:right:NoColumn :: VisibleColumns -> ColumnIndex
..} -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GridTabularList n row cell rowH colH
  -> GridTabularList n row cell rowH colH)
 -> EventM n (GridTabularList n row cell rowH colH) ())
-> (GridTabularList n row cell rowH colH
    -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall a b. (a -> b) -> a -> b
$ ColumnIndex
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
ColumnIndex
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveTo ColumnIndex
left
  AnchoredRight {ColumnIndex
totalWidth :: ColumnIndex
offset :: ColumnIndex
left :: ColumnIndex
$sel:totalWidth:NoColumn :: VisibleColumns -> ColumnIndex
$sel:offset:NoColumn :: VisibleColumns -> ColumnIndex
$sel:left:NoColumn :: VisibleColumns -> ColumnIndex
..} -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GridTabularList n row cell rowH colH
  -> GridTabularList n row cell rowH colH)
 -> EventM n (GridTabularList n row cell rowH colH) ())
-> (GridTabularList n row cell rowH colH
    -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall a b. (a -> b) -> a -> b
$ ColumnIndex
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
ColumnIndex
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveTo ColumnIndex
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 :: forall n row cell rowH colH.
Ord n =>
GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
gridMovePageDown GridRenderers n row cell rowH colH
r = GridRenderers n row cell rowH colH
-> (VisibleColumns
    -> EventM n (GridTabularList n row cell rowH colH) ())
-> EventM n (GridTabularList n row cell rowH colH) ()
forall n row cell rowH colH.
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 GridRenderers n row cell rowH colH
r ((VisibleColumns
  -> EventM n (GridTabularList n row cell rowH colH) ())
 -> EventM n (GridTabularList n row cell rowH colH) ())
-> (VisibleColumns
    -> EventM n (GridTabularList n row cell rowH colH) ())
-> EventM n (GridTabularList n row cell rowH colH) ()
forall a b. (a -> b) -> a -> b
$ \case
  VisibleColumns
NoColumn -> () -> EventM n (GridTabularList n row cell rowH colH) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  VisibleColumns
CurrentColumn -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveRight
  AnchoredLeft {ColumnIndex
right :: ColumnIndex
$sel:right:NoColumn :: VisibleColumns -> ColumnIndex
..} -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GridTabularList n row cell rowH colH
  -> GridTabularList n row cell rowH colH)
 -> EventM n (GridTabularList n row cell rowH colH) ())
-> (GridTabularList n row cell rowH colH
    -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall a b. (a -> b) -> a -> b
$ ColumnIndex
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
ColumnIndex
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveTo ColumnIndex
right
  MiddleColumns {ColumnIndex
totalWidth :: ColumnIndex
offset :: ColumnIndex
right :: ColumnIndex
left :: ColumnIndex
$sel:totalWidth:NoColumn :: VisibleColumns -> ColumnIndex
$sel:offset:NoColumn :: VisibleColumns -> ColumnIndex
$sel:left:NoColumn :: VisibleColumns -> ColumnIndex
$sel:right:NoColumn :: VisibleColumns -> ColumnIndex
..} -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GridTabularList n row cell rowH colH
  -> GridTabularList n row cell rowH colH)
 -> EventM n (GridTabularList n row cell rowH colH) ())
-> (GridTabularList n row cell rowH colH
    -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall a b. (a -> b) -> a -> b
$ ColumnIndex
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
ColumnIndex
-> GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveTo ColumnIndex
right
  AnchoredRight {} -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
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 :: forall n row cell rowH colH.
Ord n =>
GridRenderers n row cell rowH colH
-> Event -> EventM n (GridTabularList n row cell rowH colH) ()
handleGridListEvent GridRenderers n row cell rowH colH
r Event
e = case Event
e of
  EvKey Key
KLeft [] -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveLeft
  EvKey Key
KRight [] -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveRight
  EvKey Key
KHome [Modifier
MCtrl] -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveToBeginning
  EvKey Key
KEnd [Modifier
MCtrl] -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveToEnd
  EvKey Key
KPageUp [Modifier
MCtrl] -> GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
forall n row cell rowH colH.
Ord n =>
GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
gridMovePageUp GridRenderers n row cell rowH colH
r
  EvKey Key
KPageDown [Modifier
MCtrl] -> GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
forall n row cell rowH colH.
Ord n =>
GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
gridMovePageDown GridRenderers n row cell rowH colH
r
  Event
_ -> LensLike'
  (Zoomed (EventM n (GenericList n Seq row)) ())
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
-> EventM n (GenericList n Seq row) ()
-> EventM n (GridTabularList n row cell rowH colH) ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom IsLabel
  "list"
  (LensLike'
     (Focusing (StateT (EventState n) IO) ())
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row))
LensLike'
  (Zoomed (EventM n (GenericList n Seq row)) ())
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
#list (Event -> EventM n (GenericList n Seq row) ()
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 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 :: forall n row cell rowH colH.
Ord n =>
GridRenderers n row cell rowH colH
-> Event -> EventM n (GridTabularList n row cell rowH colH) ()
handleGridListEventVi GridRenderers n row cell rowH colH
r Event
e = case Event
e of
  EvKey (KChar Char
'h') [] -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveLeft
  EvKey (KChar Char
'l') [] -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveRight
  EvKey (KChar Char
'H') [] -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveToBeginning
  EvKey (KChar Char
'L') [] -> (GridTabularList n row cell rowH colH
 -> GridTabularList n row cell rowH colH)
-> EventM n (GridTabularList n row cell rowH colH) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
forall n row cell rowH colH.
GridTabularList n row cell rowH colH
-> GridTabularList n row cell rowH colH
gridMoveToEnd
  EvKey (KChar Char
'h') [Modifier
MMeta] -> GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
forall n row cell rowH colH.
Ord n =>
GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
gridMovePageUp GridRenderers n row cell rowH colH
r
  EvKey (KChar Char
'l') [Modifier
MMeta] -> GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
forall n row cell rowH colH.
Ord n =>
GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
gridMovePageDown GridRenderers n row cell rowH colH
r
  EvKey (KChar Char
'h') [Modifier
MAlt] -> GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
forall n row cell rowH colH.
Ord n =>
GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
gridMovePageUp GridRenderers n row cell rowH colH
r
  EvKey (KChar Char
'l') [Modifier
MAlt] -> GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
forall n row cell rowH colH.
Ord n =>
GridRenderers n row cell rowH colH
-> EventM n (GridTabularList n row cell rowH colH) ()
gridMovePageDown GridRenderers n row cell rowH colH
r
  Event
_ -> LensLike'
  (Zoomed (EventM n (GenericList n Seq row)) ())
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
-> EventM n (GenericList n Seq row) ()
-> EventM n (GridTabularList n row cell rowH colH) ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom IsLabel
  "list"
  (LensLike'
     (Focusing (StateT (EventState n) IO) ())
     (GridTabularList n row cell rowH colH)
     (GenericList n Seq row))
LensLike'
  (Zoomed (EventM n (GenericList n Seq row)) ())
  (GridTabularList n row cell rowH colH)
  (GenericList n Seq row)
#list ((Event -> EventM n (GenericList n Seq row) ())
-> Event -> EventM n (GenericList n Seq row) ()
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
_ -> () -> EventM n (GenericList n Seq row) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Event
e)