module Brick.Widgets.TabularList.Internal.Common (
  AvailHeight
, visibleRowsWithStart
, visibleRows
, zipWithVisibleRowsAndIndexes
) 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

-- | Height available for 'GenericList'
type AvailHeight = Int

-- | Return visible rows and the index of the first visible row, given 'GenericList' and height available for list.
visibleRowsWithStart :: GenericList n Seq row -> AvailHeight -> ([row], Index)
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.
visibleRows :: GenericList n Seq e -> AvailHeight -> [e]
visibleRows :: forall n e. GenericList n Seq e -> AvailHeight -> [e]
visibleRows GenericList n Seq e
l AvailHeight
aH = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall n row.
GenericList n Seq row -> AvailHeight -> ([row], AvailHeight)
visibleRowsWithStart GenericList n Seq e
l AvailHeight
aH

-- | Zip visible rows and their row indexes with a function.
zipWithVisibleRowsAndIndexes :: GenericList n Seq e -> AvailHeight -> (e -> Index -> c) -> [c]
zipWithVisibleRowsAndIndexes :: forall n e c.
GenericList n Seq e
-> AvailHeight -> (e -> AvailHeight -> c) -> [c]
zipWithVisibleRowsAndIndexes GenericList n Seq e
l AvailHeight
aH e -> AvailHeight -> c
f = let ([e]
es, AvailHeight
s) = forall n row.
GenericList n Seq row -> AvailHeight -> ([row], AvailHeight)
visibleRowsWithStart GenericList n Seq e
l AvailHeight
aH
  in forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith e -> AvailHeight -> c
f [e]
es [AvailHeight
s..]