{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-- | Types shared by tabular list widgets.
--
-- You don't have to import this module because modules for tabular list widgets re-export this module.
module Brick.Widgets.TabularList.Types (
  Index
, Width
, Height
, AvailWidth
, ListItemHeight
, FlatContext(..)
, WidthDeficit
, ListFocused
, Selected
, RowHdr(..)
, DrawColHdrRowHdr
) where

-- base
import GHC.Generics (Generic)
-- brick
import Brick.Types

-- | Index of a tabular list component among the same kind of components
type Index = Int

-- | Width of a tabular list component
type Width = Int

-- | Height of a tabular list component
type Height = Int

-- | Available width
type AvailWidth = Int

-- | The fixed height for row headers and row columns.
--
-- If the height of row headers or row columns is not this height, then the list will look broken.
type ListItemHeight = Int

-- | Context for one dimensional tabular list components
data FlatContext = FlatContext {
  FlatContext -> Index
index :: Index -- ^ Index of a component
, FlatContext -> Bool
selected :: Bool -- ^ Whether a component is selected
} deriving (Index -> FlatContext -> ShowS
[FlatContext] -> ShowS
FlatContext -> String
forall a.
(Index -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlatContext] -> ShowS
$cshowList :: [FlatContext] -> ShowS
show :: FlatContext -> String
$cshow :: FlatContext -> String
showsPrec :: Index -> FlatContext -> ShowS
$cshowsPrec :: Index -> FlatContext -> ShowS
Show, forall x. Rep FlatContext x -> FlatContext
forall x. FlatContext -> Rep FlatContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlatContext x -> FlatContext
$cfrom :: forall x. FlatContext -> Rep FlatContext x
Generic)

-- | > widthDeficit = max 0 $ desiredWidth - availableWidth
--
-- It is positive when a column is shrunk to the available width.
--
-- If it is positive, you may want to remove paddings in your content because it is not followed or preceded by
-- other columns.
type WidthDeficit = Int

-- | Whether the list is focused in an application
type ListFocused = Bool

-- | Whether a tabular list component is selected
type Selected = Bool

-- | Row header
--
-- * [Type Variables]("Brick.Widgets.TabularList#g:TypeVariables")
-- * [Rendering]("Brick.Widgets.TabularList#g:Rendering")
data RowHdr n e r = RowHdr {
  forall n e r.
RowHdr n e r -> Bool -> Index -> Bool -> r -> Widget n
draw :: ListFocused -> WidthDeficit -> Selected -> r -> Widget n
  -- | Calculate row header width from visible row headers and the width available for a list row.
, forall n e r. RowHdr n e r -> Index -> [r] -> Index
width :: AvailWidth -> [r] -> Width
  -- | Get a row header from a list row and row index.
, forall n e r. RowHdr n e r -> e -> Index -> r
toRowHdr :: e -> Index -> r
} deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n e r x. Rep (RowHdr n e r) x -> RowHdr n e r
forall n e r x. RowHdr n e r -> Rep (RowHdr n e r) x
$cto :: forall n e r x. Rep (RowHdr n e r) x -> RowHdr n e r
$cfrom :: forall n e r x. RowHdr n e r -> Rep (RowHdr n e r) x
Generic

-- | The renderer for column header row header.
--
-- If row headers and column headers exist and 'DrawColHdrRowHdr' is 'Nothing', then column header row header is
-- filled with empty space. 'DrawColHdrRowHdr' merely allows you to customize column header row header.
type DrawColHdrRowHdr n = Maybe (ListFocused -> WidthDeficit -> Widget n)