{-# LANGUAGE DeriveGeneric #-}
-- | 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 (
  ColumnIndex
, RowIndex
, Index
, Width
, Height
, AvailWidth
, ListItemHeight
, Position(..)
, WidthDeficit
, ListFocused
, RowHeaderWidth(..)
) where

-- base
import GHC.Generics (Generic)

-- Types used by tabular list widgets

-- | Index of column among columns
type ColumnIndex = Int
-- | Index of row among rows
type RowIndex = Int
-- | Index of element among elements
type Index = Int
-- | Width of a list element
type Width = Int
-- | Height of a list element
type Height = Int
-- | Available width
type AvailWidth = Int
-- | The fixed height for row headers and cells.
--
-- If the height of row headers or cells is not this height, then the list will look broken.
type ListItemHeight = Int
-- | Linear position for tabular list elements.
data Position = Position {
  Position -> Index
index :: Index -- ^ Index of item
, Position -> Bool
selected :: Bool -- ^ Whether or not the item is selected
} deriving (Index -> Position -> ShowS
[Position] -> ShowS
Position -> String
forall a.
(Index -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Index -> Position -> ShowS
$cshowsPrec :: Index -> Position -> ShowS
Show, forall x. Rep Position x -> Position
forall x. Position -> Rep Position x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Position x -> Position
$cfrom :: forall x. Position -> Rep Position x
Generic)
-- | > widthDeficit = max 0 $ desiredWidth - availableWidth
--
-- It is positive when an element 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

-- | Row header width information
data RowHeaderWidth rowH =
  -- | A fixed width for row header.
  FixedRowHeader Width
  -- | Calculate row header width with the width available for each row of a list
  | AvailRowHeader (AvailWidth -> Width)
  -- | Calculate row header width with visible row headers and the width available for each row of a list.
  | VisibleRowHeaders (AvailWidth -> [rowH] -> Width) 
  deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall rowH x. Rep (RowHeaderWidth rowH) x -> RowHeaderWidth rowH
forall rowH x. RowHeaderWidth rowH -> Rep (RowHeaderWidth rowH) x
$cto :: forall rowH x. Rep (RowHeaderWidth rowH) x -> RowHeaderWidth rowH
$cfrom :: forall rowH x. RowHeaderWidth rowH -> Rep (RowHeaderWidth rowH) x
Generic