{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
-- | Grid tabular list is a uniform grid that supports cell-by-cell navigation.
--
-- ![demo-01](grid-tabular-list-01.png) ![demo-02](grid-tabular-list-02.png) ![demo-03](grid-tabular-list-03.png)
--
-- Because this list is designed to show arbitrary numbers of columns, horizontal scrolling is supported through
-- cell-by-cell navigation.
--
-- Grid tabular list tries to show the current column in the center. If it can't show the current column in the center,
-- it shows the first column in the left corner or the last column in the right corner.
--
-- It should be fast enough to handle a large spreadsheet. It is also suitable for an interface to a database table.
module Brick.Widgets.TabularList.Grid (
-- * Data types
  GridRowCtxt(..)
, GridColCtxt(..)
, GridCtxt(..)
, GridColHdr(..)
, GridRenderers(..)
, GridTabularList(..)
-- * List construction
, gridTabularList
-- * Rendering
, renderGridTabularList
-- * Column navigation #ColumnNavigation#
, gridMoveLeft
, gridMoveRight
, gridMoveTo
, gridMoveToBeginning
, gridMoveToEnd
, gridMovePageUp
, gridMovePageDown
-- * Event handlers
, handleGridListEvent
, handleGridListEventVi
-- * Shared types
, module Brick.Widgets.TabularList.Types
) where

import Brick.Widgets.TabularList.Types
import Brick.Widgets.TabularList.Internal.Common
import Brick.Widgets.TabularList.Internal.Lens
-- base
import GHC.Generics (Generic)
import Data.Foldable (toList)
import Control.Monad (unless)
-- Third party libraries
import Optics.Core ( (&), (%), (%~), (.~), (^.), coercedTo )
import qualified Data.Sequence as S
import Data.Sequence (Seq(..))
import Data.Generics.Labels
-- Brick & Vty
import qualified Brick.Widgets.List as L
import Brick.Types
import Brick.Widgets.Core
import Graphics.Vty (Event(..), Key(..), Modifier(..))
import Brick.Main (lookupViewport)

-- | Grid row context
data GridRowCtxt = GRowC {
  GridRowCtxt -> Index
index :: Index
, GridRowCtxt -> Selected
selected :: Selected
} deriving (GridRowCtxt -> GridRowCtxt -> Bool
(GridRowCtxt -> GridRowCtxt -> Bool)
-> (GridRowCtxt -> GridRowCtxt -> Bool) -> Eq GridRowCtxt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GridRowCtxt -> GridRowCtxt -> Bool
== :: GridRowCtxt -> GridRowCtxt -> Bool
$c/= :: GridRowCtxt -> GridRowCtxt -> Bool
/= :: GridRowCtxt -> GridRowCtxt -> Bool
Eq, (forall x. GridRowCtxt -> Rep GridRowCtxt x)
-> (forall x. Rep GridRowCtxt x -> GridRowCtxt)
-> Generic GridRowCtxt
forall x. Rep GridRowCtxt x -> GridRowCtxt
forall x. GridRowCtxt -> Rep GridRowCtxt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GridRowCtxt -> Rep GridRowCtxt x
from :: forall x. GridRowCtxt -> Rep GridRowCtxt x
$cto :: forall x. Rep GridRowCtxt x -> GridRowCtxt
to :: forall x. Rep GridRowCtxt x -> GridRowCtxt
Generic, Int -> GridRowCtxt -> ShowS
[GridRowCtxt] -> ShowS
GridRowCtxt -> String
(Int -> GridRowCtxt -> ShowS)
-> (GridRowCtxt -> String)
-> ([GridRowCtxt] -> ShowS)
-> Show GridRowCtxt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GridRowCtxt -> ShowS
showsPrec :: Int -> GridRowCtxt -> ShowS
$cshow :: GridRowCtxt -> String
show :: GridRowCtxt -> String
$cshowList :: [GridRowCtxt] -> ShowS
showList :: [GridRowCtxt] -> ShowS
Show)

-- | Grid column context
data GridColCtxt = GColC {
  GridColCtxt -> Index
index :: Index
, GridColCtxt -> Selected
selected :: Selected
} deriving (GridColCtxt -> GridColCtxt -> Bool
(GridColCtxt -> GridColCtxt -> Bool)
-> (GridColCtxt -> GridColCtxt -> Bool) -> Eq GridColCtxt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GridColCtxt -> GridColCtxt -> Bool
== :: GridColCtxt -> GridColCtxt -> Bool
$c/= :: GridColCtxt -> GridColCtxt -> Bool
/= :: GridColCtxt -> GridColCtxt -> Bool
Eq, (forall x. GridColCtxt -> Rep GridColCtxt x)
-> (forall x. Rep GridColCtxt x -> GridColCtxt)
-> Generic GridColCtxt
forall x. Rep GridColCtxt x -> GridColCtxt
forall x. GridColCtxt -> Rep GridColCtxt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GridColCtxt -> Rep GridColCtxt x
from :: forall x. GridColCtxt -> Rep GridColCtxt x
$cto :: forall x. Rep GridColCtxt x -> GridColCtxt
to :: forall x. Rep GridColCtxt x -> GridColCtxt
Generic, Int -> GridColCtxt -> ShowS
[GridColCtxt] -> ShowS
GridColCtxt -> String
(Int -> GridColCtxt -> ShowS)
-> (GridColCtxt -> String)
-> ([GridColCtxt] -> ShowS)
-> Show GridColCtxt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GridColCtxt -> ShowS
showsPrec :: Int -> GridColCtxt -> ShowS
$cshow :: GridColCtxt -> String
show :: GridColCtxt -> String
$cshowList :: [GridColCtxt] -> ShowS
showList :: [GridColCtxt] -> ShowS
Show)

-- | Context for grid cells
data GridCtxt = GrdCtxt {
  GridCtxt -> GridRowCtxt
row :: GridRowCtxt
, GridCtxt -> GridColCtxt
col :: GridColCtxt
} deriving (GridCtxt -> GridCtxt -> Bool
(GridCtxt -> GridCtxt -> Bool)
-> (GridCtxt -> GridCtxt -> Bool) -> Eq GridCtxt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GridCtxt -> GridCtxt -> Bool
== :: GridCtxt -> GridCtxt -> Bool
$c/= :: GridCtxt -> GridCtxt -> Bool
/= :: GridCtxt -> GridCtxt -> Bool
Eq, (forall x. GridCtxt -> Rep GridCtxt x)
-> (forall x. Rep GridCtxt x -> GridCtxt) -> Generic GridCtxt
forall x. Rep GridCtxt x -> GridCtxt
forall x. GridCtxt -> Rep GridCtxt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GridCtxt -> Rep GridCtxt x
from :: forall x. GridCtxt -> Rep GridCtxt x
$cto :: forall x. Rep GridCtxt x -> GridCtxt
to :: forall x. Rep GridCtxt x -> GridCtxt
Generic, Int -> GridCtxt -> ShowS
[GridCtxt] -> ShowS
GridCtxt -> String
(Int -> GridCtxt -> ShowS)
-> (GridCtxt -> String) -> ([GridCtxt] -> ShowS) -> Show GridCtxt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GridCtxt -> ShowS
showsPrec :: Int -> GridCtxt -> ShowS
$cshow :: GridCtxt -> String
show :: GridCtxt -> String
$cshowList :: [GridCtxt] -> ShowS
showList :: [GridCtxt] -> ShowS
Show)

-- | Grid column header
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data GridColHdr n = GridColHdr {
  forall n.
GridColHdr n
-> ListFocused -> WidthDeficit -> GridColCtxt -> Widget n
draw :: ListFocused -> WidthDeficit -> GridColCtxt -> Widget n
, forall n. GridColHdr n -> ColHdrHeight
height :: ColHdrHeight
} deriving (forall x. GridColHdr n -> Rep (GridColHdr n) x)
-> (forall x. Rep (GridColHdr n) x -> GridColHdr n)
-> Generic (GridColHdr n)
forall x. Rep (GridColHdr n) x -> GridColHdr n
forall x. GridColHdr n -> Rep (GridColHdr n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n x. Rep (GridColHdr n) x -> GridColHdr n
forall n x. GridColHdr n -> Rep (GridColHdr n) x
$cfrom :: forall n x. GridColHdr n -> Rep (GridColHdr n) x
from :: forall x. GridColHdr n -> Rep (GridColHdr n) x
$cto :: forall n x. Rep (GridColHdr n) x -> GridColHdr n
to :: forall x. Rep (GridColHdr n) x -> GridColHdr n
Generic

-- | Rendering functions for components of grid tabular list
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data GridRenderers n e = GridRenderers {
  forall n e.
GridRenderers n e
-> ListFocused -> WidthDeficit -> GridCtxt -> e -> Widget n
cell :: ListFocused -> WidthDeficit -> GridCtxt -> e -> Widget n
, forall n e. GridRenderers n e -> Maybe (RowHdr n e)
rowHdr :: Maybe (RowHdr n e)
, forall n e. GridRenderers n e -> Maybe (GridColHdr n)
colHdr :: Maybe (GridColHdr n)
, forall n e. GridRenderers n e -> Maybe (ColHdrRowHdr n)
colHdrRowHdr :: Maybe (ColHdrRowHdr n)
} deriving (forall x. GridRenderers n e -> Rep (GridRenderers n e) x)
-> (forall x. Rep (GridRenderers n e) x -> GridRenderers n e)
-> Generic (GridRenderers n e)
forall x. Rep (GridRenderers n e) x -> GridRenderers n e
forall x. GridRenderers n e -> Rep (GridRenderers n e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n e x. Rep (GridRenderers n e) x -> GridRenderers n e
forall n e x. GridRenderers n e -> Rep (GridRenderers n e) x
$cfrom :: forall n e x. GridRenderers n e -> Rep (GridRenderers n e) x
from :: forall x. GridRenderers n e -> Rep (GridRenderers n e) x
$cto :: forall n e x. Rep (GridRenderers n e) x -> GridRenderers n e
to :: forall x. Rep (GridRenderers n e) x -> GridRenderers n e
Generic

-- | * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
data GridTabularList n e = GridTabularList {
  -- | The underlying primitive list that comes from brick
  forall n e. GridTabularList n e -> GenericList n Seq e
list :: L.GenericList n Seq e
, forall n e. GridTabularList n e -> Seq ColWidth
widths :: Seq ColWidth
  -- | Manipulating this field directly is unsafe. Use
  -- [column navigation]("Brick.Widgets.TabularList.Grid#g:ColumnNavigation") functions to manipulate this. If you still
  -- want to manipulate this directly, create a function that manipulates it, and test the function properly.
, forall n e. GridTabularList n e -> Index
currentColumn :: Index
} deriving (forall x. GridTabularList n e -> Rep (GridTabularList n e) x)
-> (forall x. Rep (GridTabularList n e) x -> GridTabularList n e)
-> Generic (GridTabularList n e)
forall x. Rep (GridTabularList n e) x -> GridTabularList n e
forall x. GridTabularList n e -> Rep (GridTabularList n e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n e x. Rep (GridTabularList n e) x -> GridTabularList n e
forall n e x. GridTabularList n e -> Rep (GridTabularList n e) x
$cfrom :: forall n e x. GridTabularList n e -> Rep (GridTabularList n e) x
from :: forall x. GridTabularList n e -> Rep (GridTabularList n e) x
$cto :: forall n e x. Rep (GridTabularList n e) x -> GridTabularList n e
to :: forall x. Rep (GridTabularList n e) x -> GridTabularList n e
Generic

-- | Create a grid tabular list
gridTabularList
  :: n -- ^ The list name (must be unique)
  -> Seq e -- ^ The initial list elements
  -> ListItemHeight
  -> Seq ColWidth
  -> GridTabularList n e
gridTabularList :: forall n e.
n -> Seq e -> ListItemHeight -> Seq ColWidth -> GridTabularList n e
gridTabularList n
n Seq e
rows (LstItmH Int
h) Seq ColWidth
widths = GridTabularList {
  $sel:list:GridTabularList :: GenericList n Seq e
list = n -> Seq e -> Int -> GenericList n Seq e
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
L.list n
n Seq e
rows Int
h
, $sel:widths:GridTabularList :: Seq ColWidth
widths = Seq ColWidth
widths
, $sel:currentColumn:GridTabularList :: Index
currentColumn = Int -> Index
Ix Int
0
}

-- | Width accumulated in the process of traversing columns
newtype AccWidth = AccW Int deriving (AccWidth -> AccWidth -> Bool
(AccWidth -> AccWidth -> Bool)
-> (AccWidth -> AccWidth -> Bool) -> Eq AccWidth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccWidth -> AccWidth -> Bool
== :: AccWidth -> AccWidth -> Bool
$c/= :: AccWidth -> AccWidth -> Bool
/= :: AccWidth -> AccWidth -> Bool
Eq, Int -> AccWidth -> ShowS
[AccWidth] -> ShowS
AccWidth -> String
(Int -> AccWidth -> ShowS)
-> (AccWidth -> String) -> ([AccWidth] -> ShowS) -> Show AccWidth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccWidth -> ShowS
showsPrec :: Int -> AccWidth -> ShowS
$cshow :: AccWidth -> String
show :: AccWidth -> String
$cshowList :: [AccWidth] -> ShowS
showList :: [AccWidth] -> ShowS
Show)

data VisibleGridColumns =
  -- | No column is visible
  NoColumn |
  -- | Only current column is visible
  CurrentColumn |
  -- | The first column is shown at the left corner.
  AnchoredLeft {
      VisibleGridColumns -> Index
right :: Index -- ^ The rightmost column that is visible
  } |
  -- | The current column is shown in the center
  MiddleColumns {
    -- | The leftmost visible column
    VisibleGridColumns -> Index
left :: Index,
    -- | The rightmost visible column
    right :: Index,
    -- | Slide the columns to the left by this offset to show the current column in the center
    VisibleGridColumns -> Int
offset :: Int,
    -- | Total widths of all visible columns.
    VisibleGridColumns -> AccWidth
tW :: AccWidth
  } |
  -- | The last column is shown at the right corner.
  AnchoredRight {
    -- | The leftmost visible column
    left :: Index,
    -- | 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.
    tW :: AccWidth
  }
  deriving (VisibleGridColumns -> VisibleGridColumns -> Bool
(VisibleGridColumns -> VisibleGridColumns -> Bool)
-> (VisibleGridColumns -> VisibleGridColumns -> Bool)
-> Eq VisibleGridColumns
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VisibleGridColumns -> VisibleGridColumns -> Bool
== :: VisibleGridColumns -> VisibleGridColumns -> Bool
$c/= :: VisibleGridColumns -> VisibleGridColumns -> Bool
/= :: VisibleGridColumns -> VisibleGridColumns -> Bool
Eq, Int -> VisibleGridColumns -> ShowS
[VisibleGridColumns] -> ShowS
VisibleGridColumns -> String
(Int -> VisibleGridColumns -> ShowS)
-> (VisibleGridColumns -> String)
-> ([VisibleGridColumns] -> ShowS)
-> Show VisibleGridColumns
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VisibleGridColumns -> ShowS
showsPrec :: Int -> VisibleGridColumns -> ShowS
$cshow :: VisibleGridColumns -> String
show :: VisibleGridColumns -> String
$cshowList :: [VisibleGridColumns] -> ShowS
showList :: [VisibleGridColumns] -> ShowS
Show)

-- | Calculate visible columns with the width available for columns. It tries to show the current column in the center.
-- If it can't show the current column in the center, the first column is shown at the left corner, or the last column
-- is shown at the right corner.
visibleGridColumns :: GridTabularList n e -> AvailWidth -> VisibleGridColumns
visibleGridColumns :: forall n e. GridTabularList n e -> AvailWidth -> VisibleGridColumns
visibleGridColumns GridTabularList n e
l (AvlW Int
aW) = let
  (Ix Int
curCol) = GridTabularList n e
l GridTabularList n e
-> Optic' A_Lens NoIx (GridTabularList n e) Index -> Index
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (GridTabularList n e) Index
#currentColumn
  ws :: Seq ColWidth
ws = GridTabularList n e
l GridTabularList n e
-> Optic' A_Lens NoIx (GridTabularList n e) (Seq ColWidth)
-> Seq ColWidth
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (GridTabularList n e) (Seq ColWidth)
#widths
  in case Int -> Seq ColWidth -> (Seq ColWidth, Seq ColWidth)
forall a. Int -> Seq a -> (Seq a, Seq a)
S.splitAt Int
curCol Seq ColWidth
ws of
    -- If current column is outside the boundary of row columns, return `NoColumn`.
    (Seq ColWidth
_, Seq ColWidth
Empty) -> VisibleGridColumns
NoColumn
    (Seq ColWidth
left, ColW Int
cW :<| Seq ColWidth
right) -> if Int
aW Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
      -- If the available width is 0 or less than 0,
      then VisibleGridColumns
NoColumn
      -- If the available width is equal to or less than the current column's width,
      else if Int
aW Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cW
      then VisibleGridColumns
CurrentColumn
      -- Otherwise
      else let
        -- The amount of space to the left of the current column shown in the center.
        lW :: Int
lW = (Int
aW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cW) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        -- The amount of space to the right of the current column shown in the center.
        rW :: Int
rW = Int
aW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cW
        -- Calculate the leftmost visible column for the current column shown in the center.
        leftForMiddle :: Seq ColWidth -> Index -> AccWidth -> VisibleGridColumns
leftForMiddle (Seq ColWidth
l :|> ColW Int
w) (Ix Int
idx) (AccW Int
accW) = if Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lW
          -- If the leftmost visible column hasn't been reached, go to the left by one column.
          then Seq ColWidth -> Index -> AccWidth -> VisibleGridColumns
leftForMiddle Seq ColWidth
l (Int -> Index
Ix (Int -> Index) -> Int -> Index
forall a b. (a -> b) -> a -> b
$ Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> AccWidth
AccW (Int -> AccWidth) -> Int -> AccWidth
forall a b. (a -> b) -> a -> b
$ Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w)
          -- If the leftmost visible column has been reached, calculate the rightmost visible column.
          else Index
-> AccWidth
-> Seq ColWidth
-> Index
-> AccWidth
-> VisibleGridColumns
rightForMiddle (Int -> Index
Ix Int
idx) (Int -> AccWidth
AccW (Int -> AccWidth) -> Int -> AccWidth
forall a b. (a -> b) -> a -> b
$ Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w) Seq ColWidth
right (Int -> Index
Ix (Int -> Index) -> Int -> Index
forall a b. (a -> b) -> a -> b
$ Int
curCol Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> AccWidth
AccW Int
0)
        -- If there aren't enough columns to the left of the current column shown in the center, calculate the rightmost
        -- visible column for the first column shown at the left corner.
        leftForMiddle Seq ColWidth
Empty Index
_ (AccW Int
accW) = Seq ColWidth -> Index -> AccWidth -> VisibleGridColumns
rightForLeft Seq ColWidth
right (Int -> Index
Ix (Int -> Index) -> Int -> Index
forall a b. (a -> b) -> a -> b
$ Int
curColInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> AccWidth
AccW (Int -> AccWidth) -> Int -> AccWidth
forall a b. (a -> b) -> a -> b
$ Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
cW)
        -- Calculate the rightmost visible column for the current column shown in the center.
        rightForMiddle :: Index
-> AccWidth
-> Seq ColWidth
-> Index
-> AccWidth
-> VisibleGridColumns
rightForMiddle (Ix Int
li) (AccW Int
lAccW) (ColW Int
w :<| Seq ColWidth
r) (Ix Int
ri) (AccW Int
accW) = if Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rW
          -- If the rightmost visible column hasn't been reached, go to the right by one column.
          then Index
-> AccWidth
-> Seq ColWidth
-> Index
-> AccWidth
-> VisibleGridColumns
rightForMiddle (Int -> Index
Ix Int
li) (Int -> AccWidth
AccW Int
lAccW) Seq ColWidth
r (Int -> Index
Ix (Int -> Index) -> Int -> Index
forall a b. (a -> b) -> a -> b
$ Int
riInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> AccWidth
AccW (Int -> AccWidth) -> Int -> AccWidth
forall a b. (a -> b) -> a -> b
$ Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w)
          -- If the rightmost visible column has been reached, return 'MiddleColumns'.
          else MiddleColumns { $sel:left:NoColumn :: Index
left = Int -> Index
Ix Int
li, $sel:right:NoColumn :: Index
right = Int -> Index
Ix Int
ri, $sel:offset:NoColumn :: Int
offset = Int
lAccWInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lW, $sel:tW:NoColumn :: AccWidth
tW = Int -> AccWidth
AccW (Int -> AccWidth) -> Int -> AccWidth
forall a b. (a -> b) -> a -> b
$ Int
lAccWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
cWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w }
        -- If there aren't enough columns to the right of the current column shown in the center, calculate the leftmost
        -- visible column for the last column shown at the right corner.
        rightForMiddle Index
_ AccWidth
_ Seq ColWidth
Empty Index
_ (AccW Int
accW) = Seq ColWidth -> Index -> AccWidth -> VisibleGridColumns
leftForRight Seq ColWidth
left (Int -> Index
Ix (Int -> Index) -> Int -> Index
forall a b. (a -> b) -> a -> b
$ Int
curColInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> AccWidth
AccW (Int -> AccWidth) -> Int -> AccWidth
forall a b. (a -> b) -> a -> b
$ Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
cW)
        -- Calculate the rightmost visible column for the first column shown at the left corner.
        rightForLeft :: Seq ColWidth -> Index -> AccWidth -> VisibleGridColumns
rightForLeft (ColW Int
w :<| Seq ColWidth
r) (Ix Int
idx) (AccW Int
accW) = if Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
aW
          -- If the rightmost visible column hasn't been reached, go to the right by one column.
          then Seq ColWidth -> Index -> AccWidth -> VisibleGridColumns
rightForLeft Seq ColWidth
r (Int -> Index
Ix (Int -> Index) -> Int -> Index
forall a b. (a -> b) -> a -> b
$ Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> AccWidth
AccW (Int -> AccWidth) -> Int -> AccWidth
forall a b. (a -> b) -> a -> b
$ Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w)
          -- If the rightmost visible column has been reached, return 'AnchoredLeft'.
          else Index -> VisibleGridColumns
AnchoredLeft (Index -> VisibleGridColumns) -> Index -> VisibleGridColumns
forall a b. (a -> b) -> a -> b
$ Int -> Index
Ix Int
idx
        -- If there aren't enough columns to fill the available width with the first column at the left corner, return
        -- 'AnchoredLeft' with the last column as the rightmost visible column.
        rightForLeft Seq ColWidth
Empty (Ix Int
idx) AccWidth
_ = Index -> VisibleGridColumns
AnchoredLeft (Int -> Index
Ix (Int -> Index) -> Int -> Index
forall a b. (a -> b) -> a -> b
$ Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
        -- Calculate the leftmost visible column for the last column shown at the right corner.
        leftForRight :: Seq ColWidth -> Index -> AccWidth -> VisibleGridColumns
leftForRight (Seq ColWidth
l :|> ColW Int
w) (Ix Int
idx) (AccW Int
accW) = if Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
aW
          -- If the leftmost visible column hasn't been reached, go to the left by one column.
          then Seq ColWidth -> Index -> AccWidth -> VisibleGridColumns
leftForRight Seq ColWidth
l (Int -> Index
Ix (Int -> Index) -> Int -> Index
forall a b. (a -> b) -> a -> b
$ Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> AccWidth
AccW (Int -> AccWidth) -> Int -> AccWidth
forall a b. (a -> b) -> a -> b
$ Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w)
          -- If the leftmost visible column has been reached, return 'AnchoredRight'.
          else AnchoredRight { $sel:left:NoColumn :: Index
left = Int -> Index
Ix Int
idx, $sel:offset:NoColumn :: Int
offset = Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
aW, $sel:tW:NoColumn :: AccWidth
tW = Int -> AccWidth
AccW (Int -> AccWidth) -> Int -> AccWidth
forall a b. (a -> b) -> a -> b
$ Int
accWInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w }
        -- If there aren't enough columns to fill the available width with the last column at the right corner, return
        -- 'AnchoredLeft' with the last column as the rightmost visible column.
        leftForRight Seq ColWidth
Empty Index
_ AccWidth
_ = Index -> VisibleGridColumns
AnchoredLeft (Index -> VisibleGridColumns) -> Index -> VisibleGridColumns
forall a b. (a -> b) -> a -> b
$ Int -> Index
Ix (Int -> Index) -> Int -> Index
forall a b. (a -> b) -> a -> b
$ Seq ColWidth -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq ColWidth
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        in Seq ColWidth -> Index -> AccWidth -> VisibleGridColumns
leftForMiddle Seq ColWidth
left (Int -> Index
Ix (Int -> Index) -> Int -> Index
forall a b. (a -> b) -> a -> b
$ Int
curColInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> AccWidth
AccW Int
0)

-- | Height for tabular list components
newtype Height = H Int deriving (Height -> Height -> Bool
(Height -> Height -> Bool)
-> (Height -> Height -> Bool) -> Eq Height
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Height -> Height -> Bool
== :: Height -> Height -> Bool
$c/= :: Height -> Height -> Bool
/= :: Height -> Height -> Bool
Eq, Int -> Height -> ShowS
[Height] -> ShowS
Height -> String
(Int -> Height -> ShowS)
-> (Height -> String) -> ([Height] -> ShowS) -> Show Height
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Height -> ShowS
showsPrec :: Int -> Height -> ShowS
$cshow :: Height -> String
show :: Height -> String
$cshowList :: [Height] -> ShowS
showList :: [Height] -> ShowS
Show)

-- | Render column headers or row columns
renderGridColumns
  :: GridTabularList n e
  -> VisibleGridColumns
  -> (WidthDeficit -> Index -> ColWidth -> Widget n)
  -> Height
  -> Widget n
renderGridColumns :: forall n e.
GridTabularList n e
-> VisibleGridColumns
-> (WidthDeficit -> Index -> ColWidth -> Widget n)
-> Height
-> Widget n
renderGridColumns GridTabularList n e
l VisibleGridColumns
vCs WidthDeficit -> Index -> ColWidth -> Widget n
dC (H Int
h) = 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 ColWidth
cWs = GridTabularList n e
l GridTabularList n e
-> Optic' A_Lens NoIx (GridTabularList n e) (Seq ColWidth)
-> Seq ColWidth
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (GridTabularList n e) (Seq ColWidth)
#widths
      Ix Int
curCol = GridTabularList n e
l GridTabularList n e
-> Optic' A_Lens NoIx (GridTabularList n e) Index -> Index
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (GridTabularList n e) Index
#currentColumn
      aW :: Int
aW = Context n
cContext n -> Getting Int (Context n) Int -> Int
forall {s} {a}. s -> Getting a s a -> a
^^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
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 VisibleGridColumns
vCs of
    VisibleGridColumns
NoColumn -> Widget n
forall n. Widget n
emptyWidget
    VisibleGridColumns
CurrentColumn -> case Int -> Seq ColWidth -> Maybe ColWidth
forall a. Int -> Seq a -> Maybe a
S.lookup Int
curCol Seq ColWidth
cWs of
      Maybe ColWidth
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
<> Int -> String
forall a. Show a => a -> String
show Int
curCol String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is outside the boundary of column widths."
      Just (ColW Int
cW) -> WidthDeficit -> Index -> ColWidth -> Widget n
dC (Int -> WidthDeficit
WdthD (Int -> WidthDeficit) -> Int -> WidthDeficit
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
cW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
aW) (Int -> Index
Ix Int
curCol) (Int -> ColWidth
ColW Int
aW)
    AnchoredLeft {$sel:right:NoColumn :: VisibleGridColumns -> Index
right=Ix Int
r} -> [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
$ (Index -> ColWidth -> Widget n)
-> [Index] -> [ColWidth] -> [Widget n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (WidthDeficit -> Index -> ColWidth -> Widget n
dC (WidthDeficit -> Index -> ColWidth -> Widget n)
-> WidthDeficit -> Index -> ColWidth -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> WidthDeficit
WdthD Int
0) [Int -> Index
Ix Int
0..] ([ColWidth] -> [Widget n]) -> [ColWidth] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ Seq ColWidth -> [ColWidth]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq ColWidth -> [ColWidth]) -> Seq ColWidth -> [ColWidth]
forall a b. (a -> b) -> a -> b
$ Int -> Seq ColWidth -> Seq ColWidth
forall a. Int -> Seq a -> Seq a
S.take (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Seq ColWidth
cWs
    MiddleColumns {$sel:left:NoColumn :: VisibleGridColumns -> Index
left=Ix Int
l, $sel:right:NoColumn :: VisibleGridColumns -> Index
right=Ix Int
r, Int
$sel:offset:NoColumn :: VisibleGridColumns -> Int
offset :: Int
offset, $sel:tW:NoColumn :: VisibleGridColumns -> AccWidth
tW=AccW Int
tw} -> Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
cropLeftBy Int
offset (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Widget n -> Widget n
forall n. (Int, Int) -> Widget n -> Widget n
sz (Int
tw, Int
h) (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
$ (Index -> ColWidth -> Widget n)
-> [Index] -> [ColWidth] -> [Widget n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (WidthDeficit -> Index -> ColWidth -> Widget n
dC (WidthDeficit -> Index -> ColWidth -> Widget n)
-> WidthDeficit -> Index -> ColWidth -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> WidthDeficit
WdthD Int
0) [Int -> Index
Ix Int
l..] ([ColWidth] -> [Widget n]) -> [ColWidth] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ Seq ColWidth -> [ColWidth]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq ColWidth -> [ColWidth]) -> Seq ColWidth -> [ColWidth]
forall a b. (a -> b) -> a -> b
$ Int -> Seq ColWidth -> Seq ColWidth
forall a. Int -> Seq a -> Seq a
S.take (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Seq ColWidth -> Seq ColWidth) -> Seq ColWidth -> Seq ColWidth
forall a b. (a -> b) -> a -> b
$ Int -> Seq ColWidth -> Seq ColWidth
forall a. Int -> Seq a -> Seq a
S.drop Int
l Seq ColWidth
cWs
    AnchoredRight {$sel:left:NoColumn :: VisibleGridColumns -> Index
left=Ix Int
l, Int
$sel:offset:NoColumn :: VisibleGridColumns -> Int
offset :: Int
offset, $sel:tW:NoColumn :: VisibleGridColumns -> AccWidth
tW=AccW Int
tw} -> Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
cropLeftBy Int
offset (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Widget n -> Widget n
forall n. (Int, Int) -> Widget n -> Widget n
sz (Int
tw, Int
h) (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
$ (Index -> ColWidth -> Widget n)
-> [Index] -> [ColWidth] -> [Widget n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (WidthDeficit -> Index -> ColWidth -> Widget n
dC (WidthDeficit -> Index -> ColWidth -> Widget n)
-> WidthDeficit -> Index -> ColWidth -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> WidthDeficit
WdthD Int
0) [Int -> Index
Ix Int
l..] ([ColWidth] -> [Widget n]) -> [ColWidth] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ Seq ColWidth -> [ColWidth]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq ColWidth -> [ColWidth]) -> Seq ColWidth -> [ColWidth]
forall a b. (a -> b) -> a -> b
$ Int -> Seq ColWidth -> Seq ColWidth
forall a. Int -> Seq a -> Seq a
S.drop Int
l Seq ColWidth
cWs

-- | Render grid tabular list
renderGridTabularList :: (Ord n, Show n)
  => GridRenderers n e
  -> ListFocused
  -> GridTabularList n e -- ^ The list
  -> Widget n
renderGridTabularList :: forall n e.
(Ord n, Show n) =>
GridRenderers n e -> ListFocused -> GridTabularList n e -> Widget n
renderGridTabularList GridRenderers n e
r (LstFcs Bool
f) GridTabularList n e
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 aW :: Int
aW = Context n
cContext n -> Getting Int (Context n) Int -> Int
forall {s} {a}. s -> Getting a s a -> a
^^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL
      aH :: Int
aH = Context n
cContext n -> Getting Int (Context n) Int -> Int
forall {s} {a}. s -> Getting a s a -> a
^^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL
      cell :: ListFocused -> WidthDeficit -> GridCtxt -> e -> Widget n
cell = GridRenderers n e
r GridRenderers n e
-> Optic'
     A_Lens
     NoIx
     (GridRenderers n e)
     (ListFocused -> WidthDeficit -> GridCtxt -> e -> Widget n)
-> ListFocused
-> WidthDeficit
-> GridCtxt
-> e
-> Widget n
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens
  NoIx
  (GridRenderers n e)
  (ListFocused -> WidthDeficit -> GridCtxt -> e -> Widget n)
#cell
      GridTabularList {$sel:list:GridTabularList :: forall n e. GridTabularList n e -> GenericList n Seq e
list=GenericList n Seq e
l', $sel:currentColumn:GridTabularList :: forall n e. GridTabularList n e -> Index
currentColumn=Index
curCol} = GridTabularList n e
l
      iH :: Int
iH = GenericList n Seq e
l' GenericList n Seq e
-> Optic' A_Lens NoIx (GenericList n Seq e) Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (GenericList n Seq e) Int
#listItemHeight
      colHdrRow :: VisibleGridColumns -> RowHdrWidth -> WidthDeficit -> Widget n
colHdrRow VisibleGridColumns
vCs (RowHdrW Int
rhw) (WdthD Int
rhwd) = case GridRenderers n e
r GridRenderers n e
-> Optic' A_Lens NoIx (GridRenderers n e) (Maybe (GridColHdr n))
-> Maybe (GridColHdr n)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (GridRenderers n e) (Maybe (GridColHdr n))
#colHdr of
        Maybe (GridColHdr n)
Nothing -> Widget n
forall n. Widget n
emptyWidget
        Just (GridColHdr {ListFocused -> WidthDeficit -> GridColCtxt -> Widget n
$sel:draw:GridColHdr :: forall n.
GridColHdr n
-> ListFocused -> WidthDeficit -> GridColCtxt -> Widget n
draw :: ListFocused -> WidthDeficit -> GridColCtxt -> Widget n
draw, $sel:height:GridColHdr :: forall n. GridColHdr n -> ColHdrHeight
height=ColHdrH Int
chh}) -> let
          col :: WidthDeficit -> Index -> ColWidth -> Widget n
col WidthDeficit
wd Index
c (ColW Int
w) = (Int, Int) -> Widget n -> Widget n
forall n. (Int, Int) -> Widget n -> Widget n
sz (Int
w, Int
chh) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ListFocused -> WidthDeficit -> GridColCtxt -> Widget n
draw (Bool -> ListFocused
LstFcs Bool
f) WidthDeficit
wd (GridColCtxt -> Widget n) -> GridColCtxt -> Widget n
forall a b. (a -> b) -> a -> b
$ Index -> Selected -> GridColCtxt
GColC Index
c (Selected -> GridColCtxt) -> Selected -> GridColCtxt
forall a b. (a -> b) -> a -> b
$ Bool -> Selected
Sel (Index
c Index -> Index -> Bool
forall a. Eq a => a -> a -> Bool
== Index
curCol)
          chrh :: Widget n
chrh = case GridRenderers n e
r GridRenderers n e
-> Optic' A_Lens NoIx (GridRenderers n e) (Maybe (ColHdrRowHdr n))
-> Maybe (ColHdrRowHdr n)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (GridRenderers n e) (Maybe (ColHdrRowHdr n))
#colHdrRowHdr of
            Maybe (ColHdrRowHdr n)
Nothing -> Char -> Widget n
forall n. Char -> Widget n
fill Char
' '
            Just (ColHdrRowHdr ListFocused -> WidthDeficit -> Widget n
chrh) -> ListFocused -> WidthDeficit -> Widget n
chrh (Bool -> ListFocused
LstFcs Bool
f) (Int -> WidthDeficit
WdthD Int
rhwd)
          in (Int, Int) -> Widget n -> Widget n
forall n. (Int, Int) -> Widget n -> Widget n
sz (Int
rhw, Int
chh) Widget n
chrh Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> GridTabularList n e
-> VisibleGridColumns
-> (WidthDeficit -> Index -> ColWidth -> Widget n)
-> Height
-> Widget n
forall n e.
GridTabularList n e
-> VisibleGridColumns
-> (WidthDeficit -> Index -> ColWidth -> Widget n)
-> Height
-> Widget n
renderGridColumns GridTabularList n e
l VisibleGridColumns
vCs WidthDeficit -> Index -> ColWidth -> Widget n
col (Int -> Height
H Int
chh)
      row :: VisibleGridColumns -> Int -> Bool -> e -> Widget n
row VisibleGridColumns
vCs Int
i Bool
f e
r = let
        col :: WidthDeficit -> Index -> ColWidth -> Widget n
col WidthDeficit
wd Index
c (ColW Int
w) = let gc :: GridCtxt
gc = GridRowCtxt -> GridColCtxt -> GridCtxt
GrdCtxt (Index -> Selected -> GridRowCtxt
GRowC (Int -> Index
Ix Int
i) (Bool -> Selected
Sel Bool
f)) (GridColCtxt -> GridCtxt) -> GridColCtxt -> GridCtxt
forall a b. (a -> b) -> a -> b
$ Index -> Selected -> GridColCtxt
GColC Index
c (Selected -> GridColCtxt) -> Selected -> GridColCtxt
forall a b. (a -> b) -> a -> b
$ Bool -> Selected
Sel (Index
c Index -> Index -> Bool
forall a. Eq a => a -> a -> Bool
== Index
curCol)
          in (Int, Int) -> Widget n -> Widget n
forall n. (Int, Int) -> Widget n -> Widget n
sz (Int
w, Int
iH) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ListFocused -> WidthDeficit -> GridCtxt -> e -> Widget n
cell (Bool -> ListFocused
LstFcs Bool
f) WidthDeficit
wd GridCtxt
gc e
r
        in GridTabularList n e
-> VisibleGridColumns
-> (WidthDeficit -> Index -> ColWidth -> Widget n)
-> Height
-> Widget n
forall n e.
GridTabularList n e
-> VisibleGridColumns
-> (WidthDeficit -> Index -> ColWidth -> Widget n)
-> Height
-> Widget n
renderGridColumns GridTabularList n e
l VisibleGridColumns
vCs WidthDeficit -> Index -> ColWidth -> Widget n
col (Int -> Height
H Int
iH)
      lst :: RenderM n (Result n)
lst = let vCs :: VisibleGridColumns
vCs = GridTabularList n e -> AvailWidth -> VisibleGridColumns
forall n e. GridTabularList n e -> AvailWidth -> VisibleGridColumns
visibleGridColumns GridTabularList n e
l (Int -> AvailWidth
AvlW Int
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
$ VisibleGridColumns -> RowHdrWidth -> WidthDeficit -> Widget n
colHdrRow VisibleGridColumns
vCs (Int -> RowHdrWidth
RowHdrW Int
0) (Int -> WidthDeficit
WdthD Int
0) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> (Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n Seq e -> Widget n
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
L.renderListWithIndex (VisibleGridColumns -> Int -> Bool -> e -> Widget n
row VisibleGridColumns
vCs) Bool
f GenericList n Seq e
l'
      hdrLst :: RowHdr n e -> RenderM n (Result n)
hdrLst (RowHdr {$sel:draw:RowHdr :: ()
draw=ListFocused -> WidthDeficit -> RowHdrCtxt -> r -> Widget n
drw, AvailWidth -> [r] -> RowHdrWidth
width :: AvailWidth -> [r] -> RowHdrWidth
$sel:width:RowHdr :: ()
width, $sel:toRH:RowHdr :: ()
toRH=e -> Index -> r
tR}) = let
        RowHdrW Int
rhw' = AvailWidth -> [r] -> RowHdrWidth
width (Int -> AvailWidth
AvlW Int
aW) ([r] -> RowHdrWidth) -> [r] -> RowHdrWidth
forall a b. (a -> b) -> a -> b
$ ([e] -> [Index] -> [r]) -> ([e], [Index]) -> [r]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((e -> Index -> r) -> [e] -> [Index] -> [r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith e -> Index -> r
tR) (([e], [Index]) -> [r]) -> ([e], [Index]) -> [r]
forall a b. (a -> b) -> a -> b
$ GenericList n Seq e -> AvailHeight -> ([e], [Index])
forall n e. GenericList n Seq e -> AvailHeight -> ([e], [Index])
visibleRowIdx GenericList n Seq e
l' (Int -> AvailHeight
AvlH Int
aH)
        rhw :: Int
rhw = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
rhw' Int
aW
        rhwd :: WidthDeficit
rhwd = Int -> WidthDeficit
WdthD (Int -> WidthDeficit) -> Int -> WidthDeficit
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
rhw' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
aW
        vCs :: VisibleGridColumns
vCs = GridTabularList n e -> AvailWidth -> VisibleGridColumns
forall n e. GridTabularList n e -> AvailWidth -> VisibleGridColumns
visibleGridColumns GridTabularList n e
l (AvailWidth -> VisibleGridColumns)
-> AvailWidth -> VisibleGridColumns
forall a b. (a -> b) -> a -> b
$ Int -> AvailWidth
AvlW (Int -> AvailWidth) -> Int -> AvailWidth
forall a b. (a -> b) -> a -> b
$ Int
aW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rhw
        hdrRow :: Int -> Bool -> e -> Widget n
hdrRow Int
i Bool
f e
r = (Int, Int) -> Widget n -> Widget n
forall n. (Int, Int) -> Widget n -> Widget n
sz (Int
rhw, Int
iH) (ListFocused -> WidthDeficit -> RowHdrCtxt -> r -> Widget n
drw (Bool -> ListFocused
LstFcs Bool
f) WidthDeficit
rhwd (Selected -> RowHdrCtxt
RowHdrCtxt (Selected -> RowHdrCtxt) -> Selected -> RowHdrCtxt
forall a b. (a -> b) -> a -> b
$ Bool -> Selected
Sel Bool
f) (r -> Widget n) -> r -> Widget n
forall a b. (a -> b) -> a -> b
$ e -> Index -> r
tR e
r (Int -> Index
Ix Int
i)) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> VisibleGridColumns -> Int -> Bool -> e -> Widget n
row VisibleGridColumns
vCs Int
i Bool
f e
r
        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
$ VisibleGridColumns -> RowHdrWidth -> WidthDeficit -> Widget n
colHdrRow VisibleGridColumns
vCs (Int -> RowHdrWidth
RowHdrW Int
rhw) WidthDeficit
rhwd Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> (Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n Seq e -> Widget n
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
L.renderListWithIndex Int -> Bool -> e -> Widget n
hdrRow Bool
f GenericList n Seq e
l'
  RenderM n (Result n)
-> (RowHdr n e -> RenderM n (Result n))
-> Maybe (RowHdr n e)
-> RenderM n (Result n)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RenderM n (Result n)
lst RowHdr n e -> RenderM n (Result n)
hdrLst (Maybe (RowHdr n e) -> RenderM n (Result n))
-> Maybe (RowHdr n e) -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ GridRenderers n e
r GridRenderers n e
-> Optic' A_Lens NoIx (GridRenderers n e) (Maybe (RowHdr n e))
-> Maybe (RowHdr n e)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (GridRenderers n e) (Maybe (RowHdr n e))
#rowHdr

-- | Move to the left by one column.
gridMoveLeft
  :: GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveLeft :: forall n e. GridTabularList n e -> GridTabularList n e
gridMoveLeft GridTabularList n e
gl = if Maybe Int -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GridTabularList n e
gl GridTabularList n e
-> Optic' A_Lens NoIx (GridTabularList n e) (Maybe Int)
-> Maybe Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (GridTabularList n e)
  (GridTabularList n e)
  (GenericList n Seq e)
  (GenericList n Seq e)
#list Optic
  A_Lens
  NoIx
  (GridTabularList n e)
  (GridTabularList n e)
  (GenericList n Seq e)
  (GenericList n Seq e)
-> Optic
     A_Lens
     NoIx
     (GenericList n Seq e)
     (GenericList n Seq e)
     (Maybe Int)
     (Maybe Int)
-> Optic' A_Lens NoIx (GridTabularList n e) (Maybe Int)
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
% Optic
  A_Lens
  NoIx
  (GenericList n Seq e)
  (GenericList n Seq e)
  (Maybe Int)
  (Maybe Int)
#listSelected
  then GridTabularList n e
gl
  else GridTabularList n e
gl GridTabularList n e
-> (GridTabularList n e -> GridTabularList n e)
-> GridTabularList n e
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Index Index
#currentColumn Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Index Index
-> Optic An_Iso NoIx Index Index Int Int
-> Optic
     A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a s. Coercible s a => Iso' s a
coercedTo @Int Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Int Int
-> (Int -> Int) -> GridTabularList n e -> GridTabularList n e
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1

-- | Move to the right by one column.
gridMoveRight
  :: GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveRight :: forall n e. GridTabularList n e -> GridTabularList n e
gridMoveRight GridTabularList n e
gl = if Maybe Int -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GridTabularList n e
gl GridTabularList n e
-> Optic' A_Lens NoIx (GridTabularList n e) (Maybe Int)
-> Maybe Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (GridTabularList n e)
  (GridTabularList n e)
  (GenericList n Seq e)
  (GenericList n Seq e)
#list Optic
  A_Lens
  NoIx
  (GridTabularList n e)
  (GridTabularList n e)
  (GenericList n Seq e)
  (GenericList n Seq e)
-> Optic
     A_Lens
     NoIx
     (GenericList n Seq e)
     (GenericList n Seq e)
     (Maybe Int)
     (Maybe Int)
-> Optic' A_Lens NoIx (GridTabularList n e) (Maybe Int)
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
% Optic
  A_Lens
  NoIx
  (GenericList n Seq e)
  (GenericList n Seq e)
  (Maybe Int)
  (Maybe Int)
#listSelected
  then GridTabularList n e
gl
  else GridTabularList n e
gl GridTabularList n e
-> (GridTabularList n e -> GridTabularList n e)
-> GridTabularList n e
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Index Index
#currentColumn Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Index Index
-> Optic An_Iso NoIx Index Index Int Int
-> Optic
     A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a s. Coercible s a => Iso' s a
coercedTo @Int Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Int Int
-> (Int -> Int) -> GridTabularList n e -> GridTabularList n e
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Seq ColWidth -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (GridTabularList n e
gl GridTabularList n e
-> Optic' A_Lens NoIx (GridTabularList n e) (Seq ColWidth)
-> Seq ColWidth
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (GridTabularList n e) (Seq ColWidth)
#widths) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | Move to the given column index
gridMoveTo
  :: Index
  -> GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveTo :: forall n e. Index -> GridTabularList n e -> GridTabularList n e
gridMoveTo (Ix Int
n) GridTabularList n e
gl = if Maybe Int -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GridTabularList n e
gl GridTabularList n e
-> Optic' A_Lens NoIx (GridTabularList n e) (Maybe Int)
-> Maybe Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (GridTabularList n e)
  (GridTabularList n e)
  (GenericList n Seq e)
  (GenericList n Seq e)
#list Optic
  A_Lens
  NoIx
  (GridTabularList n e)
  (GridTabularList n e)
  (GenericList n Seq e)
  (GenericList n Seq e)
-> Optic
     A_Lens
     NoIx
     (GenericList n Seq e)
     (GenericList n Seq e)
     (Maybe Int)
     (Maybe Int)
-> Optic' A_Lens NoIx (GridTabularList n e) (Maybe Int)
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
% Optic
  A_Lens
  NoIx
  (GenericList n Seq e)
  (GenericList n Seq e)
  (Maybe Int)
  (Maybe Int)
#listSelected
  then GridTabularList n e
gl
  else GridTabularList n e
gl GridTabularList n e
-> (GridTabularList n e -> GridTabularList n e)
-> GridTabularList n e
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Index Index
#currentColumn Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Index Index
-> Optic An_Iso NoIx Index Index Int Int
-> Optic
     A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a s. Coercible s a => Iso' s a
coercedTo @Int Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Int Int
-> Int -> GridTabularList n e -> GridTabularList n e
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Seq ColWidth -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (GridTabularList n e
gl GridTabularList n e
-> Optic' A_Lens NoIx (GridTabularList n e) (Seq ColWidth)
-> Seq ColWidth
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (GridTabularList n e) (Seq ColWidth)
#widths) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
n)

-- | Move to the first column.
gridMoveToBeginning
  :: GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveToBeginning :: forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToBeginning GridTabularList n e
gl = if Maybe Int -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GridTabularList n e
gl GridTabularList n e
-> Optic' A_Lens NoIx (GridTabularList n e) (Maybe Int)
-> Maybe Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (GridTabularList n e)
  (GridTabularList n e)
  (GenericList n Seq e)
  (GenericList n Seq e)
#list Optic
  A_Lens
  NoIx
  (GridTabularList n e)
  (GridTabularList n e)
  (GenericList n Seq e)
  (GenericList n Seq e)
-> Optic
     A_Lens
     NoIx
     (GenericList n Seq e)
     (GenericList n Seq e)
     (Maybe Int)
     (Maybe Int)
-> Optic' A_Lens NoIx (GridTabularList n e) (Maybe Int)
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
% Optic
  A_Lens
  NoIx
  (GenericList n Seq e)
  (GenericList n Seq e)
  (Maybe Int)
  (Maybe Int)
#listSelected
  then GridTabularList n e
gl
  else GridTabularList n e
gl GridTabularList n e
-> (GridTabularList n e -> GridTabularList n e)
-> GridTabularList n e
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Index Index
#currentColumn Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Index Index
-> Optic An_Iso NoIx Index Index Int Int
-> Optic
     A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a s. Coercible s a => Iso' s a
coercedTo @Int Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Int Int
-> Int -> GridTabularList n e -> GridTabularList n e
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int
0

-- | Move to the last column.
gridMoveToEnd
  :: GridTabularList n e -- ^ The list
  -> GridTabularList n e
gridMoveToEnd :: forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToEnd GridTabularList n e
gl = if Maybe Int -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GridTabularList n e
gl GridTabularList n e
-> Optic' A_Lens NoIx (GridTabularList n e) (Maybe Int)
-> Maybe Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (GridTabularList n e)
  (GridTabularList n e)
  (GenericList n Seq e)
  (GenericList n Seq e)
#list Optic
  A_Lens
  NoIx
  (GridTabularList n e)
  (GridTabularList n e)
  (GenericList n Seq e)
  (GenericList n Seq e)
-> Optic
     A_Lens
     NoIx
     (GenericList n Seq e)
     (GenericList n Seq e)
     (Maybe Int)
     (Maybe Int)
-> Optic' A_Lens NoIx (GridTabularList n e) (Maybe Int)
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
% Optic
  A_Lens
  NoIx
  (GenericList n Seq e)
  (GenericList n Seq e)
  (Maybe Int)
  (Maybe Int)
#listSelected
  then GridTabularList n e
gl
  else GridTabularList n e
gl GridTabularList n e
-> (GridTabularList n e -> GridTabularList n e)
-> GridTabularList n e
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Index Index
#currentColumn Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Index Index
-> Optic An_Iso NoIx Index Index Int Int
-> Optic
     A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall a s. Coercible s a => Iso' s a
coercedTo @Int Optic
  A_Lens NoIx (GridTabularList n e) (GridTabularList n e) Int Int
-> Int -> GridTabularList n e -> GridTabularList n e
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Seq ColWidth -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (GridTabularList n e
gl GridTabularList n e
-> Optic' A_Lens NoIx (GridTabularList n e) (Seq ColWidth)
-> Seq ColWidth
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (GridTabularList n e) (Seq ColWidth)
#widths) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | 'GridRenderers' are needed because if row header renderer doesn't exist, width calculation is affected.
gridMovePage :: Ord n
  => GridRenderers n e
  -> (VisibleGridColumns -> EventM n (GridTabularList n e) ())
  -> EventM n (GridTabularList n e) ()
gridMovePage :: forall n e.
Ord n =>
GridRenderers n e
-> (VisibleGridColumns -> EventM n (GridTabularList n e) ())
-> EventM n (GridTabularList n e) ()
gridMovePage GridRenderers n e
r VisibleGridColumns -> EventM n (GridTabularList n e) ()
f = do
  GridTabularList n e
l <- EventM n (GridTabularList n e) (GridTabularList n e)
forall s (m :: * -> *). MonadState s m => m s
get
  let l' :: GenericList n Seq e
l' = GridTabularList n e
l GridTabularList n e
-> Optic' A_Lens NoIx (GridTabularList n e) (GenericList n Seq e)
-> GenericList n Seq e
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (GridTabularList n e) (GenericList n Seq e)
#list
  Bool
-> EventM n (GridTabularList n e) ()
-> EventM n (GridTabularList n e) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Int -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GenericList n Seq e
l' GenericList n Seq e
-> Getting (Maybe Int) (GenericList n Seq e) (Maybe Int)
-> Maybe Int
forall {s} {a}. s -> Getting a s a -> a
^^. Getting (Maybe Int) (GenericList n Seq e) (Maybe Int)
forall n (t :: * -> *) e (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int))
-> GenericList n t e -> f (GenericList n t e)
L.listSelectedL) (EventM n (GridTabularList n e) ()
 -> EventM n (GridTabularList n e) ())
-> EventM n (GridTabularList n e) ()
-> EventM n (GridTabularList n e) ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe Viewport
v <- n -> EventM n (GridTabularList n e) (Maybe Viewport)
forall n s. Ord n => n -> EventM n s (Maybe Viewport)
lookupViewport (n -> EventM n (GridTabularList n e) (Maybe Viewport))
-> n -> EventM n (GridTabularList n e) (Maybe Viewport)
forall a b. (a -> b) -> a -> b
$ GenericList n Seq e
l' GenericList n Seq e -> Getting n (GenericList n Seq e) n -> n
forall {s} {a}. s -> Getting a s a -> a
^^. Getting n (GenericList n Seq e) n
forall n1 (t :: * -> *) e n2 (f :: * -> *).
Functor f =>
(n1 -> f n2) -> GenericList n1 t e -> f (GenericList n2 t e)
L.listNameL
    case Maybe Viewport
v of
      Maybe Viewport
Nothing -> () -> EventM n (GridTabularList n e) ()
forall a. a -> EventM n (GridTabularList n e) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just Viewport
vp -> let
        (Int
aW, Int
aH) = Viewport
vp Viewport -> Optic' A_Lens NoIx Viewport (Int, Int) -> (Int, Int)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Viewport (Int, Int)
#_vpSize
        RowHdrW Int
rhw = case GridRenderers n e
r GridRenderers n e
-> Optic' A_Lens NoIx (GridRenderers n e) (Maybe (RowHdr n e))
-> Maybe (RowHdr n e)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (GridRenderers n e) (Maybe (RowHdr n e))
#rowHdr of
          Maybe (RowHdr n e)
Nothing -> Int -> RowHdrWidth
RowHdrW Int
0
          Just (RowHdr {AvailWidth -> [r] -> RowHdrWidth
$sel:width:RowHdr :: ()
width :: AvailWidth -> [r] -> RowHdrWidth
width, e -> Index -> r
$sel:toRH:RowHdr :: ()
toRH :: e -> Index -> r
toRH}) -> AvailWidth -> [r] -> RowHdrWidth
width (Int -> AvailWidth
AvlW Int
aW) ([r] -> RowHdrWidth) -> [r] -> RowHdrWidth
forall a b. (a -> b) -> a -> b
$ ([e] -> [Index] -> [r]) -> ([e], [Index]) -> [r]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((e -> Index -> r) -> [e] -> [Index] -> [r]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith e -> Index -> r
toRH) (([e], [Index]) -> [r]) -> ([e], [Index]) -> [r]
forall a b. (a -> b) -> a -> b
$ GenericList n Seq e -> AvailHeight -> ([e], [Index])
forall n e. GenericList n Seq e -> AvailHeight -> ([e], [Index])
visibleRowIdx GenericList n Seq e
l' (Int -> AvailHeight
AvlH Int
aH)
        in VisibleGridColumns -> EventM n (GridTabularList n e) ()
f (VisibleGridColumns -> EventM n (GridTabularList n e) ())
-> VisibleGridColumns -> EventM n (GridTabularList n e) ()
forall a b. (a -> b) -> a -> b
$ GridTabularList n e -> AvailWidth -> VisibleGridColumns
forall n e. GridTabularList n e -> AvailWidth -> VisibleGridColumns
visibleGridColumns GridTabularList n e
l (AvailWidth -> VisibleGridColumns)
-> AvailWidth -> VisibleGridColumns
forall a b. (a -> b) -> a -> b
$ Int -> AvailWidth
AvlW (Int -> AvailWidth) -> Int -> AvailWidth
forall a b. (a -> b) -> a -> b
$ Int
aW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rhw

-- | Move to the previous page of columns.
--
-- 'GridRenderers' are needed because if row header doesn't exist, width calculation is affected.
gridMovePageUp :: Ord n
  => GridRenderers n e -- ^ Renderers
  -> EventM n (GridTabularList n e) ()
gridMovePageUp :: forall n e.
Ord n =>
GridRenderers n e -> EventM n (GridTabularList n e) ()
gridMovePageUp GridRenderers n e
r = GridRenderers n e
-> (VisibleGridColumns -> EventM n (GridTabularList n e) ())
-> EventM n (GridTabularList n e) ()
forall n e.
Ord n =>
GridRenderers n e
-> (VisibleGridColumns -> EventM n (GridTabularList n e) ())
-> EventM n (GridTabularList n e) ()
gridMovePage GridRenderers n e
r ((VisibleGridColumns -> EventM n (GridTabularList n e) ())
 -> EventM n (GridTabularList n e) ())
-> (VisibleGridColumns -> EventM n (GridTabularList n e) ())
-> EventM n (GridTabularList n e) ()
forall a b. (a -> b) -> a -> b
$ \case
  VisibleGridColumns
NoColumn -> () -> EventM n (GridTabularList n e) ()
forall a. a -> EventM n (GridTabularList n e) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  VisibleGridColumns
CurrentColumn -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n e -> GridTabularList n e
forall n e. GridTabularList n e -> GridTabularList n e
gridMoveLeft
  AnchoredLeft Index
_ -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n e -> GridTabularList n e
forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToBeginning
  MiddleColumns {Index
$sel:left:NoColumn :: VisibleGridColumns -> Index
left :: Index
left} -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GridTabularList n e -> GridTabularList n e)
 -> EventM n (GridTabularList n e) ())
-> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall a b. (a -> b) -> a -> b
$ Index -> GridTabularList n e -> GridTabularList n e
forall n e. Index -> GridTabularList n e -> GridTabularList n e
gridMoveTo Index
left
  AnchoredRight {Index
$sel:left:NoColumn :: VisibleGridColumns -> Index
left :: Index
left} -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GridTabularList n e -> GridTabularList n e)
 -> EventM n (GridTabularList n e) ())
-> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall a b. (a -> b) -> a -> b
$ Index -> GridTabularList n e -> GridTabularList n e
forall n e. Index -> GridTabularList n e -> GridTabularList n e
gridMoveTo Index
left

-- | Move to the next page of columns.
--
-- 'GridRenderers' are needed because if row header doesn't exist, width calculation is affected.
gridMovePageDown :: Ord n
  => GridRenderers n e -- ^ Renderers
  -> EventM n (GridTabularList n e) ()
gridMovePageDown :: forall n e.
Ord n =>
GridRenderers n e -> EventM n (GridTabularList n e) ()
gridMovePageDown GridRenderers n e
r = GridRenderers n e
-> (VisibleGridColumns -> EventM n (GridTabularList n e) ())
-> EventM n (GridTabularList n e) ()
forall n e.
Ord n =>
GridRenderers n e
-> (VisibleGridColumns -> EventM n (GridTabularList n e) ())
-> EventM n (GridTabularList n e) ()
gridMovePage GridRenderers n e
r ((VisibleGridColumns -> EventM n (GridTabularList n e) ())
 -> EventM n (GridTabularList n e) ())
-> (VisibleGridColumns -> EventM n (GridTabularList n e) ())
-> EventM n (GridTabularList n e) ()
forall a b. (a -> b) -> a -> b
$ \case
  VisibleGridColumns
NoColumn -> () -> EventM n (GridTabularList n e) ()
forall a. a -> EventM n (GridTabularList n e) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  VisibleGridColumns
CurrentColumn -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n e -> GridTabularList n e
forall n e. GridTabularList n e -> GridTabularList n e
gridMoveRight
  AnchoredLeft {Index
$sel:right:NoColumn :: VisibleGridColumns -> Index
right :: Index
right} -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GridTabularList n e -> GridTabularList n e)
 -> EventM n (GridTabularList n e) ())
-> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall a b. (a -> b) -> a -> b
$ Index -> GridTabularList n e -> GridTabularList n e
forall n e. Index -> GridTabularList n e -> GridTabularList n e
gridMoveTo Index
right
  MiddleColumns {Index
$sel:right:NoColumn :: VisibleGridColumns -> Index
right :: Index
right} -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((GridTabularList n e -> GridTabularList n e)
 -> EventM n (GridTabularList n e) ())
-> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall a b. (a -> b) -> a -> b
$ Index -> GridTabularList n e -> GridTabularList n e
forall n e. Index -> GridTabularList n e -> GridTabularList n e
gridMoveTo Index
right
  AnchoredRight {} -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n e -> GridTabularList n e
forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToEnd

-- | Handle events for grid tabular list with navigation keys.
--
-- It adds the following keyboard shortcuts to 'L.handleListEvent'.
--
-- * Move to the left by one column (Left arrow key)
-- * Move to the right by one column (Right arrow key)
-- * Go to the first column (Ctrl+Home)
-- * Go to the last column (Ctrl+End)
-- * Move to the previous page of columns (Ctrl+PageUp)
-- * Move to the next page of columns (Ctrl+PageDown)
--
-- 'GridRenderers' are needed because if row header doesn't exist, width calculation is affected.
handleGridListEvent :: Ord n
  => GridRenderers n e -- ^ Renderers
  -> Event -> EventM n (GridTabularList n e) ()
handleGridListEvent :: forall n e.
Ord n =>
GridRenderers n e -> Event -> EventM n (GridTabularList n e) ()
handleGridListEvent GridRenderers n e
r Event
e = case Event
e of
  EvKey Key
KLeft [] -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n e -> GridTabularList n e
forall n e. GridTabularList n e -> GridTabularList n e
gridMoveLeft
  EvKey Key
KRight [] -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n e -> GridTabularList n e
forall n e. GridTabularList n e -> GridTabularList n e
gridMoveRight
  EvKey Key
KHome [Modifier
MCtrl] -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n e -> GridTabularList n e
forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToBeginning
  EvKey Key
KEnd [Modifier
MCtrl] -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n e -> GridTabularList n e
forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToEnd
  EvKey Key
KPageUp [Modifier
MCtrl] -> GridRenderers n e -> EventM n (GridTabularList n e) ()
forall n e.
Ord n =>
GridRenderers n e -> EventM n (GridTabularList n e) ()
gridMovePageUp GridRenderers n e
r
  EvKey Key
KPageDown [Modifier
MCtrl] -> GridRenderers n e -> EventM n (GridTabularList n e) ()
forall n e.
Ord n =>
GridRenderers n e -> EventM n (GridTabularList n e) ()
gridMovePageDown GridRenderers n e
r
  Event
_ -> LensLike'
  (Zoomed (EventM n (GenericList n Seq e)) ())
  (GridTabularList n e)
  (GenericList n Seq e)
-> EventM n (GenericList n Seq e) ()
-> EventM n (GridTabularList n e) ()
forall c.
LensLike'
  (Zoomed (EventM n (GenericList n Seq e)) c)
  (GridTabularList n e)
  (GenericList n Seq e)
-> EventM n (GenericList n Seq e) c
-> EventM n (GridTabularList n e) c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Focusing (StateT (EventState n) IO) ())
  (GridTabularList n e)
  (GenericList n Seq e)
LensLike'
  (Zoomed (EventM n (GenericList n Seq e)) ())
  (GridTabularList n e)
  (GenericList n Seq e)
#list (Event -> EventM n (GenericList n Seq e) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
L.handleListEvent Event
e)

-- | Handle events for grid tabular list with vim keys.
--
-- It adds the following keyboard shortcuts to 'L.handleListEventVi'.
--
-- * Move to the left by one column (h)
-- * Move to the right by one column (l)
-- * Go to the first column (H)
-- * Go to the last column (L)
-- * Move to the previous page of columns (Alt+h)
-- * Move to the next page of columns (Alt+l)
--
-- 'GridRenderers' are needed because if row header doesn't exist, width calculation is affected.
handleGridListEventVi :: Ord n
  => GridRenderers n e -- ^ Renderers
  -> Event -> EventM n (GridTabularList n e) ()
handleGridListEventVi :: forall n e.
Ord n =>
GridRenderers n e -> Event -> EventM n (GridTabularList n e) ()
handleGridListEventVi GridRenderers n e
r Event
e = case Event
e of
  EvKey (KChar Char
'h') [] -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n e -> GridTabularList n e
forall n e. GridTabularList n e -> GridTabularList n e
gridMoveLeft
  EvKey (KChar Char
'l') [] -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n e -> GridTabularList n e
forall n e. GridTabularList n e -> GridTabularList n e
gridMoveRight
  EvKey (KChar Char
'H') [] -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n e -> GridTabularList n e
forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToBeginning
  EvKey (KChar Char
'L') [] -> (GridTabularList n e -> GridTabularList n e)
-> EventM n (GridTabularList n e) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify GridTabularList n e -> GridTabularList n e
forall n e. GridTabularList n e -> GridTabularList n e
gridMoveToEnd
  EvKey (KChar Char
'h') [Modifier
MMeta] -> GridRenderers n e -> EventM n (GridTabularList n e) ()
forall n e.
Ord n =>
GridRenderers n e -> EventM n (GridTabularList n e) ()
gridMovePageUp GridRenderers n e
r
  EvKey (KChar Char
'l') [Modifier
MMeta] -> GridRenderers n e -> EventM n (GridTabularList n e) ()
forall n e.
Ord n =>
GridRenderers n e -> EventM n (GridTabularList n e) ()
gridMovePageDown GridRenderers n e
r
  EvKey (KChar Char
'h') [Modifier
MAlt] -> GridRenderers n e -> EventM n (GridTabularList n e) ()
forall n e.
Ord n =>
GridRenderers n e -> EventM n (GridTabularList n e) ()
gridMovePageUp GridRenderers n e
r
  EvKey (KChar Char
'l') [Modifier
MAlt] -> GridRenderers n e -> EventM n (GridTabularList n e) ()
forall n e.
Ord n =>
GridRenderers n e -> EventM n (GridTabularList n e) ()
gridMovePageDown GridRenderers n e
r
  Event
_ -> LensLike'
  (Zoomed (EventM n (GenericList n Seq e)) ())
  (GridTabularList n e)
  (GenericList n Seq e)
-> EventM n (GenericList n Seq e) ()
-> EventM n (GridTabularList n e) ()
forall c.
LensLike'
  (Zoomed (EventM n (GenericList n Seq e)) c)
  (GridTabularList n e)
  (GenericList n Seq e)
-> EventM n (GenericList n Seq e) c
-> EventM n (GridTabularList n e) c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Focusing (StateT (EventState n) IO) ())
  (GridTabularList n e)
  (GenericList n Seq e)
LensLike'
  (Zoomed (EventM n (GenericList n Seq e)) ())
  (GridTabularList n e)
  (GenericList n Seq e)
#list ((Event -> EventM n (GenericList n Seq e) ())
-> Event -> EventM n (GenericList n Seq e) ()
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 e) ()
forall a. a -> EventM n (GenericList n Seq e) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Event
e)