7 files changed, 143 insertions(+), 7 deletions(-)

M Graphics/Layout.hs
M Graphics/Layout/CSS/Length.hs
M Graphics/Layout/Grid.hs
M Graphics/Layout/Inline.hs
M Graphics/Layout/Inline/CSS.hs
M cattrap.cabal
M test/Test.hs

@@ 1,4 1,4 @@
-{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings, RecordWildCards, StandaloneDeriving #-}
 -- | Generic layout logic, handling a hierarchy of varying formulas.
 -- Unless callers have more specific needs they probably wish to use this abstraction.
 -- Attempts to follow the CSS specs.


@@ 32,6 32,11 @@ import qualified Data.Map.Strict as M
 import qualified Data.Text.Glyphize as Hb
 import Graphics.Text.Font.Choose (Pattern)
 
+-- For comparisons
+import Data.Array.Byte (ByteArray(..))
+import Data.Text.Array (Array(..))
+import Unsafe.Coerce (unsafeCoerce)
+
 -- | Additional data routed through Balkon.
 type UserData m n x = ((Font', Int), PaddedBox m n, x)
 


@@ 52,6 57,7 @@ data LayoutItem m n x =
     | LayoutConst x (PaddedBox m n) [LayoutItem m n x]
     -- | Children of a `LayoutInline` or `LayoutInline'`.
     | LayoutSpan (FragmentTree (UserData m n x))
+    deriving (Show, Eq)
 -- | An empty box.
 nullLayout :: (PropertyParser x, Zero m, Zero n) => LayoutItem m n x
 nullLayout = LayoutFlow temp zero []


@@ 409,3 415,16 @@ glyphsPerFont node = M.unionsWith IS.union $ map glyphsPerFont $ layoutGetChilds
 
 parMap' :: NFData b => (a -> b) -> [a] -> [b]
 parMap' = parMap rdeepseq
+
+------
+--- Orphan typeclass instances
+------
+
+instance Show (Paragraph x) where
+    show (Paragraph arr _ _ _) = show $ asBA arr
+deriving instance Show PageOptions
+instance Eq (Paragraph x) where
+    Paragraph a _ _ _ == Paragraph b _ _ _ = asBA a  == asBA b
+deriving instance Eq PageOptions
+
+asBA = unsafeCoerce :: Array -> ByteArray

@@ 120,3 120,5 @@ data Font' = Font' {
 
 instance Eq Font' where
     a == b = pattern a == pattern b
+instance Show Font' where
+    show a = show $ pattern a

@@ 27,7 27,7 @@ data Track x = Track {
     trackNats :: [Double],
     -- | How much space to add between cells.
     gap :: x
-}
+} deriving (Show, Read, Eq, Ord)
 -- | Which cells a child should be aligned to.
 type GridItem = Size GridItem' GridItem'
 -- | How a grid child should be aligned per-axis.

@@ 79,6 79,7 @@ lowerSpacing (Paragraph a b (RootBox c) d) = Paragraph a b (RootBox $ inner c) d
 
 data FragmentTree x = Branch (AncestorBox x) [FragmentTree x]
     | Leaf (Fragment x)
+    deriving (Show, Eq)
 
 -- | Apply an operation to the 2nd field of the paragraph's userdata,
 -- for it's entire subtree.

@@ 2,7 2,7 @@
 -- | Infrastructure for parsing & desugaring text related CSS properties.
 module Graphics.Layout.Inline.CSS(
     CSSInline(..), Default(..), UnicodeBidi(..), applyFontInline, applyBidi,
-    resolveVAlign, resolveBoxOpts) where
+    resolveVAlign, resolveBoxOpts, plaintext) where
 
 import Data.CSS.Syntax.Tokens (Token(..))
 import Stylist (PropertyParser(..))


@@ 25,6 25,10 @@ data CSSInline = CSSInline Txt.Text TextOptions UnicodeBidi
 data UnicodeBidi = BdNormal | BdEmbed | BdOverride | BdIsolate
         | BdIsolateOverride | BdPlainText deriving (Eq, Ord, Enum, Read, Show)
 
+-- | Construct plain text
+plaintext :: Txt.Text -> CSSInline
+plaintext txt = CSSInline txt (defaultTextOptions DirLTR) BdNormal
+
 instance PropertyParser CSSInline where
     temp = CSSInline "" (defaultTextOptions DirLTR) BdNormal
     inherit (CSSInline _ opts _) = CSSInline "" opts BdNormal

@@ 26,15 26,16 @@ library
                         Graphics.Layout.Grid, Graphics.Layout.Grid.CSS,
                         Graphics.Layout.Box, Graphics.Layout.Arithmetic,
                         Graphics.Layout.CSS.Length, Graphics.Layout.CSS.Font,
-                        Graphics.Layout.Inline, Graphics.Layout.Inline.CSS
-  other-modules:        Graphics.Layout.CSS.Parse, Graphics.Layout.Grid.Table
+                        Graphics.Layout.Inline, Graphics.Layout.Inline.CSS,
+                        Graphics.Layout.Grid.Table
+  other-modules:        Graphics.Layout.CSS.Parse
   -- other-extensions:
   build-depends:       base >=4.12 && <5, containers, parallel >= 3,
                         css-syntax, scientific, text, deepseq,
                         stylist-traits >= 0.1.3.0 && < 1,
                         fontconfig-pure >= 0.2 && < 0.5,
                         harfbuzz-pure >= 1.0.3.2 && < 1.1, bytestring,
-                        balkon >= 1.2 && <2, unordered-containers
+                        balkon >= 1.2 && <2, unordered-containers, data-array-byte
   -- hs-source-dirs:
   default-language:    Haskell2010
   ghc-options:         -Wincomplete-patterns


@@ 70,4 71,5 @@ test-suite test-cattrap
   type:                exitcode-stdio-1.0
   main-is:             Test.hs
   build-depends:       base, cattrap, hspec >= 2 && < 3, QuickCheck >= 2 && < 3,
-                        css-syntax, stylist-traits, unordered-containers
+                        css-syntax, stylist-traits, unordered-containers,
+                        balkon, harfbuzz-pure

@@ 6,6 6,7 @@ import Test.Hspec
 import Graphics.Layout.Arithmetic
 import Data.CSS.Syntax.Tokens (tokenize, Token(..))
 import Stylist (PropertyParser(..))
+import Stylist.Tree (StyleTree(..))
 import Data.Maybe (fromJust)
 
 import Graphics.Layout.Box as B


@@ 13,6 14,17 @@ import Graphics.Layout.Grid
 import Graphics.Layout.Flow
 import Graphics.Layout
 
+import Graphics.Layout.CSS
+import Graphics.Layout.Grid.Table
+import Graphics.Layout.Inline.CSS
+import Graphics.Layout.CSS.Font (placeholderFont)
+
+import Data.Text.ParagraphLayout.Rich (constructParagraph,
+        defaultParagraphOptions, defaultTextOptions,
+        InnerNode(..), Box(..), RootNode(..))
+import Data.Text.ParagraphLayout (PageOptions(..))
+import Data.Text.Glyphize (Direction(..))
+
 import Graphics.Layout.Grid.CSS (parseASCIIGrid)
 import qualified Data.HashMap.Lazy as HM
 


@@ 303,6 315,102 @@ spec = do
             test [["head", "nav", "head"]]
             test [["head"], ["nav"], ["head"]]
             test [["head", "head"], ["head", "nav"]]
+    describe "<table>" $ do
+        it "parses to grids" $ do
+            -- <table>
+            --  <caption>Test table</caption>
+            --  <thead><tr><th>A</th><th rowspan="2">B</th><th>C</th></tr></thead>
+            --  <tbody><tr><td colspan="2">D</td><td colspan="2">E</td></tr></tbody>
+            --  <tfoot><tr><td>F</td><td>G</td><td>H</td></tr></tfoot>
+            -- </table>
+            let text' txt = StyleTree temp { inlineStyles = plaintext txt } []
+            let table :: StyleTree (CSSBox ())
+                table = StyleTree temp { display = Table } [
+                  StyleTree temp { display = TableHeaderGroup } [
+                      StyleTree temp { display = TableRow } [
+                          StyleTree temp { display = TableCell } [text' "A"],
+                          StyleTree temp {
+                              display = TableCell,
+                              tableOptions = temp { rowspan = 2 }
+                          } [text' "B"],
+                          StyleTree temp { display = TableCell } [text' "C"]
+                      ]
+                  ],
+                  StyleTree temp { display = TableRowGroup } [
+                      StyleTree temp { display = TableRow } [
+                          StyleTree temp {
+                              display = TableCell,
+                              tableOptions = temp { colspan = 2 }
+                          } [text' "D"],
+                          StyleTree temp {
+                              display = TableCell,
+                              tableOptions = temp { colspan = 2 }
+                          } [text' "E"]
+                      ]
+                  ],
+                  StyleTree temp { display = TableFooterGroup } [
+                      StyleTree temp { display = TableRow } [
+                          StyleTree temp { display = TableCell } [text' "F"],
+                          StyleTree temp { display = TableCell } [text' "G"],
+                          StyleTree temp { display = TableCell } [text' "H"]
+                      ]
+                  ],
+                  StyleTree temp { display = TableCaption } [text' "Test table"]
+                 ]
+            let defaultPageOptions = PageOptions 0 0 2 2
+            let gridItem x y = GridItem {
+                cellStart = x, cellEnd = y,
+                alignment = Start,
+                minSize = 0, natSize = 0
+              }
+            let track cells' = Track {
+                cells = cells',
+                trackMins = [], trackNats = [], gap = Pixels 0
+            }
+            let inline txt = LayoutInline () (constructParagraph "" (
+                        RootBox $ Box [
+                            TextSequence ((placeholderFont, 12), zero, ()) txt
+                        ] $ defaultTextOptions DirLTR
+                    ) "" defaultParagraphOptions) defaultPageOptions
+            finalizeCSS placeholderFont placeholderFont table `shouldBe`
+                    LayoutFlow () lengthBox [
+                        LayoutFlow () lengthBox [inline "Test table"],
+                        LayoutGrid () Size {
+                           inline = track [Left Auto, Left Auto, Left Auto, Left Auto, Left Auto, Left Auto],
+                           block = track [Left Auto, Left Auto, Left Auto]
+                        } [
+                            gridItem 0 6 `Size` gridItem 0 1,
+                            gridItem 0 6 `Size` gridItem 1 2,
+                            gridItem 0 6 `Size` gridItem 2 3,
+                            gridItem 0 6 `Size` gridItem 3 4,
+                            gridItem 0 6 `Size` gridItem 4 5,
+                            gridItem 0 6 `Size` gridItem 5 6,
+                            gridItem 1 2 `Size` gridItem 0 1,
+                            gridItem 3 4 `Size` gridItem 0 2,
+                            gridItem 5 6 `Size` gridItem 0 1,
+                            gridItem 1 3 `Size` gridItem 1 2,
+                            gridItem 4 6 `Size` gridItem 1 2,
+                            gridItem 1 2 `Size` gridItem 2 3,
+                            gridItem 3 4 `Size` gridItem 2 3,
+                            gridItem 5 6 `Size` gridItem 2 3
+                        ] [
+                            LayoutFlow () lengthBox [],
+                            LayoutFlow () lengthBox [],
+                            LayoutFlow () lengthBox [],
+                            LayoutFlow () lengthBox [],
+                            LayoutFlow () lengthBox [],
+                            LayoutFlow () lengthBox [],
+                            LayoutFlow () lengthBox [inline "A"],
+                            LayoutFlow () lengthBox [inline "B"],
+                            LayoutFlow () lengthBox [inline "C"],
+                            LayoutFlow () lengthBox [inline "D"],
+                            LayoutFlow () lengthBox [inline "E"],
+                            LayoutFlow () lengthBox [inline "F"],
+                            LayoutFlow () lengthBox [inline "G"],
+                            LayoutFlow () lengthBox [inline "H"]
+                        ]
+                    ]
+
 
 runMath = flip evalCalc [] . mapCalc fst . flip parseCalc [] . filter (/= Whitespace) . tokenize