module Brick.Widgets.TabularList.Internal.Common (
  AvailHeight(..)
, visibleRowIdx
, sz
) 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
import Brick.Types
import Brick.Widgets.Core

-- | Height available for 'GenericList'
newtype AvailHeight = AvlH Int deriving (Int -> AvailHeight -> ShowS
[AvailHeight] -> ShowS
AvailHeight -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AvailHeight] -> ShowS
$cshowList :: [AvailHeight] -> ShowS
show :: AvailHeight -> String
$cshow :: AvailHeight -> String
showsPrec :: Int -> AvailHeight -> ShowS
$cshowsPrec :: Int -> AvailHeight -> ShowS
Show, AvailHeight -> AvailHeight -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AvailHeight -> AvailHeight -> Bool
$c/= :: AvailHeight -> AvailHeight -> Bool
== :: AvailHeight -> AvailHeight -> Bool
$c== :: AvailHeight -> AvailHeight -> Bool
Eq)

-- | Return visible rows and their row indexes.
--
-- The visible rows are rows that are visible when the current row is either at the top or the bottom.
visibleRowIdx :: GenericList n Seq e -> AvailHeight -> ([e], [Index])
visibleRowIdx :: forall n e. GenericList n Seq e -> AvailHeight -> ([e], [Index])
visibleRowIdx GenericList n Seq e
l (AvlH Int
h) = let
  idx :: Int
idx = forall a. a -> Maybe a -> a
fromMaybe Int
0 (GenericList n Seq e
lforall s a. s -> Getting a s a -> a
^.forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL)
  numPerHeight :: Int
numPerHeight = case Int
h forall a. Integral a => a -> a -> (a, a)
`divMod` (GenericList n Seq e
lforall s a. s -> Getting a s a -> a
^.forall n (t :: * -> *) e. Lens' (GenericList n t e) Int
listItemHeightL) of
    (Int
nph, Int
0) -> Int
nph
    (Int
nph, Int
_) -> Int
nph forall a. Num a => a -> a -> a
+ Int
1
  -- If the current row is at the bottom, the start should be visible.
  start :: Int
start = forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Int
idx forall a. Num a => a -> a -> a
- Int
numPerHeight forall a. Num a => a -> a -> a
+ Int
1
  -- If the current row is at the top, the row at start + length - 1 should be visible.
  length :: Int
length = Int
numPerHeight forall a. Num a => a -> a -> a
* Int
2
  rows :: [e]
rows = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Splittable t => Int -> Int -> t a -> t a
slice Int
start Int
length forall a b. (a -> b) -> a -> b
$ GenericList n Seq e
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 ([e]
rows, [Int -> Index
Ix Int
start..])

-- | It is a shortened version of 'setAvailableSize'.
sz :: (Int, Int) -> Widget n -> Widget n
sz :: forall n. (Int, Int) -> Widget n -> Widget n
sz (Int
w, Int
h) = if Int
w forall a. Ord a => a -> a -> Bool
<= Int
0 then forall a b. a -> b -> a
const forall n. Widget n
emptyWidget else forall n. (Int, Int) -> Widget n -> Widget n
setAvailableSize (Int
w, Int
h)