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 = forall a. a -> Maybe a -> a
fromMaybe AvailHeight
0 (GenericList n Seq row
lforall s a. s -> Getting a s a -> a
^.forall n (t :: * -> *) e.
Lens' (GenericList n t e) (Maybe AvailHeight)
listSelectedL)
  numPerHeight :: AvailHeight
numPerHeight = case AvailHeight
aH forall a. Integral a => a -> a -> (a, a)
`divMod` (GenericList n Seq row
lforall s a. s -> Getting a s a -> a
^.forall n (t :: * -> *) e. Lens' (GenericList n t e) AvailHeight
listItemHeightL) of
    (AvailHeight
nph, AvailHeight
0) -> AvailHeight
nph
    (AvailHeight
nph, AvailHeight
_) -> AvailHeight
nph forall a. Num a => a -> a -> a
+ AvailHeight
1
  start :: AvailHeight
start = forall a. Ord a => a -> a -> a
max AvailHeight
0 forall a b. (a -> b) -> a -> b
$ AvailHeight
idx forall a. Num a => a -> a -> a
- AvailHeight
numPerHeight forall a. Num a => a -> a -> a
+ AvailHeight
1
  length :: AvailHeight
length = AvailHeight
numPerHeight forall a. Num a => a -> a -> a
* AvailHeight
2
  rows :: [row]
rows = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a.
Splittable t =>
AvailHeight -> AvailHeight -> t a -> t a
slice AvailHeight
start AvailHeight
length forall a b. (a -> b) -> a -> b
$ GenericList n Seq row
lforall s a. s -> Getting a s a -> a
^.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 = forall n row.
GenericList n Seq row -> AvailHeight -> ([row], AvailHeight)
visibleRowsWithStart GenericList n Seq row
l AvailHeight
aH forall s a. s -> Getting a s a -> a
^. 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 = 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 forall s a. s -> Getting a s a -> a
^. 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) = forall n row.
GenericList n Seq row -> AvailHeight -> ([row], AvailHeight)
visibleRowsWithStart GenericList n Seq row
l AvailHeight
aH
  in ([row]
rows, forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith row -> AvailHeight -> Maybe rowH
rowH [row]
rows [AvailHeight
start..])