9 files changed, 83 insertions(+), 18 deletions(-)

M Graphics/Layout.hs
M Graphics/Layout/Box.hs
M Graphics/Layout/CSS.hs
M Graphics/Layout/Grid.hs
M Graphics/Layout/Grid/CSS.hs
M Graphics/Layout/Grid/Table.hs
M Graphics/Layout/Inline.hs
M Graphics/Layout/Inline/CSS.hs
M cattrap.cabal

@@ 9,7 9,7 @@ module Graphics.Layout(LayoutItem(..), UserData,
         boxMinWidth, boxMaxWidth, boxNatWidth, boxWidth,
         boxNatHeight, boxMinHeight, boxMaxHeight, boxHeight,
         boxSplit, boxPaginate, boxPosition, boxLayout,
-        glyphs, codepoints, fragmentFont, {-, glyphsPerFont-}) where
+        glyphs, codepoints, fragmentFont, glyphsPerFont) where
 
 import Data.Text.ParagraphLayout.Rich (Paragraph(..), ParagraphOptions(..),
                                 ParagraphLayout(..), layoutRich)


@@ 66,7 66,7 @@ instance (Zero m, CastDouble m, NFData m, Zero n, CastDouble n, NFData n) =>
         NFData (LayoutItem m n x) where
     rnf = rnf . layoutGetBox -- Avoid auxiliary properties that don't cleanly `rnf`
 
---- | Retrieve the surrounding box for a layout item.
+-- | Retrieve the surrounding box for a layout item.
 layoutGetBox :: (Zero m, Zero n, CastDouble m, CastDouble n) =>
         LayoutItem m n x -> PaddedBox m n
 layoutGetBox (LayoutFlow _ ret _) = ret


@@ 101,6 101,7 @@ layoutGetInner (LayoutInline' ret _ _) = ret
 layoutGetInner (LayoutConst ret _ _) = ret
 layoutGetInner (LayoutSpan x) = treeInner x
 
+-- | Retrieve the font associated with inline layout.
 fragmentFont x = let (ret, _, _) = treeInner' x in ret
 
 -- | map-ready wrapper around `setCellBox` sourcing from a child node.

@@ 117,11 117,17 @@ maxWidth PaddedBox {..} = left margin + left border + left padding +
 maxHeight PaddedBox {..} = top margin + top border + top padding +
     block max + bottom padding + bottom border + bottom margin
 
+-- | Amount of whitespace to the left, summing margins, borders, & padding.
 leftSpace PaddedBox {..} = left margin + left border + left padding
+-- | Amount of whitespace to the right, summing margins, borders, & padding.
 rightSpace PaddedBox {..} = right margin + right border + right padding
+-- | Amount of whitespace to the top, summing margins, borders, & padding.
 topSpace PaddedBox {..} = top margin + top border + top padding
+-- | Amount of whitespace to the bottom, summing margins, borders, & padding.
 bottomSpace PaddedBox {..} = bottom margin + bottom border + bottom padding
+-- | Amount of whitespace along the x axis, summing margins, borders, & padding.
 hSpace self = leftSpace self + rightSpace self
+-- | Amount of whitespace along the y axis, summing margins, borders, & padding.
 vSpace self = topSpace self + bottomSpace self
 
 -- | A partially-computed length value.


@@ 148,6 154,7 @@ mapAuto x Preferred = Pixels x
 mapAuto x Min = Pixels x
 mapAuto _ x = x
 
+-- | Typeclass for zeroing out fields, so layout primitives can be more reusable.
 class Zero a where
     -- | Return the empty (or zero) value for a CatTrap geometric type.
     zero :: a


@@ 167,6 174,8 @@ instance (Zero m, Zero n) => Zero (PaddedBox m n) where
 instance (Zero m, Zero n) => Zero (Border m n) where
     zero = Border zero zero zero zero
 
+-- | Typeclass for converting between doubles & layout types, approximately if needs be.
+-- So layout primitives can be more reusable.
 class CastDouble a where
     -- | Convert a double to a double or length.
     fromDouble :: Double -> a

@@ 28,6 28,7 @@ import Data.Maybe (fromMaybe)
 instance (PropertyParser x, Zero m, Zero n) => Default (UserData m n x) where
     def = ((placeholderFont, 0), zero, temp)
 
+-- | Resolves length units in properties handled by downstream components.
 inner' :: PropertyParser x => Font' -> CSSBox x -> x
 inner' f self = foldr apply (inner self) $ innerProperties self
   where apply (k, v) ret = fromMaybe ret $


@@ 74,6 75,7 @@ finalizeCSS root parent self@StyleTree {
         (finalizeChilds root font_ self' childs)
   where
     font_ = pattern2font (font self') (font' self') parent root
+-- | Desugars parsed CSS with a provided system font into more generic layout parameters.
 finalizeCSS' sysfont self@StyleTree { style = self' } =
     finalizeCSS (pattern2font (font self') (font' self') sysfont sysfont) sysfont self
 


@@ 274,6 276,7 @@ finalizeTable root parent val opts childs = LayoutGrid val grid cells' childs'
     isRowGroup (StyleTree CSSBox { display = TableColumnGroup } _) = True
     isRowGroup _ = False
 
+-- | Applies border-collapse to a table element.
 collapseTBorders' :: CSSBox x -> CSSBox x
 collapseTBorders' self = self {
     cssBox = collapseTBorders (tableOptions self) (cssBox self)

@@ 152,7 152,7 @@ trackPosition self childs = map gridCellPosition childs
     align _ Start = 0
     align excess Mid = excess/2
     align excess End = excess
--- Compute the maximum size along an axis of a child, for it to be sized to.
+-- | Compute the maximum size along an axis of a child, for it to be sized to.
 cellSize :: CastDouble x => Track x -> GridItem' -> Double
 cellSize self child = track (cellEnd child) - track (cellStart child)
   where

@@ 18,6 18,7 @@ import Graphics.Layout.Box
 import Graphics.Layout.Grid
 import Graphics.Layout
 
+-- | Mapping from area identifiers to bounding boxes.
 type Areas = HM.HashMap Text ((Int, Int), (Int, Maybe Int))
 
 -- | Converts a grid to lookup table start & indices for row & columns.

@@ 1,4 1,6 @@
 {-# LANGUAGE OverloadedStrings, ViewPatterns #-}
+-- | Datastructures for parsing table styling properties,
+-- & for positioning cells into Grid layout regions.
 module Graphics.Layout.Grid.Table where
 
 import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))


@@ 13,22 15,36 @@ import Data.Text.ParagraphLayout.Rich (
 import Text.Read (readMaybe)
 import Data.Text (unpack)
 
+-- | Tracks `rowspan` attributes so later rows can dodge it.
 type Overflowed = [Int]
 
+-- | A row with no cells overflowing into it.
 emptyRow :: Overflowed
 emptyRow = []
 
+-- | Decrement all `rowspan`s being overflowed, removing 0'd ones.
 commitRow :: Overflowed -> Overflowed
 commitRow = map $ Prelude.max 0 . pred
 
+-- | Find the next column which a previous multi-row cell hasn't called "dibs" on.
 allocCol :: Int -> Overflowed -> Int
 allocCol ix cols = ix + length (span (> 0) $ drop ix cols)
 
+-- | Splice a newly-allocated cell covernig `colspan` (2nd arg) & `rowspan` (3rd arg)
+-- from "ix" (from 1st arg) into the final arg.
 insertCell :: Int -> Int -> Int -> Overflowed -> Overflowed
-insertCell ix colspan rowspan cols =
-    before ++ replicate colspan rowspan ++ drop colspan after
-  where (before, after) = splitAt ix cols
-
+insertCell ix colspan rowspan cols = before ++ inner colspan after
+  where
+    (before, after) = splitAt ix cols
+    inner x cols' | x <= 0 = cols'
+    inner colspan (col:cols') = Prelude.max col rowspan:inner (pred colspan) cols'
+    inner x [] = replicate x colspan
+
+-- | Parsed CSS properties & HTML attributes for laying out "table" elements.
+-- To parse HTML attributes, expects the following useragent stylesheet rules:
+--
+-- [rowspan] { -argo-rowspan: attr(rowspan) }
+-- [colspan] { -argo-colspan: attr(colspan) }
 data TableOptions = TableOptions {
     -- | HTML rowspan attribute
     rowspan :: Int,


@@ 96,31 112,41 @@ instance PropertyParser TableOptions where
 
     longhand _ _ _ _ = Nothing
 
+-- | Resolve any units in the "border-spacing" property according to the given font.
+-- If "border-collapse" is set, removes this spacing.
 finalizeGap :: TableOptions -> Font' -> (Length, Length)
 finalizeGap TableOptions { borderCollapse = True } _ = (Pixels 0, Pixels 0)
 finalizeGap TableOptions { borderHSpacing = x, borderVSpacing = y } font =
     (finalizeLength x font, finalizeLength y font)
 
+-- | Shorthand for a padded box without its CSS units resolved, simplifies type signatures.
 type UPaddedBox = PaddedBox Unitted Unitted
+-- | Removes margins & halves borders if "border-collapse" is set,
+-- as per the CSS specification. Apply this on the table cells, rows, & columns.
 collapseBorders :: TableOptions -> UPaddedBox -> UPaddedBox
 collapseBorders TableOptions { borderCollapse = False } ret = ret
 collapseBorders _ box = box {
     margin = zero,
     border = mapX half $ mapY half $ border box
   }
+-- | Removes padding & halves borders if "border-collapse" is set,
+-- as per the CSS specification. Apply this on the table itself.
 collapseTBorders :: TableOptions -> UPaddedBox -> UPaddedBox
 collapseTBorders TableOptions { borderCollapse = False } ret = ret
 collapseTBorders _ box = box {
     padding = zero,
     border = mapX half $ mapY half $ border box
   }
+-- | Helper for halving a unit.
 half (x,u) = (x/2,u)
 
+-- | Lower vertical alignment to grid alignment options.
 finalizeVAlign :: TableOptions -> Alignment
 finalizeVAlign TableOptions { verticalAlign = (_,"top") } = Start
 finalizeVAlign TableOptions { verticalAlign = (_,"middle") } = Mid
 finalizeVAlign TableOptions { verticalAlign = (_,"bottom") } = End
 finalizeVAlign _ = Start -- FIXME: Support baseline alignment!
+-- | Lower text alignment to grid alignment.
 finalizeHAlign :: ParagraphOptions -> Direction -> Alignment
 finalizeHAlign (paragraphAlignment -> AlignStart) _ = Start
 finalizeHAlign (paragraphAlignment -> AlignEnd) _ = End

@@ 77,6 77,7 @@ lowerSpacing (Paragraph a b (RootBox c) d) = Paragraph a b (RootBox $ inner c) d
     inner' self@(TextSequence _ _) = self
 
 
+-- | A tree extracted from Balkón's inline layout.
 data FragmentTree x = Branch (AncestorBox x) [FragmentTree x]
     | Leaf (Fragment x)
     deriving (Show, Eq)


@@ 155,11 156,13 @@ fragmentPos :: (Double, Double) -> Fragment a -> (Double, Double)
 fragmentPos (x, y) self = (x + hbScale (x_min r), y + hbScale (y_min r))
     where r = fragmentRect self
 
+-- | Extract the tree datastructure out of Balkón's ParagraphLayout
 reconstructTree :: Eq x => ParagraphLayout x -> [FragmentTree x]
 reconstructTree ParagraphLayout { paragraphFragments = frags } =
     reconstructTree' [frag {
             fragmentAncestorBoxes = reverse $ fragmentAncestorBoxes frag
         } | frag <- frags]
+-- | Extract the tree datastructure out of Balkón's fragments.
 reconstructTree' :: Eq x => [Fragment x] -> [FragmentTree x]
 reconstructTree' (self@Fragment { fragmentAncestorBoxes = [] }:frags) =
     Leaf self:reconstructTree' frags


@@ 178,12 181,12 @@ reconstructTree' frags@(Fragment {
     sameBranch Fragment { fragmentAncestorBoxes = [] } = False
 reconstructTree' [] = []
 
+-- | Add an X,Y offset to all positions, annotating the userdata.
 positionTree :: (CastDouble m, CastDouble n) => (Double, Double) ->
         FragmentTree (a, PaddedBox m n, c) ->
         FragmentTree (a, PaddedBox m n, ((Double, Double), c))
 positionTree (x, y) self@(Branch (AncestorBox (a, b, c) d e f g) childs) =
-    Branch (AncestorBox (a, b, (pos, c)) d e f g) $
-        map (positionTree pos) childs
+    Branch (AncestorBox (a, b, (pos, c)) d e f g) $ map (positionTree pos) childs
   where
     pos = (x + hbScale (x_min rect), y + hbScale (y_min rect))
     rect = treeRect self


@@ 192,16 195,20 @@ positionTree (x, y) self@(Leaf (Fragment (a, b, c) d _ f g h i)) =
   where
     pos = (x + hbScale (x_min rect), y + hbScale (y_min rect))
     rect = treeRect self
+-- | Retrieve 3rd userdata field.
 treeInner :: FragmentTree (a, b, c) -> c
 treeInner (Branch AncestorBox { boxUserData = (_, _, ret) } _) = ret
 treeInner (Leaf Fragment { fragmentUserData = (_, _, ret) }) = ret
+-- | Retrieve userdata field.
 treeInner' :: FragmentTree a -> a
 treeInner' (Branch self _) = boxUserData self
 treeInner' (Leaf self) = fragmentUserData self
 
+-- | Retrieve Harfbuzz data out of the tree extracted from Balkón.
 glyphs :: FragmentTree x -> [(HB.GlyphInfo, HB.GlyphPos)]
 glyphs (Branch _ _) = []
 glyphs (Leaf self) = fragmentGlyphs self
+-- | Retrieve the Unicode codepoints out of the tree extracted from Balkón.
 codepoints :: FragmentTree x -> [Word32]
 codepoints self = map HB.codepoint $ map fst $ glyphs self
 

@@ 71,6 71,7 @@ instance PropertyParser CSSInline where
         Just $ CSSInline txt opts BdPlainText
     longhand _ _ _ _ = Nothing
 
+-- | Fills in properties from looked-up fonts.
 applyFontInline :: TextOptions -> Font' -> TextOptions
 applyFontInline opts font = opts {
     textFont = hbFont font,


@@ 100,6 101,7 @@ applyBidi (CSSInline _ _ BdPlainText) txt =
 applyBidi (CSSInline _ (textDirection -> dir) _) txt =
     trace ("Unexpected direction! " ++ show dir) txt
 
+-- | Append a single character to the end of a string.
 a +: b = a ++ [b]
 
 chLREmbed, chRLEmbed, chLROverride, chRLOverride, chPopDir,


@@ 115,11 117,15 @@ chRLIsolate = leaf '\x2067'
 ch1stStrongIsolate = leaf '\x2068'
 chPopDirIsolate = leaf '\x2069'
 
+-- | A Balkón fragment holding a magic character.
 leaf ch = TextSequence def $ Txt.singleton ch
 
+-- | Types with default values.
+-- Used to fill in values into generated fragments from caller.
 class Default a where
     def :: a
 
+-- | Converts parsed valign keywords or length units to Balkón alignment.
 resolveVAlign :: Font' -> Unitted -> VerticalAlignment
 resolveVAlign _ (_,"top") = AlignLineTop
 resolveVAlign _ (_,"super") = AlignLineTop -- FIXME: Is there a better translation?


@@ 132,9 138,11 @@ resolveVAlign f (_,"middle") = AlignBaseline $ toHB $ fontHeight f 'x' / 2
 resolveVAlign f x | Pixels y <- finalizeLength x f = AlignBaseline $ toHB y
     | Percent y <- finalizeLength x f = AlignBaseline $ toHB $ y * lineheight f
     | otherwise = trace ("Invalid length! " ++ show x) $ AlignBaseline 0
+-- | Converts grid options to box options.
 resolveBoxOpts f grid = defaultBoxOptions {
     boxVerticalAlignment = resolveVAlign f $ verticalAlign grid
   }
 
+-- | Convert from CatTrap units to Balkón|Harfbuzz units.
 toHB :: Double -> Int32
 toHB = toEnum . fromEnum . (*) hbUnit

@@ 2,7 2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                cattrap
-version:             0.3.0.0
+version:             0.4.0.0
 synopsis:            Lays out boxes according to the CSS Box Model.
 description:         Computes where to place e.g. images, paragraphs, containers, tables, etc onscreen given desired amounts of whitespace.
 homepage:            https://argonaut-constellation.org/


@@ 30,12 30,13 @@ library
                         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,
+  build-depends:       base >=4.12 && <5, containers >= 0.6 && < 1, parallel >= 3 && <4,
+                        css-syntax >= 0.1 && < 0.2, scientific >= 0.3 && < 1, text >= 2.0.2,
+                        deepseq >= 1.4 && <2, 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, data-array-byte
+                        harfbuzz-pure >= 1.0.3.2 && < 1.1, bytestring >= 0.11 && <1,
+                        balkon >= 1.2 && <2, unordered-containers >= 0.2 && <1,
+                        data-array-byte >= 0.1 && < 0.2
   -- hs-source-dirs:
   default-language:    Haskell2010
   ghc-options:         -Wincomplete-patterns


@@ 44,7 45,8 @@ executable cattrap
   main-is:             Main.hs
   -- other-modules:
   -- other-extensions:
-  build-depends:       base >=4.12 && <5, cattrap, text, css-syntax, xml, stylist-traits, sdl2 >= 2.5.4
+  build-depends:       base >=4.12 && <5, cattrap, text, css-syntax, xml >= 1.3 && < 2,
+                        stylist-traits, sdl2 >= 2.5.4
   hs-source-dirs:      app
   default-language:    Haskell2010
 


@@ 52,7 54,12 @@ executable cattrap-argonaut
   main-is:             Integration.hs
   -- other-modules:
   -- other-extensions:
-  build-depends:       base >=4.12 && <5, cattrap, text>=2.0.2, css-syntax, stylist-traits, stylist>=2.7.0.1, hurl-xml, hurl, sdl2 >= 2.5.4, containers, network-uri, xml-conduit, directory, xml-conduit-stylist, bytestring, file-embed, deepseq, fontconfig-pure
+  build-depends:       base >=4.12 && <5, cattrap, text>=2.0.2, css-syntax,
+                        stylist-traits , stylist>=2.7.0.1 && <3,
+                        hurl-xml >= 0.2 && < 1, hurl >= 2.3 && < 3,
+                        sdl2 >= 2.5.4 && < 2.6, containers, network-uri >=2.6 && <3,
+                        xml-conduit >= 1.8 && < 2, directory >= 1.3 && < 2, xml-conduit-stylist,
+                        bytestring, file-embed >= 0.0.15 && < 0.1, deepseq, fontconfig-pure
   hs-source-dirs:      app
   default-language:    Haskell2010
   ghc-options:	-threaded


@@ 61,7 68,10 @@ executable cattrap-stylist
   main-is:             Integration2.hs
   -- other-modules:
   -- other-extensions:
-  build-depends:       base >=4.12 && <5, cattrap, text>=2.0.2, css-syntax, stylist-traits, stylist>=2.7.0.1, network-uri, html-conduit, xml-conduit, xml-conduit-stylist, deepseq, fontconfig-pure
+  build-depends:       base >=4.12 && <5, cattrap, text>=2.0.2 && <3, css-syntax,
+                        stylist-traits, stylist>=2.7.0.1 && <3, network-uri,
+                        html-conduit >=1.3 && <2, xml-conduit >= 1.8 && < 2,
+                        xml-conduit-stylist >= 3 && < 4, deepseq, fontconfig-pure
   hs-source-dirs:      app
   default-language:    Haskell2010