{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | 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 (
-- * Tabular dimensions
  RowHdrWidth(..)
, ColWidth(..)
, ColHdrHeight(..)
, ListItemHeight(..)
-- * Shared rendering context
, Index(..)
, AvailWidth(..)
, WidthDeficit(..)
, ListFocused(..)
, Selected(..)
-- * Row header
, RowHdrCtxt(..)
, RowHdr(..)
, ColHdrRowHdr(..)
) where

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

-- | Index of a tabular list component among the same kind of components
newtype Index = Ix Int deriving (Int -> Index
Index -> Int
Index -> [Index]
Index -> Index
Index -> Index -> [Index]
Index -> Index -> Index -> [Index]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Index -> Index -> Index -> [Index]
$cenumFromThenTo :: Index -> Index -> Index -> [Index]
enumFromTo :: Index -> Index -> [Index]
$cenumFromTo :: Index -> Index -> [Index]
enumFromThen :: Index -> Index -> [Index]
$cenumFromThen :: Index -> Index -> [Index]
enumFrom :: Index -> [Index]
$cenumFrom :: Index -> [Index]
fromEnum :: Index -> Int
$cfromEnum :: Index -> Int
toEnum :: Int -> Index
$ctoEnum :: Int -> Index
pred :: Index -> Index
$cpred :: Index -> Index
succ :: Index -> Index
$csucc :: Index -> Index
Enum, Index -> Index -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Index -> Index -> Bool
$c/= :: Index -> Index -> Bool
== :: Index -> Index -> Bool
$c== :: Index -> Index -> Bool
Eq, forall x. Rep Index x -> Index
forall x. Index -> Rep Index x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Index x -> Index
$cfrom :: forall x. Index -> Rep Index x
Generic, Int -> Index -> ShowS
[Index] -> ShowS
Index -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Index] -> ShowS
$cshowList :: [Index] -> ShowS
show :: Index -> String
$cshow :: Index -> String
showsPrec :: Int -> Index -> ShowS
$cshowsPrec :: Int -> Index -> ShowS
Show)

-- | Width for row header
newtype RowHdrWidth = RowHdrW Int deriving (RowHdrWidth -> RowHdrWidth -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RowHdrWidth -> RowHdrWidth -> Bool
$c/= :: RowHdrWidth -> RowHdrWidth -> Bool
== :: RowHdrWidth -> RowHdrWidth -> Bool
$c== :: RowHdrWidth -> RowHdrWidth -> Bool
Eq, forall x. Rep RowHdrWidth x -> RowHdrWidth
forall x. RowHdrWidth -> Rep RowHdrWidth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RowHdrWidth x -> RowHdrWidth
$cfrom :: forall x. RowHdrWidth -> Rep RowHdrWidth x
Generic, Int -> RowHdrWidth -> ShowS
[RowHdrWidth] -> ShowS
RowHdrWidth -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowHdrWidth] -> ShowS
$cshowList :: [RowHdrWidth] -> ShowS
show :: RowHdrWidth -> String
$cshow :: RowHdrWidth -> String
showsPrec :: Int -> RowHdrWidth -> ShowS
$cshowsPrec :: Int -> RowHdrWidth -> ShowS
Show)

-- | Width of a column header or a row column
newtype ColWidth = ColW Int deriving (ColWidth -> ColWidth -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColWidth -> ColWidth -> Bool
$c/= :: ColWidth -> ColWidth -> Bool
== :: ColWidth -> ColWidth -> Bool
$c== :: ColWidth -> ColWidth -> Bool
Eq, forall x. Rep ColWidth x -> ColWidth
forall x. ColWidth -> Rep ColWidth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColWidth x -> ColWidth
$cfrom :: forall x. ColWidth -> Rep ColWidth x
Generic, Int -> ColWidth -> ShowS
[ColWidth] -> ShowS
ColWidth -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColWidth] -> ShowS
$cshowList :: [ColWidth] -> ShowS
show :: ColWidth -> String
$cshow :: ColWidth -> String
showsPrec :: Int -> ColWidth -> ShowS
$cshowsPrec :: Int -> ColWidth -> ShowS
Show)

-- | Height for column headers and column header row header
newtype ColHdrHeight = ColHdrH Int deriving (ColHdrHeight -> ColHdrHeight -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColHdrHeight -> ColHdrHeight -> Bool
$c/= :: ColHdrHeight -> ColHdrHeight -> Bool
== :: ColHdrHeight -> ColHdrHeight -> Bool
$c== :: ColHdrHeight -> ColHdrHeight -> Bool
Eq, forall x. Rep ColHdrHeight x -> ColHdrHeight
forall x. ColHdrHeight -> Rep ColHdrHeight x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColHdrHeight x -> ColHdrHeight
$cfrom :: forall x. ColHdrHeight -> Rep ColHdrHeight x
Generic, Int -> ColHdrHeight -> ShowS
[ColHdrHeight] -> ShowS
ColHdrHeight -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColHdrHeight] -> ShowS
$cshowList :: [ColHdrHeight] -> ShowS
show :: ColHdrHeight -> String
$cshow :: ColHdrHeight -> String
showsPrec :: Int -> ColHdrHeight -> ShowS
$cshowsPrec :: Int -> ColHdrHeight -> ShowS
Show)

-- | 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.
newtype ListItemHeight = LstItmH Int deriving (ListItemHeight -> ListItemHeight -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListItemHeight -> ListItemHeight -> Bool
$c/= :: ListItemHeight -> ListItemHeight -> Bool
== :: ListItemHeight -> ListItemHeight -> Bool
$c== :: ListItemHeight -> ListItemHeight -> Bool
Eq, forall x. Rep ListItemHeight x -> ListItemHeight
forall x. ListItemHeight -> Rep ListItemHeight x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListItemHeight x -> ListItemHeight
$cfrom :: forall x. ListItemHeight -> Rep ListItemHeight x
Generic, Int -> ListItemHeight -> ShowS
[ListItemHeight] -> ShowS
ListItemHeight -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListItemHeight] -> ShowS
$cshowList :: [ListItemHeight] -> ShowS
show :: ListItemHeight -> String
$cshow :: ListItemHeight -> String
showsPrec :: Int -> ListItemHeight -> ShowS
$cshowsPrec :: Int -> ListItemHeight -> ShowS
Show)

-- | Available width
newtype AvailWidth = AvlW Int deriving (AvailWidth -> AvailWidth -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AvailWidth -> AvailWidth -> Bool
$c/= :: AvailWidth -> AvailWidth -> Bool
== :: AvailWidth -> AvailWidth -> Bool
$c== :: AvailWidth -> AvailWidth -> Bool
Eq, forall x. Rep AvailWidth x -> AvailWidth
forall x. AvailWidth -> Rep AvailWidth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AvailWidth x -> AvailWidth
$cfrom :: forall x. AvailWidth -> Rep AvailWidth x
Generic, Int -> AvailWidth -> ShowS
[AvailWidth] -> ShowS
AvailWidth -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AvailWidth] -> ShowS
$cshowList :: [AvailWidth] -> ShowS
show :: AvailWidth -> String
$cshow :: AvailWidth -> String
showsPrec :: Int -> AvailWidth -> ShowS
$cshowsPrec :: Int -> AvailWidth -> ShowS
Show)

-- | > widthDeficit = max 0 $ desiredColumnWidth - availableWidth
--
-- It is positive when a column is shrunk to the available width.
--
-- If you use fixed paddings to introduce gaps between columns, you may want to remove fixed paddings when width deficit
-- is positive because a column is not preceded or followed by other columns and its width is shrunk.
--
-- The following examples show how to remove gaps between columns when width deficit is positive.
--
-- @
-- 'padRight' ('Pad' $ if widthDeficit > 0 then 0 else 1) $ 'padLeft' 'Max' content
-- @
--
-- @
-- 'padLeft' ('Pad' $ if widthDeficit > 0 then 0 else 1) $ 'hCenter' content
-- @
newtype WidthDeficit = WdthD Int deriving (WidthDeficit -> WidthDeficit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WidthDeficit -> WidthDeficit -> Bool
$c/= :: WidthDeficit -> WidthDeficit -> Bool
== :: WidthDeficit -> WidthDeficit -> Bool
$c== :: WidthDeficit -> WidthDeficit -> Bool
Eq, forall x. Rep WidthDeficit x -> WidthDeficit
forall x. WidthDeficit -> Rep WidthDeficit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WidthDeficit x -> WidthDeficit
$cfrom :: forall x. WidthDeficit -> Rep WidthDeficit x
Generic, Int -> WidthDeficit -> ShowS
[WidthDeficit] -> ShowS
WidthDeficit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WidthDeficit] -> ShowS
$cshowList :: [WidthDeficit] -> ShowS
show :: WidthDeficit -> String
$cshow :: WidthDeficit -> String
showsPrec :: Int -> WidthDeficit -> ShowS
$cshowsPrec :: Int -> WidthDeficit -> ShowS
Show)

-- | Whether the list is focused in an application
newtype ListFocused = LstFcs Bool deriving (ListFocused -> ListFocused -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFocused -> ListFocused -> Bool
$c/= :: ListFocused -> ListFocused -> Bool
== :: ListFocused -> ListFocused -> Bool
$c== :: ListFocused -> ListFocused -> Bool
Eq, forall x. Rep ListFocused x -> ListFocused
forall x. ListFocused -> Rep ListFocused x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListFocused x -> ListFocused
$cfrom :: forall x. ListFocused -> Rep ListFocused x
Generic, Int -> ListFocused -> ShowS
[ListFocused] -> ShowS
ListFocused -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFocused] -> ShowS
$cshowList :: [ListFocused] -> ShowS
show :: ListFocused -> String
$cshow :: ListFocused -> String
showsPrec :: Int -> ListFocused -> ShowS
$cshowsPrec :: Int -> ListFocused -> ShowS
Show)

-- | Whether a tabular list component is selected
newtype Selected = Sel Bool deriving (Selected -> Selected -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selected -> Selected -> Bool
$c/= :: Selected -> Selected -> Bool
== :: Selected -> Selected -> Bool
$c== :: Selected -> Selected -> Bool
Eq, forall x. Rep Selected x -> Selected
forall x. Selected -> Rep Selected x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Selected x -> Selected
$cfrom :: forall x. Selected -> Rep Selected x
Generic, Int -> Selected -> ShowS
[Selected] -> ShowS
Selected -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selected] -> ShowS
$cshowList :: [Selected] -> ShowS
show :: Selected -> String
$cshow :: Selected -> String
showsPrec :: Int -> Selected -> ShowS
$cshowsPrec :: Int -> Selected -> ShowS
Show)

-- | Row header context
newtype RowHdrCtxt = RowHdrCtxt Selected deriving (RowHdrCtxt -> RowHdrCtxt -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RowHdrCtxt -> RowHdrCtxt -> Bool
$c/= :: RowHdrCtxt -> RowHdrCtxt -> Bool
== :: RowHdrCtxt -> RowHdrCtxt -> Bool
$c== :: RowHdrCtxt -> RowHdrCtxt -> Bool
Eq, forall x. Rep RowHdrCtxt x -> RowHdrCtxt
forall x. RowHdrCtxt -> Rep RowHdrCtxt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RowHdrCtxt x -> RowHdrCtxt
$cfrom :: forall x. RowHdrCtxt -> Rep RowHdrCtxt x
Generic, Int -> RowHdrCtxt -> ShowS
[RowHdrCtxt] -> ShowS
RowHdrCtxt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowHdrCtxt] -> ShowS
$cshowList :: [RowHdrCtxt] -> ShowS
show :: RowHdrCtxt -> String
$cshow :: RowHdrCtxt -> String
showsPrec :: Int -> RowHdrCtxt -> ShowS
$cshowsPrec :: Int -> RowHdrCtxt -> ShowS
Show)

-- | 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
-> ListFocused -> WidthDeficit -> RowHdrCtxt -> r -> Widget n
draw :: ListFocused -> WidthDeficit -> RowHdrCtxt -> 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 -> AvailWidth -> [r] -> RowHdrWidth
width :: AvailWidth -> [r] -> RowHdrWidth
  -- | Get a row header from a list row and row index.
, forall n e r. RowHdr n e r -> e -> Index -> r
toRH :: 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 'ColHdrRowHdr' is 'BlankCHRH', then column header row header is
-- filled with empty space. 'ColHdrRowHdr' merely allows you to customize column header row header.
data ColHdrRowHdr n = BlankCHRH | CHRH (ListFocused -> WidthDeficit -> Widget n) deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n x. Rep (ColHdrRowHdr n) x -> ColHdrRowHdr n
forall n x. ColHdrRowHdr n -> Rep (ColHdrRowHdr n) x
$cto :: forall n x. Rep (ColHdrRowHdr n) x -> ColHdrRowHdr n
$cfrom :: forall n x. ColHdrRowHdr n -> Rep (ColHdrRowHdr n) x
Generic