module Brick.Widgets.TabularList.Internal.Common (
  visibleRows
, visibleRowHdrs
, visibleRowsAndRowHdrs
) where

import Brick.Widgets.TabularList.Types
-- base
import Data.Maybe (fromMaybe, catMaybes)
import Data.Foldable (toList)
-- Third party libraries
import Lens.Micro
import Data.Sequence (Seq)
-- Brick
import Brick.Widgets.List

type Start = Int
type AvailHeight = Int
visibleRowsWithStart :: GenericList n Seq row -> AvailHeight -> ([row], Start)
visibleRowsWithStart :: forall n row.
GenericList n Seq row -> AvailHeight -> ([row], AvailHeight)
visibleRowsWithStart GenericList n Seq row
l AvailHeight
aH = let
  idx :: AvailHeight
idx = AvailHeight -> Maybe AvailHeight -> AvailHeight
forall a. a -> Maybe a -> a
fromMaybe AvailHeight
0 (GenericList n Seq row
lGenericList n Seq row
-> Getting
     (Maybe AvailHeight) (GenericList n Seq row) (Maybe AvailHeight)
-> Maybe AvailHeight
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe AvailHeight) (GenericList n Seq row) (Maybe AvailHeight)
forall n (t :: * -> *) e.
Lens' (GenericList n t e) (Maybe AvailHeight)
listSelectedL)
  numPerHeight :: AvailHeight
numPerHeight = case AvailHeight
aH AvailHeight -> AvailHeight -> (AvailHeight, AvailHeight)
forall a. Integral a => a -> a -> (a, a)
`divMod` (GenericList n Seq row
lGenericList n Seq row
-> Getting AvailHeight (GenericList n Seq row) AvailHeight
-> AvailHeight
forall s a. s -> Getting a s a -> a
^.Getting AvailHeight (GenericList n Seq row) AvailHeight
forall n (t :: * -> *) e. Lens' (GenericList n t e) AvailHeight
listItemHeightL) of
    (AvailHeight
nph, AvailHeight
0) -> AvailHeight
nph
    (AvailHeight
nph, AvailHeight
_) -> AvailHeight
nph AvailHeight -> AvailHeight -> AvailHeight
forall a. Num a => a -> a -> a
+ AvailHeight
1
  start :: AvailHeight
start = AvailHeight -> AvailHeight -> AvailHeight
forall a. Ord a => a -> a -> a
max AvailHeight
0 (AvailHeight -> AvailHeight) -> AvailHeight -> AvailHeight
forall a b. (a -> b) -> a -> b
$ AvailHeight
idx AvailHeight -> AvailHeight -> AvailHeight
forall a. Num a => a -> a -> a
- AvailHeight
numPerHeight AvailHeight -> AvailHeight -> AvailHeight
forall a. Num a => a -> a -> a
+ AvailHeight
1
  length :: AvailHeight
length = AvailHeight
numPerHeight AvailHeight -> AvailHeight -> AvailHeight
forall a. Num a => a -> a -> a
* AvailHeight
2
  rows :: [row]
rows = Seq row -> [row]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq row -> [row]) -> Seq row -> [row]
forall a b. (a -> b) -> a -> b
$ AvailHeight -> AvailHeight -> Seq row -> Seq row
forall (t :: * -> *) a.
Splittable t =>
AvailHeight -> AvailHeight -> t a -> t a
slice AvailHeight
start AvailHeight
length (Seq row -> Seq row) -> Seq row -> Seq row
forall a b. (a -> b) -> a -> b
$ GenericList n Seq row
lGenericList n Seq row
-> Getting (Seq row) (GenericList n Seq row) (Seq row) -> Seq row
forall s a. s -> Getting a s a -> a
^.Getting (Seq row) (GenericList n Seq row) (Seq row)
forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
listElementsL
  in ([row]
rows, AvailHeight
start)

-- | Return visible rows, given 'GenericList' and height available for list elements
visibleRows :: GenericList n Seq row -> AvailHeight -> [row]
visibleRows :: forall n row. GenericList n Seq row -> AvailHeight -> [row]
visibleRows GenericList n Seq row
l AvailHeight
aH = GenericList n Seq row -> AvailHeight -> ([row], AvailHeight)
forall n row.
GenericList n Seq row -> AvailHeight -> ([row], AvailHeight)
visibleRowsWithStart GenericList n Seq row
l AvailHeight
aH ([row], AvailHeight)
-> Getting [row] ([row], AvailHeight) [row] -> [row]
forall s a. s -> Getting a s a -> a
^. Getting [row] ([row], AvailHeight) [row]
forall s t a b. Field1 s t a b => Lens s t a b
_1

-- | Return visible row headers, given 'GenericList' and height available for list elements
visibleRowHdrs :: GenericList n Seq row -> AvailHeight -> (row -> RowIndex -> Maybe rowH) -> [rowH]
visibleRowHdrs :: forall n row rowH.
GenericList n Seq row
-> AvailHeight -> (row -> AvailHeight -> Maybe rowH) -> [rowH]
visibleRowHdrs GenericList n Seq row
l AvailHeight
aH row -> AvailHeight -> Maybe rowH
rowH = GenericList n Seq row
-> AvailHeight
-> (row -> AvailHeight -> Maybe rowH)
-> ([row], [rowH])
forall n row rowH.
GenericList n Seq row
-> AvailHeight
-> (row -> AvailHeight -> Maybe rowH)
-> ([row], [rowH])
visibleRowsAndRowHdrs GenericList n Seq row
l AvailHeight
aH row -> AvailHeight -> Maybe rowH
rowH ([row], [rowH]) -> Getting [rowH] ([row], [rowH]) [rowH] -> [rowH]
forall s a. s -> Getting a s a -> a
^. Getting [rowH] ([row], [rowH]) [rowH]
forall s t a b. Field2 s t a b => Lens s t a b
_2

-- | Return visible rows and visible row headers, given 'GenericList', available height, and row header function.
visibleRowsAndRowHdrs :: GenericList n Seq row -> AvailHeight -> (row -> RowIndex -> Maybe rowH) -> ([row], [rowH])
visibleRowsAndRowHdrs :: forall n row rowH.
GenericList n Seq row
-> AvailHeight
-> (row -> AvailHeight -> Maybe rowH)
-> ([row], [rowH])
visibleRowsAndRowHdrs GenericList n Seq row
l AvailHeight
aH row -> AvailHeight -> Maybe rowH
rowH = let
  ([row]
rows, AvailHeight
start) = GenericList n Seq row -> AvailHeight -> ([row], AvailHeight)
forall n row.
GenericList n Seq row -> AvailHeight -> ([row], AvailHeight)
visibleRowsWithStart GenericList n Seq row
l AvailHeight
aH
  in ([row]
rows, [Maybe rowH] -> [rowH]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe rowH] -> [rowH]) -> [Maybe rowH] -> [rowH]
forall a b. (a -> b) -> a -> b
$ (row -> AvailHeight -> Maybe rowH)
-> [row] -> [AvailHeight] -> [Maybe rowH]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith row -> AvailHeight -> Maybe rowH
rowH [row]
rows [AvailHeight
start..])