2 files changed, 82 insertions(+), 14 deletions(-)

M Graphics/Layout/CSS.hs
M Graphics/Layout/CSS/Parse.hs

@@ 73,7 73,7 @@ finalizeChilds :: PropertyParser x => Font' -> Font' -> CSSBox x ->
         [StyleTree (CSSBox x)] -> [LayoutItem Length Length x]
 finalizeChilds root parent style' (StyleTree { style = CSSBox { display = None } }:childs) =
     finalizeChilds root parent style' childs
-finalizeChilds root parent style' childs@(child:childs')
+finalizeChilds root parent style' childs@(child:_)
     | isInlineTree childs, Just self <- finalizeParagraph (flattenTree0 childs) =
         [LayoutInline (inherit $ inner' parent style') self paging]
     | (inlines@(_:_), blocks) <- spanInlines childs,


@@ 82,7 82,6 @@ finalizeChilds root parent style' childs@(child:childs')
                 finalizeChilds root parent style' blocks
     | (StyleTree { style = CSSBox { display = Inline } }:childs') <- childs =
         finalizeChilds root parent style' childs' -- Inline's all whitespace...
-    | otherwise = finalizeCSS root parent child : finalizeChilds root parent style' childs'
   where
     paging = pageOptions $ style child
     isInlineTree = all isInlineTree0


@@ 118,7 117,23 @@ finalizeChilds root parent style' childs@(child:childs')
     finalizeParagraph tree =
         Just $ constructParagraph "" tree "" $ paragraphOptions style'
     enumerate = zip $ enumFrom 0
-finalizeChilds _ _ _ [] = []
+finalizeChilds root parent style' childs
+    | (_:_) <- table = finalizeTable root parent temp table:
+        finalizeChilds root parent style' rest
+    | (child:childs') <- childs = finalizeCSS root parent child:
+        finalizeChilds root parent style' childs'
+    | otherwise = []
+  where
+    (table, rest) = span isTable childs
+    isTable (StyleTree CSSBox { display = TableRow } _) = True
+    isTable (StyleTree CSSBox { display = TableHeaderGroup } _) = True
+    isTable (StyleTree CSSBox { display = TableRowGroup } _) = True
+    isTable (StyleTree CSSBox { display = TableFooterGroup } _) = True
+    isTable (StyleTree CSSBox { display = TableCell } _) = True
+    isTable (StyleTree CSSBox { display = TableColumn } _) = True
+    isTable (StyleTree CSSBox { display = TableColumnGroup } _) = True
+    -- Treat TableCaption as a block element!
+    isTable _ = False
 
 -- | Desugar most units, possibly in reference to given font.
 finalizeBox self@CSSBox { cssBox = box } font_ =


@@ 126,7 141,7 @@ finalizeBox self@CSSBox { cssBox = box } font_ =
 
 -- | (Unused, incomplete) Desugar a styletree of table elements to a grid layout.
 finalizeTable root parent val childs = LayoutFlow val lengthBox [] -- Placeholder!
-{- finalizeTable root parent val childs = LayoutGrid val grid $ zip cells' childs'
+{-finalizeTable root parent val childs = LayoutGrid val grid $ zip cells' childs'
   where -- FIXME? How to handle non-table items in <table>?
     grid = Grid {
         rows = take width $ repeat ("", (0,"auto")),


@@ 141,12 156,47 @@ finalizeTable root parent val childs = LayoutFlow val lengthBox [] -- Placeholde
         containerMax = Size Auto Auto
     }
     cells' = adjustWidths cells
-    
+
     (cells, width, height) = lowerCells childs
     lowerCells (StyleTree self@CSSBox { display = TableRow } cells:rest) =
         (row:rows, max rowwidth width', succ height)
       where
-        (row, rowwidth) = lowerRow cells 0 -- FIXME: How to dodge colspans?
+        (row, rowwidth) = lowerRow cells 0 -- FIXME: How to dodge rowspans?
+        (rows, width', height') = lowerCells rest
+    lowerCells (StyleTree CSSBox { display = TableHeaderGroup } childs:rest) =
+        -- Ignore table-header-group styles for now...
+        -- Though it'd be nice for this to impact pagination...
+        lowerCells (childs ++ rest)
+    lowerCells (StyleTree CSSBox { display = TableFooterGroup } childs:rest) =
+        lowerCells (childs ++ rest) -- As per TableHeaderGroup
+    lowerCells (StyleTree CSSBox { display = TableRowGroup } childs:rest) =
+        lowerCells (childs ++ rest) -- As per TableHeaderGroup
+    lowerCells (StyleTree CSSBox { display = TableColumnGroup } _:rest) =
+        lowerCells rest -- It'd be nice to allow styling based on this...
+    lowerCells (StyleTree CSSBox { display = TableColumn } _:rest) =
+        lowerCells rest -- As per TableColumnGroup, should be contained within it.
+    lowerCells (StyleTree CSSBox { display = TableSummary } _:rest) =
+        lowerCells rest -- Handled by callers!
+    lowerCells [] = ([], 0, 0)
+    lowerCells items = (row:rows, max rowwidth width', succ height)
+      where
+        (cells, rest) = break isRowGroup items
+        (row, rowwidth) = lowerRow cells 0 -- FIXME: How to dodge rowspans?
         (rows, width', height') = lowerCells rest
-    lowerCells (StyleTree self@CSSBox { display = TableHeaderGroup } childs ) =
-        -}
+        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 _ = False
+
+    lowerRow (StyleTree self'@CSSBox { display = TableCell } childs:rest) ix =
+        (cell:cells, width)
+      where
+        (cells, width) = lowerRow rest end
+        end = ix + colspan self'
+        cell = (GridItem' ix end _ _ _ `Size` _,
+            finalizeCSS __ $ StyleTree self' { display = Block } childs)
+    lowerRow (self:rest) ix = (cell:cells, width)
+      where
+        (cells, width) = lowerRow rest $ succ ix
+        cell = (GridItem' ix (succ ix) _ _ _ `Size` _, finalizeCSS __ self)-}

@@ 17,8 17,9 @@ import Graphics.Layout.Grid.CSS (CSSGrid(..), CSSCell(..), Placement(..))
 import Graphics.Layout.Inline.CSS (CSSInline(..))
 
 import Data.Maybe (isJust, fromMaybe)
+import Text.Read (readMaybe)
 import qualified Data.HashMap.Lazy as HM
-import Data.Text (Text)
+import Data.Text (Text, unpack)
 import Debug.Trace (trace) -- For debug warnings.
 
 -- | Parsed CSS properties relevant to layout.


@@ 51,7 52,11 @@ data CSSBox a = CSSBox {
     -- | Parsed widows & orphans controlling pagination.
     pageOptions :: PageOptions,
     -- | Parsed text-alignment & other options which applies per-paragraph.
-    paragraphOptions :: ParagraphOptions
+    paragraphOptions :: ParagraphOptions,
+    -- | HTML rowspan attribute
+    rowspan :: Integer,
+    -- | HTML colspan attribute
+    colspan :: Integer
 }
 -- | Accessor for inlineStyle's `textDirection` attribute.
 direction CSSBox { inlineStyles = CSSInline _ opts _ } = textDirection opts


@@ 96,7 101,8 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
         pageOptions = PageOptions 0 0 2 2,
         paragraphOptions = defaultParagraphOptions {
             paragraphAlignment = AlignStart
-        }
+        },
+        rowspan = 1, colspan = 1
       }
     inherit parent = CSSBox {
         boxSizing = boxSizing parent,


@@ 112,7 118,8 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
         inlineStyles = inherit $ inlineStyles parent,
         captionBelow = captionBelow parent,
         pageOptions = pageOptions parent,
-        paragraphOptions = paragraphOptions parent
+        paragraphOptions = paragraphOptions parent,
+        rowspan = 1, colspan = 1
       }
     priority self = concat [x font, x font', x gridStyles, x cellStyles, x inner]
       where x getter = priority $ getter self


@@ 233,7 240,7 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
     longhand _ self "display" [Ident "block"] = Just self { display = Block }
     longhand _ self "display" [Ident "none"] = Just self { display = None }
     longhand _ self "display" [Ident "grid"] = Just self { display = Grid }
-    {-longhand _ self "display" [Ident "table"] = Just self { display = Table }
+    longhand _ self "display" [Ident "table"] = Just self { display = Table }
     longhand CSSBox { display = Table } self "display" [Ident "table-row-group"] =
         Just self { display=TableRowGroup }
     longhand CSSBox { display = Table } self "display" [Ident "table-header-group"] =


@@ 249,10 256,21 @@ instance PropertyParser a => PropertyParser (CSSBox a) where
     longhand CSSBox { display = TableColumnGroup } self "display" [Ident "table-column"] =
         Just self { display = TableColumn }
     longhand CSSBox { display = Table } self "display" [Ident "table-caption"] =
-        Just self { display=TableCaption } -}
+        Just self { display=TableCaption }
     longhand _ self "display" [Ident "inline"] = Just self { display = Inline }
     longhand _ self "display" [Ident "initial"] = Just self { display = Inline }
 
+    longhand _ self "-argo-rowspan" [Ident "initial"] = Just self { rowspan = 1 }
+    longhand _ self "-argo-rowspan" [String x]
+        | Just y <- readMaybe $ unpack x, y >= 1 = Just self { rowspan = y }
+    longhand _ self "-argo-rowspan" [Number _ (NVInteger x)]
+        | x >= 1 = Just self { rowspan = x }
+    longhand _ self "-argo-colspan" [Ident "initial"] = Just self { colspan = 1 }
+    longhand _ self "-argo-colspan" [String x]
+        | Just y <- readMaybe $ unpack x, y >= 1 = Just self { colspan = y }
+    longhand _ self "-argo-colspan" [Number _ (NVInteger x)]
+        | x >= 1 = Just self { colspan = x }
+
     longhand _ self "caption-side" [Ident "top"] = Just self { captionBelow = False }
     longhand _ self "caption-side" [Ident "bottom"] = Just self { captionBelow = True }
     longhand _ self "caption-side" [Ident "initial"] = Just self {captionBelow = False}