{-# LANGUAGE MultiWayIf #-}
module Brick.Widgets.Table
(
Table
, ColumnAlignment(..)
, RowAlignment(..)
, TableException(..)
, table
, alignLeft
, alignRight
, alignCenter
, alignTop
, alignMiddle
, alignBottom
, setColAlignment
, setRowAlignment
, setDefaultColAlignment
, setDefaultRowAlignment
, surroundingBorder
, rowBorders
, columnBorders
, renderTable
)
where
import Control.Monad (forM)
import qualified Control.Exception as E
import Data.List (transpose, intersperse, nub)
import qualified Data.Map as M
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid ((<>))
#endif
import Graphics.Vty (imageHeight, imageWidth, charFill)
import Lens.Micro ((^.))
import Brick.Types
import Brick.Widgets.Core
import Brick.Widgets.Center
import Brick.Widgets.Border
data ColumnAlignment =
AlignLeft
| AlignCenter
| AlignRight
deriving (ColumnAlignment -> ColumnAlignment -> Bool
(ColumnAlignment -> ColumnAlignment -> Bool)
-> (ColumnAlignment -> ColumnAlignment -> Bool)
-> Eq ColumnAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnAlignment -> ColumnAlignment -> Bool
$c/= :: ColumnAlignment -> ColumnAlignment -> Bool
== :: ColumnAlignment -> ColumnAlignment -> Bool
$c== :: ColumnAlignment -> ColumnAlignment -> Bool
Eq, Int -> ColumnAlignment -> ShowS
[ColumnAlignment] -> ShowS
ColumnAlignment -> String
(Int -> ColumnAlignment -> ShowS)
-> (ColumnAlignment -> String)
-> ([ColumnAlignment] -> ShowS)
-> Show ColumnAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnAlignment] -> ShowS
$cshowList :: [ColumnAlignment] -> ShowS
show :: ColumnAlignment -> String
$cshow :: ColumnAlignment -> String
showsPrec :: Int -> ColumnAlignment -> ShowS
$cshowsPrec :: Int -> ColumnAlignment -> ShowS
Show, ReadPrec [ColumnAlignment]
ReadPrec ColumnAlignment
Int -> ReadS ColumnAlignment
ReadS [ColumnAlignment]
(Int -> ReadS ColumnAlignment)
-> ReadS [ColumnAlignment]
-> ReadPrec ColumnAlignment
-> ReadPrec [ColumnAlignment]
-> Read ColumnAlignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColumnAlignment]
$creadListPrec :: ReadPrec [ColumnAlignment]
readPrec :: ReadPrec ColumnAlignment
$creadPrec :: ReadPrec ColumnAlignment
readList :: ReadS [ColumnAlignment]
$creadList :: ReadS [ColumnAlignment]
readsPrec :: Int -> ReadS ColumnAlignment
$creadsPrec :: Int -> ReadS ColumnAlignment
Read)
data RowAlignment =
AlignTop
| AlignMiddle
| AlignBottom
deriving (RowAlignment -> RowAlignment -> Bool
(RowAlignment -> RowAlignment -> Bool)
-> (RowAlignment -> RowAlignment -> Bool) -> Eq RowAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RowAlignment -> RowAlignment -> Bool
$c/= :: RowAlignment -> RowAlignment -> Bool
== :: RowAlignment -> RowAlignment -> Bool
$c== :: RowAlignment -> RowAlignment -> Bool
Eq, Int -> RowAlignment -> ShowS
[RowAlignment] -> ShowS
RowAlignment -> String
(Int -> RowAlignment -> ShowS)
-> (RowAlignment -> String)
-> ([RowAlignment] -> ShowS)
-> Show RowAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowAlignment] -> ShowS
$cshowList :: [RowAlignment] -> ShowS
show :: RowAlignment -> String
$cshow :: RowAlignment -> String
showsPrec :: Int -> RowAlignment -> ShowS
$cshowsPrec :: Int -> RowAlignment -> ShowS
Show, ReadPrec [RowAlignment]
ReadPrec RowAlignment
Int -> ReadS RowAlignment
ReadS [RowAlignment]
(Int -> ReadS RowAlignment)
-> ReadS [RowAlignment]
-> ReadPrec RowAlignment
-> ReadPrec [RowAlignment]
-> Read RowAlignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RowAlignment]
$creadListPrec :: ReadPrec [RowAlignment]
readPrec :: ReadPrec RowAlignment
$creadPrec :: ReadPrec RowAlignment
readList :: ReadS [RowAlignment]
$creadList :: ReadS [RowAlignment]
readsPrec :: Int -> ReadS RowAlignment
$creadsPrec :: Int -> ReadS RowAlignment
Read)
data TableException =
TEUnequalRowSizes
| TEInvalidCellSizePolicy
deriving (TableException -> TableException -> Bool
(TableException -> TableException -> Bool)
-> (TableException -> TableException -> Bool) -> Eq TableException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableException -> TableException -> Bool
$c/= :: TableException -> TableException -> Bool
== :: TableException -> TableException -> Bool
$c== :: TableException -> TableException -> Bool
Eq, Int -> TableException -> ShowS
[TableException] -> ShowS
TableException -> String
(Int -> TableException -> ShowS)
-> (TableException -> String)
-> ([TableException] -> ShowS)
-> Show TableException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableException] -> ShowS
$cshowList :: [TableException] -> ShowS
show :: TableException -> String
$cshow :: TableException -> String
showsPrec :: Int -> TableException -> ShowS
$cshowsPrec :: Int -> TableException -> ShowS
Show, ReadPrec [TableException]
ReadPrec TableException
Int -> ReadS TableException
ReadS [TableException]
(Int -> ReadS TableException)
-> ReadS [TableException]
-> ReadPrec TableException
-> ReadPrec [TableException]
-> Read TableException
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TableException]
$creadListPrec :: ReadPrec [TableException]
readPrec :: ReadPrec TableException
$creadPrec :: ReadPrec TableException
readList :: ReadS [TableException]
$creadList :: ReadS [TableException]
readsPrec :: Int -> ReadS TableException
$creadsPrec :: Int -> ReadS TableException
Read)
instance E.Exception TableException where
data Table n =
Table { Table n -> Map Int ColumnAlignment
columnAlignments :: M.Map Int ColumnAlignment
, Table n -> Map Int RowAlignment
rowAlignments :: M.Map Int RowAlignment
, Table n -> [[Widget n]]
tableRows :: [[Widget n]]
, Table n -> ColumnAlignment
defaultColumnAlignment :: ColumnAlignment
, Table n -> RowAlignment
defaultRowAlignment :: RowAlignment
, Table n -> Bool
drawSurroundingBorder :: Bool
, Table n -> Bool
drawRowBorders :: Bool
, Table n -> Bool
drawColumnBorders :: Bool
}
table :: [[Widget n]] -> Table n
table :: [[Widget n]] -> Table n
table [[Widget n]]
rows =
if | Bool -> Bool
not Bool
allFixed -> TableException -> Table n
forall a e. Exception e => e -> a
E.throw TableException
TEInvalidCellSizePolicy
| Bool -> Bool
not Bool
allSameLength -> TableException -> Table n
forall a e. Exception e => e -> a
E.throw TableException
TEUnequalRowSizes
| Bool
otherwise -> Table n
t
where
allSameLength :: Bool
allSameLength = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub ([Widget n] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Widget n] -> Int) -> [[Widget n]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Widget n]]
rows)) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
allFixed :: Bool
allFixed = ([Widget n] -> Bool) -> [[Widget n]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Widget n] -> Bool
forall n. [Widget n] -> Bool
fixedRow [[Widget n]]
rows
fixedRow :: [Widget n] -> Bool
fixedRow = (Widget n -> Bool) -> [Widget n] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Widget n -> Bool
forall n. Widget n -> Bool
fixedCell
fixedCell :: Widget n -> Bool
fixedCell Widget n
w = Widget n -> Size
forall n. Widget n -> Size
hSize Widget n
w Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
Fixed Bool -> Bool -> Bool
&& Widget n -> Size
forall n. Widget n -> Size
vSize Widget n
w Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== Size
Fixed
t :: Table n
t = Table :: forall n.
Map Int ColumnAlignment
-> Map Int RowAlignment
-> [[Widget n]]
-> ColumnAlignment
-> RowAlignment
-> Bool
-> Bool
-> Bool
-> Table n
Table { columnAlignments :: Map Int ColumnAlignment
columnAlignments = Map Int ColumnAlignment
forall a. Monoid a => a
mempty
, rowAlignments :: Map Int RowAlignment
rowAlignments = Map Int RowAlignment
forall a. Monoid a => a
mempty
, tableRows :: [[Widget n]]
tableRows = [[Widget n]]
rows
, drawSurroundingBorder :: Bool
drawSurroundingBorder = Bool
True
, drawRowBorders :: Bool
drawRowBorders = Bool
True
, drawColumnBorders :: Bool
drawColumnBorders = Bool
True
, defaultColumnAlignment :: ColumnAlignment
defaultColumnAlignment = ColumnAlignment
AlignLeft
, defaultRowAlignment :: RowAlignment
defaultRowAlignment = RowAlignment
AlignTop
}
surroundingBorder :: Bool -> Table n -> Table n
surroundingBorder :: Bool -> Table n -> Table n
surroundingBorder Bool
b Table n
t =
Table n
t { drawSurroundingBorder :: Bool
drawSurroundingBorder = Bool
b }
rowBorders :: Bool -> Table n -> Table n
rowBorders :: Bool -> Table n -> Table n
rowBorders Bool
b Table n
t =
Table n
t { drawRowBorders :: Bool
drawRowBorders = Bool
b }
columnBorders :: Bool -> Table n -> Table n
columnBorders :: Bool -> Table n -> Table n
columnBorders Bool
b Table n
t =
Table n
t { drawColumnBorders :: Bool
drawColumnBorders = Bool
b }
alignRight :: Int -> Table n -> Table n
alignRight :: Int -> Table n -> Table n
alignRight = ColumnAlignment -> Int -> Table n -> Table n
forall n. ColumnAlignment -> Int -> Table n -> Table n
setColAlignment ColumnAlignment
AlignRight
alignLeft :: Int -> Table n -> Table n
alignLeft :: Int -> Table n -> Table n
alignLeft = ColumnAlignment -> Int -> Table n -> Table n
forall n. ColumnAlignment -> Int -> Table n -> Table n
setColAlignment ColumnAlignment
AlignLeft
alignCenter :: Int -> Table n -> Table n
alignCenter :: Int -> Table n -> Table n
alignCenter = ColumnAlignment -> Int -> Table n -> Table n
forall n. ColumnAlignment -> Int -> Table n -> Table n
setColAlignment ColumnAlignment
AlignCenter
alignTop :: Int -> Table n -> Table n
alignTop :: Int -> Table n -> Table n
alignTop = RowAlignment -> Int -> Table n -> Table n
forall n. RowAlignment -> Int -> Table n -> Table n
setRowAlignment RowAlignment
AlignTop
alignMiddle :: Int -> Table n -> Table n
alignMiddle :: Int -> Table n -> Table n
alignMiddle = RowAlignment -> Int -> Table n -> Table n
forall n. RowAlignment -> Int -> Table n -> Table n
setRowAlignment RowAlignment
AlignMiddle
alignBottom :: Int -> Table n -> Table n
alignBottom :: Int -> Table n -> Table n
alignBottom = RowAlignment -> Int -> Table n -> Table n
forall n. RowAlignment -> Int -> Table n -> Table n
setRowAlignment RowAlignment
AlignBottom
setColAlignment :: ColumnAlignment -> Int -> Table n -> Table n
setColAlignment :: ColumnAlignment -> Int -> Table n -> Table n
setColAlignment ColumnAlignment
a Int
col Table n
t =
Table n
t { columnAlignments :: Map Int ColumnAlignment
columnAlignments = Int
-> ColumnAlignment
-> Map Int ColumnAlignment
-> Map Int ColumnAlignment
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
col ColumnAlignment
a (Table n -> Map Int ColumnAlignment
forall n. Table n -> Map Int ColumnAlignment
columnAlignments Table n
t) }
setRowAlignment :: RowAlignment -> Int -> Table n -> Table n
setRowAlignment :: RowAlignment -> Int -> Table n -> Table n
setRowAlignment RowAlignment
a Int
row Table n
t =
Table n
t { rowAlignments :: Map Int RowAlignment
rowAlignments = Int -> RowAlignment -> Map Int RowAlignment -> Map Int RowAlignment
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Int
row RowAlignment
a (Table n -> Map Int RowAlignment
forall n. Table n -> Map Int RowAlignment
rowAlignments Table n
t) }
setDefaultColAlignment :: ColumnAlignment -> Table n -> Table n
setDefaultColAlignment :: ColumnAlignment -> Table n -> Table n
setDefaultColAlignment ColumnAlignment
a Table n
t =
Table n
t { defaultColumnAlignment :: ColumnAlignment
defaultColumnAlignment = ColumnAlignment
a }
setDefaultRowAlignment :: RowAlignment -> Table n -> Table n
setDefaultRowAlignment :: RowAlignment -> Table n -> Table n
setDefaultRowAlignment RowAlignment
a Table n
t =
Table n
t { defaultRowAlignment :: RowAlignment
defaultRowAlignment = RowAlignment
a }
renderTable :: Table n -> Widget n
renderTable :: Table n -> Widget n
renderTable Table n
t =
Widget n -> Widget n
forall n. Widget n -> Widget n
joinBorders (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
Context n
ctx <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
[[Result n]]
cellResults <- [[Widget n]]
-> ([Widget n]
-> ReaderT (Context n) (State (RenderState n)) [Result n])
-> ReaderT (Context n) (State (RenderState n)) [[Result n]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Table n -> [[Widget n]]
forall n. Table n -> [[Widget n]]
tableRows Table n
t) (([Widget n]
-> ReaderT (Context n) (State (RenderState n)) [Result n])
-> ReaderT (Context n) (State (RenderState n)) [[Result n]])
-> ([Widget n]
-> ReaderT (Context n) (State (RenderState n)) [Result n])
-> ReaderT (Context n) (State (RenderState n)) [[Result n]]
forall a b. (a -> b) -> a -> b
$ (Widget n -> RenderM n (Result n))
-> [Widget n]
-> ReaderT (Context n) (State (RenderState n)) [Result n]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render
let maybeIntersperse :: (Table n -> Bool) -> a -> [a] -> [a]
maybeIntersperse Table n -> Bool
f a
v = if Table n -> Bool
f Table n
t then a -> [a] -> [a]
forall a. a -> [a] -> [a]
intersperse a
v else [a] -> [a]
forall a. a -> a
id
rowHeights :: [Int]
rowHeights = [Result n] -> Int
forall n. [Result n] -> Int
rowHeight ([Result n] -> Int) -> [[Result n]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Result n]]
cellResults
colWidths :: [Int]
colWidths = [Result n] -> Int
forall n. [Result n] -> Int
colWidth ([Result n] -> Int) -> [[Result n]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Result n]]
byColumn
allRowAligns :: [RowAlignment]
allRowAligns = (\Int
i -> RowAlignment -> Int -> Map Int RowAlignment -> RowAlignment
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault (Table n -> RowAlignment
forall n. Table n -> RowAlignment
defaultRowAlignment Table n
t) Int
i (Table n -> Map Int RowAlignment
forall n. Table n -> Map Int RowAlignment
rowAlignments Table n
t)) (Int -> RowAlignment) -> [Int] -> [RowAlignment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
[Int
0..[Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
rowHeights Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
allColAligns :: [ColumnAlignment]
allColAligns = (\Int
i -> ColumnAlignment
-> Int -> Map Int ColumnAlignment -> ColumnAlignment
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault (Table n -> ColumnAlignment
forall n. Table n -> ColumnAlignment
defaultColumnAlignment Table n
t) Int
i (Table n -> Map Int ColumnAlignment
forall n. Table n -> Map Int ColumnAlignment
columnAlignments Table n
t)) (Int -> ColumnAlignment) -> [Int] -> [ColumnAlignment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
[Int
0..[[Result n]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Result n]]
byColumn Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
rowHeight :: [Result n] -> Int
rowHeight = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([Result n] -> [Int]) -> [Result n] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result n -> Int) -> [Result n] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Image -> Int
imageHeight (Image -> Int) -> (Result n -> Image) -> Result n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result n -> Image
forall n. Result n -> Image
image)
colWidth :: [Result n] -> Int
colWidth = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([Result n] -> [Int]) -> [Result n] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result n -> Int) -> [Result n] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Image -> Int
imageWidth (Image -> Int) -> (Result n -> Image) -> Result n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result n -> Image
forall n. Result n -> Image
image)
byColumn :: [[Result n]]
byColumn = [[Result n]] -> [[Result n]]
forall a. [[a]] -> [[a]]
transpose [[Result n]]
cellResults
toW :: Result n -> Widget n
toW = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> (Result n -> RenderM n (Result n)) -> Result n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return
fillEmptyCell :: d -> d -> Result n -> Result n
fillEmptyCell d
w d
h Result n
result =
if Image -> Int
imageWidth (Result n -> Image
forall n. Result n -> Image
image Result n
result) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Image -> Int
imageHeight (Result n -> Image
forall n. Result n -> Image
image Result n
result) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then Result n
result { image :: Image
image = Attr -> Char -> d -> d -> Image
forall d. Integral d => Attr -> Char -> d -> d -> Image
charFill (Context n
ctxContext n -> Getting Attr (Context n) Attr -> Attr
forall s a. s -> Getting a s a -> a
^.Getting Attr (Context n) Attr
forall r n. Getting r (Context n) Attr
attrL) Char
' ' d
w d
h }
else Result n
result
mkColumn :: (ColumnAlignment, Int, [Result n]) -> Widget n
mkColumn (ColumnAlignment
hAlign, Int
width, [Result n]
colCells) =
let paddedCells :: [Widget n]
paddedCells = (((RowAlignment, Int, Result n) -> Widget n)
-> [(RowAlignment, Int, Result n)] -> [Widget n])
-> [(RowAlignment, Int, Result n)]
-> ((RowAlignment, Int, Result n) -> Widget n)
-> [Widget n]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((RowAlignment, Int, Result n) -> Widget n)
-> [(RowAlignment, Int, Result n)] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map ([RowAlignment]
-> [Int] -> [Result n] -> [(RowAlignment, Int, Result n)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [RowAlignment]
allRowAligns [Int]
rowHeights [Result n]
colCells) (((RowAlignment, Int, Result n) -> Widget n) -> [Widget n])
-> ((RowAlignment, Int, Result n) -> Widget n) -> [Widget n]
forall a b. (a -> b) -> a -> b
$ \(RowAlignment
vAlign, Int
rHeight, Result n
cell) ->
Int -> ColumnAlignment -> Widget n -> Widget n
forall n. Int -> ColumnAlignment -> Widget n -> Widget n
applyColAlignment Int
width ColumnAlignment
hAlign (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Int -> RowAlignment -> Widget n -> Widget n
forall n. Int -> RowAlignment -> Widget n -> Widget n
applyRowAlignment Int
rHeight RowAlignment
vAlign (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Result n -> Widget n
forall n. Result n -> Widget n
toW (Result n -> Widget n) -> Result n -> Widget n
forall a b. (a -> b) -> a -> b
$
Int -> Int -> Result n -> Result n
forall d n. Integral d => d -> d -> Result n -> Result n
fillEmptyCell Int
width Int
rHeight Result n
cell
maybeRowBorders :: [Widget n] -> [Widget n]
maybeRowBorders = (Table n -> Bool) -> Widget n -> [Widget n] -> [Widget n]
forall a. (Table n -> Bool) -> a -> [a] -> [a]
maybeIntersperse Table n -> Bool
forall n. Table n -> Bool
drawRowBorders (Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
width Widget n
forall n. Widget n
hBorder)
in [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ [Widget n] -> [Widget n]
forall n. [Widget n] -> [Widget n]
maybeRowBorders [Widget n]
paddedCells
vBorders :: [Widget n]
vBorders = Int -> Widget n
forall n. Int -> Widget n
mkVBorder (Int -> Widget n) -> [Int] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
rowHeights
hBorders :: [Widget n]
hBorders = Int -> Widget n
forall n. Int -> Widget n
mkHBorder (Int -> Widget n) -> [Int] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
colWidths
mkHBorder :: Int -> Widget n
mkHBorder Int
w = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
w Widget n
forall n. Widget n
hBorder
mkVBorder :: Int -> Widget n
mkVBorder Int
h = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
h Widget n
forall n. Widget n
vBorder
topBorder :: Widget n
topBorder =
[Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (Table n -> Bool) -> Widget n -> [Widget n] -> [Widget n]
forall a. (Table n -> Bool) -> a -> [a] -> [a]
maybeIntersperse Table n -> Bool
forall n. Table n -> Bool
drawColumnBorders Widget n
forall n. Widget n
topT [Widget n]
forall n. [Widget n]
hBorders
bottomBorder :: Widget n
bottomBorder =
[Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (Table n -> Bool) -> Widget n -> [Widget n] -> [Widget n]
forall a. (Table n -> Bool) -> a -> [a] -> [a]
maybeIntersperse Table n -> Bool
forall n. Table n -> Bool
drawColumnBorders Widget n
forall n. Widget n
bottomT [Widget n]
forall n. [Widget n]
hBorders
leftBorder :: Widget n
leftBorder =
[Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n
forall n. Widget n
topLeftCorner Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
: (Table n -> Bool) -> Widget n -> [Widget n] -> [Widget n]
forall a. (Table n -> Bool) -> a -> [a] -> [a]
maybeIntersperse Table n -> Bool
forall n. Table n -> Bool
drawRowBorders Widget n
forall n. Widget n
leftT [Widget n]
forall n. [Widget n]
vBorders [Widget n] -> [Widget n] -> [Widget n]
forall a. Semigroup a => a -> a -> a
<> [Widget n
forall n. Widget n
bottomLeftCorner]
rightBorder :: Widget n
rightBorder =
[Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n
forall n. Widget n
topRightCorner Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
: (Table n -> Bool) -> Widget n -> [Widget n] -> [Widget n]
forall a. (Table n -> Bool) -> a -> [a] -> [a]
maybeIntersperse Table n -> Bool
forall n. Table n -> Bool
drawRowBorders Widget n
forall n. Widget n
rightT [Widget n]
forall n. [Widget n]
vBorders [Widget n] -> [Widget n] -> [Widget n]
forall a. Semigroup a => a -> a -> a
<> [Widget n
forall n. Widget n
bottomRightCorner]
maybeWrap :: (Table n -> Bool) -> (a -> a) -> a -> a
maybeWrap Table n -> Bool
check a -> a
f =
if Table n -> Bool
check Table n
t then a -> a
f else a -> a
forall a. a -> a
id
addSurroundingBorder :: Widget n -> Widget n
addSurroundingBorder Widget n
body =
Widget n
forall n. Widget n
leftBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (Widget n
forall n. Widget n
topBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
body Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Widget n
forall n. Widget n
bottomBorder) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n
forall n. Widget n
rightBorder
addColumnBorders :: [Widget n] -> [Widget n]
addColumnBorders =
let maybeAddCrosses :: [Widget n] -> [Widget n]
maybeAddCrosses = (Table n -> Bool) -> Widget n -> [Widget n] -> [Widget n]
forall a. (Table n -> Bool) -> a -> [a] -> [a]
maybeIntersperse Table n -> Bool
forall n. Table n -> Bool
drawRowBorders Widget n
forall n. Widget n
cross
columnBorder :: Widget n
columnBorder = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ [Widget n] -> [Widget n]
forall n. [Widget n] -> [Widget n]
maybeAddCrosses [Widget n]
forall n. [Widget n]
vBorders
in Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
intersperse Widget n
forall n. Widget n
columnBorder
let columns :: [Widget n]
columns = (ColumnAlignment, Int, [Result n]) -> Widget n
forall n. (ColumnAlignment, Int, [Result n]) -> Widget n
mkColumn ((ColumnAlignment, Int, [Result n]) -> Widget n)
-> [(ColumnAlignment, Int, [Result n])] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ColumnAlignment]
-> [Int] -> [[Result n]] -> [(ColumnAlignment, Int, [Result n])]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [ColumnAlignment]
allColAligns [Int]
colWidths [[Result n]]
byColumn
body :: Widget n
body = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$
(Table n -> Bool)
-> ([Widget n] -> [Widget n]) -> [Widget n] -> [Widget n]
forall a. (Table n -> Bool) -> (a -> a) -> a -> a
maybeWrap Table n -> Bool
forall n. Table n -> Bool
drawColumnBorders [Widget n] -> [Widget n]
forall n. [Widget n] -> [Widget n]
addColumnBorders [Widget n]
columns
Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ (Table n -> Bool) -> (Widget n -> Widget n) -> Widget n -> Widget n
forall a. (Table n -> Bool) -> (a -> a) -> a -> a
maybeWrap Table n -> Bool
forall n. Table n -> Bool
drawSurroundingBorder Widget n -> Widget n
forall n. Widget n -> Widget n
addSurroundingBorder Widget n
body
topLeftCorner :: Widget n
topLeftCorner :: Widget n
topLeftCorner = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Edges Bool -> Widget n) -> Edges Bool -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
True Bool
False Bool
True
topRightCorner :: Widget n
topRightCorner :: Widget n
topRightCorner = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Edges Bool -> Widget n) -> Edges Bool -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
True Bool
True Bool
False
bottomLeftCorner :: Widget n
bottomLeftCorner :: Widget n
bottomLeftCorner = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Edges Bool -> Widget n) -> Edges Bool -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
False Bool
True
bottomRightCorner :: Widget n
bottomRightCorner :: Widget n
bottomRightCorner = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Edges Bool -> Widget n) -> Edges Bool -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
True Bool
False
cross :: Widget n
cross :: Widget n
cross = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Edges Bool -> Widget n) -> Edges Bool -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
True Bool
True Bool
True
leftT :: Widget n
leftT :: Widget n
leftT = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Edges Bool -> Widget n) -> Edges Bool -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
True Bool
False Bool
True
rightT :: Widget n
rightT :: Widget n
rightT = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Edges Bool -> Widget n) -> Edges Bool -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
True Bool
True Bool
False
topT :: Widget n
topT :: Widget n
topT = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Edges Bool -> Widget n) -> Edges Bool -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
False Bool
True Bool
True Bool
True
bottomT :: Widget n
bottomT :: Widget n
bottomT = Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Edges Bool -> Widget n) -> Edges Bool -> Widget n
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
True Bool
True
applyColAlignment :: Int -> ColumnAlignment -> Widget n -> Widget n
applyColAlignment :: Int -> ColumnAlignment -> Widget n -> Widget n
applyColAlignment Int
width ColumnAlignment
align Widget n
w =
Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
width (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ case ColumnAlignment
align of
ColumnAlignment
AlignLeft -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max Widget n
w
ColumnAlignment
AlignCenter -> Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter Widget n
w
ColumnAlignment
AlignRight -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max Widget n
w
applyRowAlignment :: Int -> RowAlignment -> Widget n -> Widget n
applyRowAlignment :: Int -> RowAlignment -> Widget n -> Widget n
applyRowAlignment Int
rHeight RowAlignment
align Widget n
w =
Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
rHeight (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ case RowAlignment
align of
RowAlignment
AlignTop -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max Widget n
w
RowAlignment
AlignMiddle -> Widget n -> Widget n
forall n. Widget n -> Widget n
vCenter Widget n
w
RowAlignment
AlignBottom -> Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop Padding
Max Widget n
w