From a7083fe3956783cc32ed6078e941c2b3a6b711a0 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Mon, 30 Oct 2023 16:40:23 +1300
Subject: [PATCH] Allow styling table columns & rows!

---
 Graphics/Layout/CSS.hs | 56 ++++++++++++++++++++++++++++++++++++------
 1 file changed, 49 insertions(+), 7 deletions(-)

diff --git a/Graphics/Layout/CSS.hs b/Graphics/Layout/CSS.hs
index 7658682..decbe2f 100644
--- a/Graphics/Layout/CSS.hs
+++ b/Graphics/Layout/CSS.hs
@@ -153,9 +153,10 @@ finalizeTable root parent val childs = LayoutGrid val grid cells' childs'
         gap = Pixels 0, -- Allow styling this!
         trackMins = [], trackNats = []
       }
-    (cells', childs') = unzip cells
+    (cells', childs') = unzip (decor ++ cells)
 
     (cells, width, height) = lowerCells childs 0 emptyRow
+    decor = decorateRow childs width 0 ++ decorateCol childs height 0
     lowerCells (StyleTree self@CSSBox { display = TableRow } cells:rest) h x =
         (row ++ rows, Prelude.max rowwidth width', height')
       where
@@ -181,12 +182,6 @@ finalizeTable root parent val childs = LayoutGrid val grid cells' childs'
         (cells, rest) = break isRowGroup items
         (row, rowwidth, x') = lowerRow cells 0 h x
         (rows, width', height') = lowerCells rest (succ h) $ commitRow x'
-        isRowGroup (StyleTree CSSBox { display = TableRow } _) = True
-        isRowGroup (StyleTree CSSBox { display = TableHeaderGroup } _) = True
-        isRowGroup (StyleTree CSSBox { display = TableFooterGroup } _) = True
-        isRowGroup (StyleTree CSSBox { display = TableRowGroup } _) = True
-        isRowGroup (StyleTree CSSBox { display = TableCaption } _) = True
-        isRowGroup _ = False
 
     lowerRow (StyleTree self'@CSSBox {display=TableCell} childs:rest) ix row x =
         (cell:cells, width, x')
@@ -207,3 +202,50 @@ finalizeTable root parent val childs = LayoutGrid val grid cells' childs'
                 `Size` GridItem row (succ row) Start 0 0,
             finalizeCSS root parent self)
     lowerRow [] ix _ x = ([], ix, x)
+
+    decorateRow (StyleTree self@CSSBox { display = TableRow } _:rest) w row =
+        buildDecor self 0 w row 1:decorateRow rest w (succ row)
+    decorateRow (StyleTree self@CSSBox { display = d } childs:rest) w row
+        | d `elem` [TableHeaderGroup, TableFooterGroup, TableRowGroup] =
+            buildDecor self 0 w row (countRows childs):
+                decorateRow (childs ++ rest) w (row + countRows childs)
+        | d `elem` [TableCaption, TableColumn, TableColumnGroup] =
+            decorateRow rest w row
+        | otherwise = decorateRow (dropWhile (not . isRowGroup) rest) w$succ row
+    decorateRow [] _ _ = []
+    decorateCol (StyleTree self@CSSBox { display = TableColumn } _:rest) h col =
+        buildDecor self col 1 0 h:decorateCol rest h (succ col)
+    decorateCol (StyleTree self@CSSBox { display = TableColumnGroup } childs:rest)
+        h col = buildDecor self col (countCols childs) 0 h:
+            decorateCol (childs ++ rest) h (col + countCols childs)
+    decorateCol (_:rest) h col = decorateCol rest h col
+    decorateCol [] _ _ = []
+
+    countRows (StyleTree CSSBox { display = TableRow } _:rest) =
+        succ $ countRows rest
+    countRows (StyleTree CSSBox { display = d } childs:rest)
+        | d `elem` [TableHeaderGroup, TableFooterGroup, TableRowGroup] =
+            countRows childs + countRows rest
+        | d `elem` [TableCaption, TableColumn, TableColumnGroup] = countRows rest
+        | otherwise = succ $ countRows $ dropWhile (not . isRowGroup) rest
+    countRows [] = 0
+    countCols (StyleTree CSSBox { display = TableColumn } _:rest) =
+        succ $ countCols rest
+    countCols (StyleTree CSSBox { display = TableColumnGroup } childs:rest) =
+        countCols childs + countCols rest
+    countCols (_:rest) = countCols rest
+    countCols [] = 0
+
+    buildDecor self col colspan row rowspan =
+        (GridItem col (col + colspan) Start 0 0 `Size`
+            GridItem row (row + rowspan) Start 0 0,
+            finalizeCSS root parent $ StyleTree self { display = Block } [])
+
+    isRowGroup (StyleTree CSSBox { display = TableRow } _) = True
+    isRowGroup (StyleTree CSSBox { display = TableHeaderGroup } _) = True
+    isRowGroup (StyleTree CSSBox { display = TableFooterGroup } _) = True
+    isRowGroup (StyleTree CSSBox { display = TableRowGroup } _) = True
+    isRowGroup (StyleTree CSSBox { display = TableCaption } _) = True
+    isRowGroup (StyleTree CSSBox { display = TableColumn } _) = True
+    isRowGroup (StyleTree CSSBox { display = TableColumnGroup } _) = True
+    isRowGroup _ = False
-- 
2.30.2