{-# LANGUAGE OverloadedStrings #-}
-- These following language extensions are to aid a dependency injection into
-- inline styling.
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}
-- | Parses & desugars CSS properties to general CatTrap datastructures.
module Graphics.Layout.CSS(CSSBox(..), BoxSizing(..), Display(..),
        finalizeCSS, finalizeCSS') where

import qualified Data.Text as Txt
import Stylist (PropertyParser(..))
import Stylist.Tree (StyleTree(..))
import Data.Text.ParagraphLayout.Rich (constructParagraph, defaultBoxOptions,
        LineHeight(..), InnerNode(..), Box(..), RootNode(..))

import Graphics.Layout.Box as B
import Graphics.Layout
import Graphics.Layout.CSS.Length
import Graphics.Layout.CSS.Font
import Graphics.Layout.Grid.CSS
import Graphics.Layout.Grid
import Graphics.Layout.Grid.Table
import Graphics.Layout.Inline.CSS

import Data.Char (isSpace)
import Graphics.Layout.CSS.Parse
import Data.Maybe (fromMaybe)

instance (PropertyParser x, Zero m, Zero n) => Default (UserData m n x) where
    def :: UserData m n x
def = ((Font'
placeholderFont, Int
0), forall a. Zero a => a
zero, forall a. PropertyParser a => a
temp)

inner' :: PropertyParser x => Font' -> CSSBox x -> x
inner' :: forall x. PropertyParser x => Font' -> CSSBox x -> x
inner' Font'
f CSSBox x
self = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Text, [Token]) -> x -> x
apply (forall a. CSSBox a -> a
inner CSSBox x
self) forall a b. (a -> b) -> a -> b
$ forall a. CSSBox a -> [(Text, [Token])]
innerProperties CSSBox x
self
  where apply :: (Text, [Token]) -> x -> x
apply (Text
k, [Token]
v) x
ret = forall a. a -> Maybe a -> a
fromMaybe x
ret forall a b. (a -> b) -> a -> b
$
            forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (forall a. CSSBox a -> a
innerParent CSSBox x
self) x
ret Text
k forall a b. (a -> b) -> a -> b
$ Font' -> [Token] -> [Token]
finalizeLengths Font'
f [Token]
v

-- | Desugar parsed CSS into more generic layout parameters.
finalizeCSS :: PropertyParser x => Font' -> Font' -> StyleTree (CSSBox x) ->
        LayoutItem Length Length x
finalizeCSS :: forall x.
PropertyParser x =>
Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS Font'
root Font'
parent StyleTree { style :: forall p. StyleTree p -> p
style = self' :: CSSBox x
self'@CSSBox { display :: forall a. CSSBox a -> Display
display = Display
None } } =
    forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow (forall x. PropertyParser x => Font' -> CSSBox x -> x
inner' Font'
parent CSSBox x
self') PaddedBox Length Length
lengthBox []
finalizeCSS Font'
root Font'
parent self :: StyleTree (CSSBox x)
self@StyleTree {
    style :: forall p. StyleTree p -> p
style = self' :: CSSBox x
self'@CSSBox { display :: forall a. CSSBox a -> Display
display = Display
Grid }, children :: forall p. StyleTree p -> [StyleTree p]
children = [StyleTree (CSSBox x)]
childs
  } = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow (forall x. PropertyParser x => Font' -> CSSBox x -> x
inner' Font'
font_ CSSBox x
self') (forall {a}. CSSBox a -> Font' -> PaddedBox Length Length
finalizeBox CSSBox x
self' Font'
font_) [
        forall x.
PropertyParser x =>
CSSGrid
-> Font'
-> [CSSCell]
-> [LayoutItem Length Length x]
-> LayoutItem Length Length x
finalizeGrid (forall a. CSSBox a -> CSSGrid
gridStyles CSSBox x
self') Font'
font_ (forall a b. (a -> b) -> [a] -> [b]
map forall a. CSSBox a -> CSSCell
cellStyles forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall p. StyleTree p -> p
style [StyleTree (CSSBox x)]
childs)
            (forall x.
PropertyParser x =>
Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds Font'
root Font'
font_ CSSBox x
self' [StyleTree (CSSBox x)]
childs)]
  where
    font_ :: Font'
font_ = Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font (forall a. CSSBox a -> Pattern
font CSSBox x
self') (forall a. CSSBox a -> CSSFont
font' CSSBox x
self') Font'
parent Font'
root
finalizeCSS Font'
root Font'
parent self :: StyleTree (CSSBox x)
self@StyleTree {
        style :: forall p. StyleTree p -> p
style = self' :: CSSBox x
self'@CSSBox {
            display :: forall a. CSSBox a -> Display
display = Display
Table, tableOptions :: forall a. CSSBox a -> TableOptions
tableOptions = opts :: TableOptions
opts@TableOptions {captionBelow :: TableOptions -> Bool
captionBelow=Bool
False}
        },
        children :: forall p. StyleTree p -> [StyleTree p]
children = [StyleTree (CSSBox x)]
childs
    } = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow (forall x. PropertyParser x => Font' -> CSSBox x -> x
inner' Font'
font_ CSSBox x
self')
        (forall {a}. CSSBox a -> Font' -> PaddedBox Length Length
finalizeBox (forall x. CSSBox x -> CSSBox x
collapseTBorders' CSSBox x
self') Font'
font_)
        ([forall x.
PropertyParser x =>
Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS Font'
root Font'
font_ StyleTree (CSSBox x)
child { style :: CSSBox x
style = CSSBox x
child' { display :: Display
display = Display
Block } }
            | child :: StyleTree (CSSBox x)
child@StyleTree { style :: forall p. StyleTree p -> p
style = child' :: CSSBox x
child'@CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableCaption } } <- [StyleTree (CSSBox x)]
childs] forall a. [a] -> [a] -> [a]
++
        [forall {x}.
PropertyParser x =>
Font'
-> Font'
-> x
-> TableOptions
-> [StyleTree (CSSBox x)]
-> LayoutItem Length Length x
finalizeTable Font'
root Font'
font_ (forall a. CSSBox a -> a
inner CSSBox x
self') TableOptions
opts [StyleTree (CSSBox x)]
childs])
  where
    font_ :: Font'
font_ = Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font (forall a. CSSBox a -> Pattern
font CSSBox x
self') (forall a. CSSBox a -> CSSFont
font' CSSBox x
self') Font'
parent Font'
root
finalizeCSS Font'
root Font'
parent self :: StyleTree (CSSBox x)
self@StyleTree {
        style :: forall p. StyleTree p -> p
style = self' :: CSSBox x
self'@CSSBox {
            display :: forall a. CSSBox a -> Display
display = Display
Table, tableOptions :: forall a. CSSBox a -> TableOptions
tableOptions = opts :: TableOptions
opts@TableOptions {captionBelow :: TableOptions -> Bool
captionBelow=Bool
True}
        }, children :: forall p. StyleTree p -> [StyleTree p]
children = [StyleTree (CSSBox x)]
childs
    } = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow (forall x. PropertyParser x => Font' -> CSSBox x -> x
inner' Font'
font_ CSSBox x
self')
        (forall {a}. CSSBox a -> Font' -> PaddedBox Length Length
finalizeBox (forall x. CSSBox x -> CSSBox x
collapseTBorders' CSSBox x
self') Font'
font_)
        (forall {x}.
PropertyParser x =>
Font'
-> Font'
-> x
-> TableOptions
-> [StyleTree (CSSBox x)]
-> LayoutItem Length Length x
finalizeTable Font'
root Font'
font_ forall a. PropertyParser a => a
temp TableOptions
opts [StyleTree (CSSBox x)]
childsforall a. a -> [a] -> [a]
:
        [forall x.
PropertyParser x =>
Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS Font'
root Font'
font_ StyleTree (CSSBox x)
child { style :: CSSBox x
style = CSSBox x
child' { display :: Display
display = Display
Block } }
            | child :: StyleTree (CSSBox x)
child@StyleTree { style :: forall p. StyleTree p -> p
style = child' :: CSSBox x
child'@CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableCaption } } <- [StyleTree (CSSBox x)]
childs])
  where
    font_ :: Font'
font_ = Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font (forall a. CSSBox a -> Pattern
font CSSBox x
self') (forall a. CSSBox a -> CSSFont
font' CSSBox x
self') Font'
parent Font'
root
finalizeCSS Font'
root Font'
parent self :: StyleTree (CSSBox x)
self@StyleTree {
    style :: forall p. StyleTree p -> p
style = CSSBox x
self', children :: forall p. StyleTree p -> [StyleTree p]
children = [StyleTree (CSSBox x)]
childs
  } = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow (forall x. PropertyParser x => Font' -> CSSBox x -> x
inner' Font'
font_ CSSBox x
self') (forall {a}. CSSBox a -> Font' -> PaddedBox Length Length
finalizeBox CSSBox x
self' Font'
font_)
        (forall x.
PropertyParser x =>
Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds Font'
root Font'
font_ CSSBox x
self' [StyleTree (CSSBox x)]
childs)
  where
    font_ :: Font'
font_ = Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font (forall a. CSSBox a -> Pattern
font CSSBox x
self') (forall a. CSSBox a -> CSSFont
font' CSSBox x
self') Font'
parent Font'
root
finalizeCSS' :: Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS' Font'
sysfont self :: StyleTree (CSSBox x)
self@StyleTree { style :: forall p. StyleTree p -> p
style = CSSBox x
self' } =
    forall x.
PropertyParser x =>
Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS (Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font (forall a. CSSBox a -> Pattern
font CSSBox x
self') (forall a. CSSBox a -> CSSFont
font' CSSBox x
self') Font'
sysfont Font'
sysfont) Font'
sysfont StyleTree (CSSBox x)
self

-- | Desugar a sequence of child nodes, taking care to capture runs of inlines.
finalizeChilds :: PropertyParser x => Font' -> Font' -> CSSBox x ->
        [StyleTree (CSSBox x)] -> [LayoutItem Length Length x]
finalizeChilds :: forall x.
PropertyParser x =>
Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds Font'
root Font'
parent CSSBox x
style' (StyleTree { style :: forall p. StyleTree p -> p
style = CSSBox { display :: forall a. CSSBox a -> Display
display = Display
None } }:[StyleTree (CSSBox x)]
childs) =
    forall x.
PropertyParser x =>
Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds Font'
root Font'
parent CSSBox x
style' [StyleTree (CSSBox x)]
childs
finalizeChilds Font'
root Font'
parent CSSBox x
style' childs :: [StyleTree (CSSBox x)]
childs@(StyleTree (CSSBox x)
child:[StyleTree (CSSBox x)]
_)
    | forall {a}. [StyleTree (CSSBox a)] -> Bool
isInlineTree [StyleTree (CSSBox x)]
childs, Just Paragraph ((Font', Int), PaddedBox Length Length, x)
self <- forall {d}. RootNode Text d -> Maybe (Paragraph d)
finalizeParagraph (forall {a}.
(Default ((Font', Int), PaddedBox Length Length, a),
 PropertyParser a) =>
[StyleTree (CSSBox a)]
-> RootNode Text ((Font', Int), PaddedBox Length Length, a)
flattenTree0 [StyleTree (CSSBox x)]
childs) =
        [forall m n x.
x -> Paragraph (UserData m n x) -> PageOptions -> LayoutItem m n x
LayoutInline (forall a. PropertyParser a => a -> a
inherit forall a b. (a -> b) -> a -> b
$ forall x. PropertyParser x => Font' -> CSSBox x -> x
inner' Font'
parent CSSBox x
style') Paragraph ((Font', Int), PaddedBox Length Length, x)
self PageOptions
paging]
    | (inlines :: [StyleTree (CSSBox x)]
inlines@(StyleTree (CSSBox x)
_:[StyleTree (CSSBox x)]
_), [StyleTree (CSSBox x)]
blocks) <- forall {a}.
[StyleTree (CSSBox a)]
-> ([StyleTree (CSSBox a)], [StyleTree (CSSBox a)])
spanInlines [StyleTree (CSSBox x)]
childs,
        Just Paragraph ((Font', Int), PaddedBox Length Length, x)
self <- forall {d}. RootNode Text d -> Maybe (Paragraph d)
finalizeParagraph (forall {a}.
(Default ((Font', Int), PaddedBox Length Length, a),
 PropertyParser a) =>
[StyleTree (CSSBox a)]
-> RootNode Text ((Font', Int), PaddedBox Length Length, a)
flattenTree0 [StyleTree (CSSBox x)]
inlines) =
            forall m n x.
x -> Paragraph (UserData m n x) -> PageOptions -> LayoutItem m n x
LayoutInline (forall a. PropertyParser a => a -> a
inherit forall a b. (a -> b) -> a -> b
$ forall x. PropertyParser x => Font' -> CSSBox x -> x
inner' Font'
parent CSSBox x
style') Paragraph ((Font', Int), PaddedBox Length Length, x)
self PageOptions
paging forall a. a -> [a] -> [a]
:
                forall x.
PropertyParser x =>
Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds Font'
root Font'
parent CSSBox x
style' [StyleTree (CSSBox x)]
blocks
    | (StyleTree { style :: forall p. StyleTree p -> p
style = CSSBox { display :: forall a. CSSBox a -> Display
display = Display
Inline } }:[StyleTree (CSSBox x)]
childs') <- [StyleTree (CSSBox x)]
childs =
        forall x.
PropertyParser x =>
Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds Font'
root Font'
parent CSSBox x
style' [StyleTree (CSSBox x)]
childs' -- Inline's all whitespace...
  where
    paging :: PageOptions
paging = forall a. CSSBox a -> PageOptions
pageOptions forall a b. (a -> b) -> a -> b
$ forall p. StyleTree p -> p
style StyleTree (CSSBox x)
child
    isInlineTree :: [StyleTree (CSSBox a)] -> Bool
isInlineTree = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all StyleTree (CSSBox a) -> Bool
isInlineTree0
    isInlineTree0 :: StyleTree (CSSBox a) -> Bool
isInlineTree0 StyleTree { style :: forall p. StyleTree p -> p
style = CSSBox { display :: forall a. CSSBox a -> Display
display = Display
Inline }, children :: forall p. StyleTree p -> [StyleTree p]
children = [StyleTree (CSSBox a)]
childs } =
        [StyleTree (CSSBox a)] -> Bool
isInlineTree [StyleTree (CSSBox a)]
childs
    isInlineTree0 StyleTree (CSSBox a)
_ = Bool
False
    spanInlines :: [StyleTree (CSSBox a)]
-> ([StyleTree (CSSBox a)], [StyleTree (CSSBox a)])
spanInlines [StyleTree (CSSBox a)]
childs = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span forall {a}. StyleTree (CSSBox a) -> Bool
isInlineTree0 [StyleTree (CSSBox a)]
childs of
        ([StyleTree (CSSBox a)]
inlines, (StyleTree {
            style :: forall p. StyleTree p -> p
style = CSSBox { display :: forall a. CSSBox a -> Display
display = Display
Inline }, children :: forall p. StyleTree p -> [StyleTree p]
children = [StyleTree (CSSBox a)]
tail
          }:[StyleTree (CSSBox a)]
blocks)) -> let ([StyleTree (CSSBox a)]
inlines', [StyleTree (CSSBox a)]
blocks') = [StyleTree (CSSBox a)]
-> ([StyleTree (CSSBox a)], [StyleTree (CSSBox a)])
spanInlines [StyleTree (CSSBox a)]
tail
            in ([StyleTree (CSSBox a)]
inlines forall a. [a] -> [a] -> [a]
++ [StyleTree (CSSBox a)]
inlines', [StyleTree (CSSBox a)]
blocks' forall a. [a] -> [a] -> [a]
++ [StyleTree (CSSBox a)]
blocks)
        ([StyleTree (CSSBox a)], [StyleTree (CSSBox a)])
ret -> ([StyleTree (CSSBox a)], [StyleTree (CSSBox a)])
ret
    flattenTree0 :: [StyleTree (CSSBox a)]
-> RootNode Text ((Font', Int), PaddedBox Length Length, a)
flattenTree0 [StyleTree (CSSBox a)]
childs
        | iStyle :: CSSInline
iStyle@(CSSInline Text
_ TextOptions
_ UnicodeBidi
bidi) <- forall a. CSSBox a -> CSSInline
inlineStyles CSSBox x
style',
            UnicodeBidi
bidi forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UnicodeBidi
BdOverride, UnicodeBidi
BdIsolateOverride] = forall t d. Box t d -> RootNode t d
RootBox forall a b. (a -> b) -> a -> b
$ forall t d. [InnerNode t d] -> TextOptions -> Box t d
Box
                (forall d.
Default d =>
CSSInline -> [InnerNode Text d] -> [InnerNode Text d]
applyBidi CSSInline
iStyle forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {a}.
(PropertyParser a,
 Default ((Font', Int), PaddedBox Length Length, a)) =>
Font'
-> (Int, StyleTree (CSSBox a))
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
flattenTree Font'
parent) forall a b. (a -> b) -> a -> b
$ forall {b}. [b] -> [(Int, b)]
enumerate [StyleTree (CSSBox a)]
childs)
                forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip TextOptions -> Font' -> TextOptions
applyFontInline Font'
parent forall a b. (a -> b) -> a -> b
$ forall {a}. CSSBox a -> TextOptions
txtOpts CSSBox x
style'
        | Bool
otherwise = forall t d. Box t d -> RootNode t d
RootBox forall a b. (a -> b) -> a -> b
$ forall t d. [InnerNode t d] -> TextOptions -> Box t d
Box (forall a b. (a -> b) -> [a] -> [b]
map (forall {a}.
(PropertyParser a,
 Default ((Font', Int), PaddedBox Length Length, a)) =>
Font'
-> (Int, StyleTree (CSSBox a))
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
flattenTree Font'
parent) forall a b. (a -> b) -> a -> b
$ forall {b}. [b] -> [(Int, b)]
enumerate [StyleTree (CSSBox a)]
childs)
            forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip TextOptions -> Font' -> TextOptions
applyFontInline Font'
parent forall a b. (a -> b) -> a -> b
$ forall {a}. CSSBox a -> TextOptions
txtOpts CSSBox x
style'
    flattenTree :: Font'
-> (Int, StyleTree (CSSBox a))
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
flattenTree Font'
p (Int
i, StyleTree CSSBox a
self child :: [StyleTree (CSSBox a)]
child@(StyleTree (CSSBox a)
_:[StyleTree (CSSBox a)]
_)) =
        forall {a} {b}.
(PropertyParser a,
 Default ((Font', b), PaddedBox Length Length, a)) =>
Font'
-> b
-> CSSBox a
-> [InnerNode Text ((Font', b), PaddedBox Length Length, a)]
-> InnerNode Text ((Font', b), PaddedBox Length Length, a)
buildInline Font'
f Int
i CSSBox a
self forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Font'
-> (Int, StyleTree (CSSBox a))
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
flattenTree Font'
f) forall a b. (a -> b) -> a -> b
$ forall {b}. [b] -> [(Int, b)]
enumerate [StyleTree (CSSBox a)]
child
      where f :: Font'
f = Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font (forall a. CSSBox a -> Pattern
font CSSBox a
self) (forall a. CSSBox a -> CSSFont
font' CSSBox a
self) Font'
p Font'
root
    flattenTree Font'
f (Int
i,StyleTree {style :: forall p. StyleTree p -> p
style=self :: CSSBox a
self@CSSBox {inlineStyles :: forall a. CSSBox a -> CSSInline
inlineStyles=CSSInline Text
txt TextOptions
_ UnicodeBidi
_}})
        = forall {a} {b}.
(PropertyParser a,
 Default ((Font', b), PaddedBox Length Length, a)) =>
Font'
-> b
-> CSSBox a
-> [InnerNode Text ((Font', b), PaddedBox Length Length, a)]
-> InnerNode Text ((Font', b), PaddedBox Length Length, a)
buildInline Font'
f Int
i CSSBox a
self [
            forall t d. d -> t -> InnerNode t d
TextSequence ((Font'
f, Int
0), forall a. Zero a => a
zero, forall a. PropertyParser a => a -> a
inherit forall a b. (a -> b) -> a -> b
$ forall x. PropertyParser x => Font' -> CSSBox x -> x
inner' Font'
parent CSSBox a
self) Text
txt]
    buildInline :: Font'
-> b
-> CSSBox a
-> [InnerNode Text ((Font', b), PaddedBox Length Length, a)]
-> InnerNode Text ((Font', b), PaddedBox Length Length, a)
buildInline Font'
f b
i CSSBox a
self [InnerNode Text ((Font', b), PaddedBox Length Length, a)]
childs =
        forall t d. d -> Box t d -> BoxOptions -> InnerNode t d
InlineBox ((Font'
f, b
i), forall {a}. CSSBox a -> Font' -> PaddedBox Length Length
finalizeBox CSSBox a
self Font'
f, forall x. PropertyParser x => Font' -> CSSBox x -> x
inner' Font'
parent CSSBox a
self)
                (forall t d. [InnerNode t d] -> TextOptions -> Box t d
Box [InnerNode Text ((Font', b), PaddedBox Length Length, a)]
childs' forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip TextOptions -> Font' -> TextOptions
applyFontInline Font'
f forall a b. (a -> b) -> a -> b
$ forall {a}. CSSBox a -> TextOptions
txtOpts CSSBox a
self)
                forall a b. (a -> b) -> a -> b
$ Font' -> TableOptions -> BoxOptions
resolveBoxOpts Font'
f (forall a. CSSBox a -> TableOptions
tableOptions CSSBox a
self)
      where childs' :: [InnerNode Text ((Font', b), PaddedBox Length Length, a)]
childs' = forall d.
Default d =>
CSSInline -> [InnerNode Text d] -> [InnerNode Text d]
applyBidi (forall a. CSSBox a -> CSSInline
inlineStyles CSSBox a
self) [InnerNode Text ((Font', b), PaddedBox Length Length, a)]
childs
    finalizeParagraph :: RootNode Text d -> Maybe (Paragraph d)
finalizeParagraph (RootBox (Box [TextSequence d
_ Text
txt] TextOptions
_))
        | (Char -> Bool) -> Text -> Bool
Txt.all Char -> Bool
isSpace Text
txt = forall a. Maybe a
Nothing -- Discard isolated whitespace.
    finalizeParagraph RootNode Text d
tree =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall d.
Text -> RootNode Text d -> Text -> ParagraphOptions -> Paragraph d
constructParagraph Text
"" RootNode Text d
tree Text
"" forall a b. (a -> b) -> a -> b
$ forall a. CSSBox a -> ParagraphOptions
paragraphOptions CSSBox x
style'
    enumerate :: [b] -> [(Int, b)]
enumerate = forall a b. [a] -> [b] -> [(a, b)]
zip forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> [a]
enumFrom Int
0
finalizeChilds Font'
root Font'
parent style' :: CSSBox x
style'@CSSBox { tableOptions :: forall a. CSSBox a -> TableOptions
tableOptions = TableOptions
tOpts } [StyleTree (CSSBox x)]
childs
    | (StyleTree (CSSBox x)
_:[StyleTree (CSSBox x)]
_) <- [StyleTree (CSSBox x)]
table = forall {x}.
PropertyParser x =>
Font'
-> Font'
-> x
-> TableOptions
-> [StyleTree (CSSBox x)]
-> LayoutItem Length Length x
finalizeTable Font'
root Font'
parent forall a. PropertyParser a => a
temp TableOptions
tOpts [StyleTree (CSSBox x)]
tableforall a. a -> [a] -> [a]
:
        forall x.
PropertyParser x =>
Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds Font'
root Font'
parent CSSBox x
style' [StyleTree (CSSBox x)]
rest
    | (StyleTree (CSSBox x)
child:[StyleTree (CSSBox x)]
childs') <- [StyleTree (CSSBox x)]
childs = forall x.
PropertyParser x =>
Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS Font'
root Font'
parent StyleTree (CSSBox x)
childforall a. a -> [a] -> [a]
:
        forall x.
PropertyParser x =>
Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds Font'
root Font'
parent CSSBox x
style' [StyleTree (CSSBox x)]
childs'
    | Bool
otherwise = []
  where
    ([StyleTree (CSSBox x)]
table, [StyleTree (CSSBox x)]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span forall {a}. StyleTree (CSSBox a) -> Bool
isTable [StyleTree (CSSBox x)]
childs
    isTable :: StyleTree (CSSBox a) -> Bool
isTable (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableRow } [StyleTree (CSSBox a)]
_) = Bool
True
    isTable (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableHeaderGroup } [StyleTree (CSSBox a)]
_) = Bool
True
    isTable (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableRowGroup } [StyleTree (CSSBox a)]
_) = Bool
True
    isTable (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableFooterGroup } [StyleTree (CSSBox a)]
_) = Bool
True
    isTable (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableCell } [StyleTree (CSSBox a)]
_) = Bool
True
    isTable (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableColumn } [StyleTree (CSSBox a)]
_) = Bool
True
    isTable (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableColumnGroup } [StyleTree (CSSBox a)]
_) = Bool
True
    -- Treat TableCaption as a block element!
    isTable StyleTree (CSSBox a)
_ = Bool
False

-- | Desugar most units, possibly in reference to given font.
finalizeBox :: CSSBox a -> Font' -> PaddedBox Length Length
finalizeBox self :: CSSBox a
self@CSSBox { cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box } Font'
font_ =
    forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' (forall a b c. (a -> b -> c) -> b -> a -> c
flip Unitted -> Font' -> Length
finalizeLength Font'
font_) forall a b. (a -> b) -> a -> b
$ forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' (forall a b c. (a -> b -> c) -> b -> a -> c
flip Unitted -> Font' -> Length
finalizeLength Font'
font_) PaddedBox Unitted Unitted
box

-- | Desugar a styletree of table elements to a grid layout.
finalizeTable :: Font'
-> Font'
-> x
-> TableOptions
-> [StyleTree (CSSBox x)]
-> LayoutItem Length Length x
finalizeTable Font'
root Font'
parent x
val TableOptions
opts [StyleTree (CSSBox x)]
childs = forall m n x.
x
-> Grid m n -> [GridItem] -> [LayoutItem m n x] -> LayoutItem m n x
LayoutGrid x
val Size (Track Length) (Track Length)
grid [GridItem]
cells' [LayoutItem Length Length x]
childs'
  where
    grid :: Size (Track Length) (Track Length)
grid = Track {
        cells :: [Either Length Double]
cells = forall a. Int -> a -> [a]
replicate Int
width forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Length
Auto,
        gap :: Length
gap = Length
hGap,
        trackMins :: [Double]
trackMins = [], trackNats :: [Double]
trackNats = []
      } forall m n. n -> m -> Size m n
`Size` Track {
        cells :: [Either Length Double]
cells = forall a. Int -> a -> [a]
replicate Int
height forall a b. (a -> b) -> a -> b
$  forall a b. a -> Either a b
Left Length
Auto,
        gap :: Length
gap = Length
yGap,
        trackMins :: [Double]
trackMins = [], trackNats :: [Double]
trackNats = []
      }
    ([GridItem]
cells', [LayoutItem Length Length x]
childs') = forall a b. [(a, b)] -> ([a], [b])
unzip ([(GridItem, LayoutItem Length Length x)]
decor forall a. [a] -> [a] -> [a]
++ [(GridItem, LayoutItem Length Length x)]
cells)
    (Length
hGap, Length
yGap) = TableOptions -> Font' -> (Length, Length)
finalizeGap TableOptions
opts Font'
parent

    ([(GridItem, LayoutItem Length Length x)]
cells, Int
width, Int
height) = forall {a}.
PropertyParser a =>
[StyleTree (CSSBox a)]
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Int)
lowerCells [StyleTree (CSSBox x)]
childs Int
0 Overflowed
emptyRow
    decor :: [(GridItem, LayoutItem Length Length x)]
decor = forall {a}.
PropertyParser a =>
[StyleTree (CSSBox a)]
-> Int -> Int -> [(GridItem, LayoutItem Length Length a)]
decorateRow [StyleTree (CSSBox x)]
childs Int
width Int
0 forall a. [a] -> [a] -> [a]
++ forall {a}.
PropertyParser a =>
[StyleTree (CSSBox a)]
-> Int -> Int -> [(GridItem, LayoutItem Length Length a)]
decorateCol [StyleTree (CSSBox x)]
childs Int
height Int
0
    lowerCells :: [StyleTree (CSSBox a)]
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Int)
lowerCells (StyleTree self :: CSSBox a
self@CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableRow } [StyleTree (CSSBox a)]
cells:[StyleTree (CSSBox a)]
rest) Int
h Overflowed
x =
        ([(GridItem, LayoutItem Length Length a)]
row forall a. [a] -> [a] -> [a]
++ [(GridItem, LayoutItem Length Length a)]
rows, forall a. Ord a => a -> a -> a
Prelude.max Int
rowwidth Int
width', Int
height')
      where
        ([(GridItem, LayoutItem Length Length a)]
row, Int
rowwidth, Overflowed
x') = forall {a}.
PropertyParser a =>
[StyleTree (CSSBox a)]
-> Int
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Overflowed)
lowerRow [StyleTree (CSSBox a)]
cells Int
0 Int
h Overflowed
x
        ([(GridItem, LayoutItem Length Length a)]
rows, Int
width', Int
height') = [StyleTree (CSSBox a)]
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Int)
lowerCells [StyleTree (CSSBox a)]
rest (forall a. Enum a => a -> a
succ Int
h) forall a b. (a -> b) -> a -> b
$ Overflowed -> Overflowed
commitRow Overflowed
x'
    lowerCells (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableHeaderGroup } [StyleTree (CSSBox a)]
childs:[StyleTree (CSSBox a)]
rest) Int
h Overflowed
x =
        -- Ignore table-header-group styles for now...
        -- Though it'd be nice for this to impact pagination...
        [StyleTree (CSSBox a)]
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Int)
lowerCells ([StyleTree (CSSBox a)]
childs forall a. [a] -> [a] -> [a]
++ [StyleTree (CSSBox a)]
rest) Int
h Overflowed
x
    lowerCells (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableFooterGroup } [StyleTree (CSSBox a)]
childs:[StyleTree (CSSBox a)]
rest) Int
h Overflowed
x =
        [StyleTree (CSSBox a)]
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Int)
lowerCells ([StyleTree (CSSBox a)]
childs forall a. [a] -> [a] -> [a]
++ [StyleTree (CSSBox a)]
rest) Int
h Overflowed
x -- As per TableHeaderGroup
    lowerCells (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableRowGroup } [StyleTree (CSSBox a)]
childs:[StyleTree (CSSBox a)]
rest) Int
h Overflowed
x =
        [StyleTree (CSSBox a)]
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Int)
lowerCells ([StyleTree (CSSBox a)]
childs forall a. [a] -> [a] -> [a]
++ [StyleTree (CSSBox a)]
rest) Int
h Overflowed
x -- As per TableHeaderGroup
    lowerCells (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableColumnGroup } [StyleTree (CSSBox a)]
_:[StyleTree (CSSBox a)]
rest) Int
h Overflowed
x =
        [StyleTree (CSSBox a)]
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Int)
lowerCells [StyleTree (CSSBox a)]
rest Int
h Overflowed
x -- It'd be nice to allow styling based on this...
    lowerCells (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableColumn } [StyleTree (CSSBox a)]
_:[StyleTree (CSSBox a)]
rest) Int
h Overflowed
x =
        [StyleTree (CSSBox a)]
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Int)
lowerCells [StyleTree (CSSBox a)]
rest Int
h Overflowed
x -- As per TableColumnGroup, should be contained within.
    lowerCells (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableCaption } [StyleTree (CSSBox a)]
_:[StyleTree (CSSBox a)]
rest) Int
h Overflowed
x =
        [StyleTree (CSSBox a)]
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Int)
lowerCells [StyleTree (CSSBox a)]
rest Int
h Overflowed
x -- Handled by callers!
    lowerCells [] Int
h Overflowed
_ = ([], Int
0, Int
h)
    lowerCells [StyleTree (CSSBox a)]
items Int
h Overflowed
x = ([(GridItem, LayoutItem Length Length a)]
row forall a. [a] -> [a] -> [a]
++ [(GridItem, LayoutItem Length Length a)]
rows, forall a. Ord a => a -> a -> a
Prelude.max Int
rowwidth Int
width', Int
height')
      where
        ([StyleTree (CSSBox a)]
cells, [StyleTree (CSSBox a)]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break forall {a}. StyleTree (CSSBox a) -> Bool
isRowGroup [StyleTree (CSSBox a)]
items
        ([(GridItem, LayoutItem Length Length a)]
row, Int
rowwidth, Overflowed
x') = forall {a}.
PropertyParser a =>
[StyleTree (CSSBox a)]
-> Int
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Overflowed)
lowerRow [StyleTree (CSSBox a)]
cells Int
0 Int
h Overflowed
x
        ([(GridItem, LayoutItem Length Length a)]
rows, Int
width', Int
height') = [StyleTree (CSSBox a)]
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Int)
lowerCells [StyleTree (CSSBox a)]
rest (forall a. Enum a => a -> a
succ Int
h) forall a b. (a -> b) -> a -> b
$ Overflowed -> Overflowed
commitRow Overflowed
x'

    lowerRow :: [StyleTree (CSSBox a)]
-> Int
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Overflowed)
lowerRow (StyleTree self :: CSSBox a
self@CSSBox {
            display :: forall a. CSSBox a -> Display
display = Display
TableCell, tableOptions :: forall a. CSSBox a -> TableOptions
tableOptions = TableOptions
self' } [StyleTree (CSSBox a)]
childs:[StyleTree (CSSBox a)]
rest) Int
ix Int
row Overflowed
x =
        ((GridItem, LayoutItem Length Length a)
cellforall a. a -> [a] -> [a]
:[(GridItem, LayoutItem Length Length a)]
cells, Int
width, Overflowed
x')
      where
        ([(GridItem, LayoutItem Length Length a)]
cells, Int
width, Overflowed
x') = [StyleTree (CSSBox a)]
-> Int
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Overflowed)
lowerRow [StyleTree (CSSBox a)]
rest Int
end Int
row forall a b. (a -> b) -> a -> b
$
            Int -> Int -> Int -> Overflowed -> Overflowed
insertCell Int
start (TableOptions -> Int
colspan TableOptions
self') (TableOptions -> Int
rowspan TableOptions
self') Overflowed
x
        start :: Int
start = Int -> Overflowed -> Int
allocCol Int
ix Overflowed
x
        end :: Int
end = Int
start forall a. Num a => a -> a -> a
+ TableOptions -> Int
colspan TableOptions
self'
        cell :: (GridItem, LayoutItem Length Length a)
cell = (Int -> Int -> Alignment -> Double -> Double -> GridItem'
GridItem Int
start Int
end Alignment
Start Double
0 Double
0
                forall m n. n -> m -> Size m n
`Size` Int -> Int -> Alignment -> Double -> Double -> GridItem'
GridItem Int
row (Int
row forall a. Num a => a -> a -> a
+ TableOptions -> Int
rowspan TableOptions
self') Alignment
valign Double
0 Double
0,
            forall x.
PropertyParser x =>
Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS Font'
root Font'
parent forall a b. (a -> b) -> a -> b
$ forall p. p -> [StyleTree p] -> StyleTree p
StyleTree CSSBox a
self { display :: Display
display = Display
Block } [StyleTree (CSSBox a)]
childs)
        valign :: Alignment
valign = TableOptions -> Alignment
finalizeVAlign TableOptions
self'
        halign :: Alignment
halign = ParagraphOptions -> Direction -> Alignment
finalizeHAlign (forall a. CSSBox a -> ParagraphOptions
paragraphOptions CSSBox a
self) (forall {a}. CSSBox a -> Direction
direction CSSBox a
self)
    lowerRow (StyleTree (CSSBox a)
self:[StyleTree (CSSBox a)]
rest) Int
ix Int
row Overflowed
x = ((GridItem, LayoutItem Length Length a)
cellforall a. a -> [a] -> [a]
:[(GridItem, LayoutItem Length Length a)]
cells, Int
width, Overflowed
x')
      where
        ix' :: Int
ix' = Int -> Overflowed -> Int
allocCol Int
ix Overflowed
x
        ([(GridItem, LayoutItem Length Length a)]
cells, Int
width, Overflowed
x') = [StyleTree (CSSBox a)]
-> Int
-> Int
-> Overflowed
-> ([(GridItem, LayoutItem Length Length a)], Int, Overflowed)
lowerRow [StyleTree (CSSBox a)]
rest (forall a. Enum a => a -> a
succ Int
ix') Int
row forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Overflowed -> Overflowed
insertCell Int
ix' Int
1 Int
1 Overflowed
x
        cell :: (GridItem, LayoutItem Length Length a)
cell = (Int -> Int -> Alignment -> Double -> Double -> GridItem'
GridItem Int
ix' (forall a. Enum a => a -> a
succ Int
ix') Alignment
Start Double
0 Double
0
                forall m n. n -> m -> Size m n
`Size` Int -> Int -> Alignment -> Double -> Double -> GridItem'
GridItem Int
row (forall a. Enum a => a -> a
succ Int
row) Alignment
Start Double
0 Double
0,
            forall x.
PropertyParser x =>
Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS Font'
root Font'
parent StyleTree (CSSBox a)
self {
                style :: CSSBox a
style = (forall p. StyleTree p -> p
style StyleTree (CSSBox a)
self) {
                    cssBox :: PaddedBox Unitted Unitted
cssBox = TableOptions
-> PaddedBox Unitted Unitted -> PaddedBox Unitted Unitted
collapseBorders TableOptions
opts forall a b. (a -> b) -> a -> b
$ forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox forall a b. (a -> b) -> a -> b
$ forall p. StyleTree p -> p
style StyleTree (CSSBox a)
self
                }
            })
    lowerRow [] Int
ix Int
_ Overflowed
x = ([], Int
ix, Overflowed
x)

    decorateRow :: [StyleTree (CSSBox a)]
-> Int -> Int -> [(GridItem, LayoutItem Length Length a)]
decorateRow (StyleTree self :: CSSBox a
self@CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableRow } [StyleTree (CSSBox a)]
_:[StyleTree (CSSBox a)]
rest) Int
w Int
row =
        forall {x}.
PropertyParser x =>
CSSBox x
-> Int
-> Int
-> Int
-> Int
-> (GridItem, LayoutItem Length Length x)
buildDecor CSSBox a
self Int
0 Int
w Int
row Int
1forall a. a -> [a] -> [a]
:[StyleTree (CSSBox a)]
-> Int -> Int -> [(GridItem, LayoutItem Length Length a)]
decorateRow [StyleTree (CSSBox a)]
rest Int
w (forall a. Enum a => a -> a
succ Int
row)
    decorateRow (StyleTree self :: CSSBox a
self@CSSBox { display :: forall a. CSSBox a -> Display
display = Display
d } [StyleTree (CSSBox a)]
childs:[StyleTree (CSSBox a)]
rest) Int
w Int
row
        | Display
d forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Display
TableHeaderGroup, Display
TableFooterGroup, Display
TableRowGroup] =
            forall {x}.
PropertyParser x =>
CSSBox x
-> Int
-> Int
-> Int
-> Int
-> (GridItem, LayoutItem Length Length x)
buildDecor CSSBox a
self Int
0 Int
w Int
row (forall {a} {a}. (Enum a, Num a) => [StyleTree (CSSBox a)] -> a
countRows [StyleTree (CSSBox a)]
childs)forall a. a -> [a] -> [a]
:
                [StyleTree (CSSBox a)]
-> Int -> Int -> [(GridItem, LayoutItem Length Length a)]
decorateRow ([StyleTree (CSSBox a)]
childs forall a. [a] -> [a] -> [a]
++ [StyleTree (CSSBox a)]
rest) Int
w (Int
row forall a. Num a => a -> a -> a
+ forall {a} {a}. (Enum a, Num a) => [StyleTree (CSSBox a)] -> a
countRows [StyleTree (CSSBox a)]
childs)
        | Display
d forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Display
TableCaption, Display
TableColumn, Display
TableColumnGroup] =
            [StyleTree (CSSBox a)]
-> Int -> Int -> [(GridItem, LayoutItem Length Length a)]
decorateRow [StyleTree (CSSBox a)]
rest Int
w Int
row
        | Bool
otherwise = [StyleTree (CSSBox a)]
-> Int -> Int -> [(GridItem, LayoutItem Length Length a)]
decorateRow (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. StyleTree (CSSBox a) -> Bool
isRowGroup) [StyleTree (CSSBox a)]
rest) Int
wforall a b. (a -> b) -> a -> b
$forall a. Enum a => a -> a
succ Int
row
    decorateRow [] Int
_ Int
_ = []
    decorateCol :: [StyleTree (CSSBox a)]
-> Int -> Int -> [(GridItem, LayoutItem Length Length a)]
decorateCol (StyleTree self :: CSSBox a
self@CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableColumn } [StyleTree (CSSBox a)]
_:[StyleTree (CSSBox a)]
rest) Int
h Int
col =
        forall {x}.
PropertyParser x =>
CSSBox x
-> Int
-> Int
-> Int
-> Int
-> (GridItem, LayoutItem Length Length x)
buildDecor CSSBox a
self Int
col Int
1 Int
0 Int
hforall a. a -> [a] -> [a]
:[StyleTree (CSSBox a)]
-> Int -> Int -> [(GridItem, LayoutItem Length Length a)]
decorateCol [StyleTree (CSSBox a)]
rest Int
h (forall a. Enum a => a -> a
succ Int
col)
    decorateCol (StyleTree self :: CSSBox a
self@CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableColumnGroup } [StyleTree (CSSBox a)]
childs:[StyleTree (CSSBox a)]
rest)
        Int
h Int
col = forall {x}.
PropertyParser x =>
CSSBox x
-> Int
-> Int
-> Int
-> Int
-> (GridItem, LayoutItem Length Length x)
buildDecor CSSBox a
self Int
col (forall {a} {a}. [StyleTree (CSSBox a)] -> CSSBox a -> Int
countCols' [StyleTree (CSSBox a)]
childs CSSBox a
self) Int
0 Int
hforall a. a -> [a] -> [a]
:
            [StyleTree (CSSBox a)]
-> Int -> Int -> [(GridItem, LayoutItem Length Length a)]
decorateCol ([StyleTree (CSSBox a)]
childs forall a. [a] -> [a] -> [a]
++ [StyleTree (CSSBox a)]
rest) Int
h (Int
col forall a. Num a => a -> a -> a
+ forall {a} {a}. [StyleTree (CSSBox a)] -> CSSBox a -> Int
countCols' [StyleTree (CSSBox a)]
childs CSSBox a
self)
    decorateCol (StyleTree (CSSBox a)
_:[StyleTree (CSSBox a)]
rest) Int
h Int
col = [StyleTree (CSSBox a)]
-> Int -> Int -> [(GridItem, LayoutItem Length Length a)]
decorateCol [StyleTree (CSSBox a)]
rest Int
h Int
col
    decorateCol [] Int
_ Int
_ = []

    countRows :: [StyleTree (CSSBox a)] -> a
countRows (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableRow } [StyleTree (CSSBox a)]
_:[StyleTree (CSSBox a)]
rest) =
        forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ [StyleTree (CSSBox a)] -> a
countRows [StyleTree (CSSBox a)]
rest
    countRows (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
d } [StyleTree (CSSBox a)]
childs:[StyleTree (CSSBox a)]
rest)
        | Display
d forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Display
TableHeaderGroup, Display
TableFooterGroup, Display
TableRowGroup] =
            [StyleTree (CSSBox a)] -> a
countRows [StyleTree (CSSBox a)]
childs forall a. Num a => a -> a -> a
+ [StyleTree (CSSBox a)] -> a
countRows [StyleTree (CSSBox a)]
rest
        | Display
d forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Display
TableCaption, Display
TableColumn, Display
TableColumnGroup] = [StyleTree (CSSBox a)] -> a
countRows [StyleTree (CSSBox a)]
rest
        | Bool
otherwise = forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ [StyleTree (CSSBox a)] -> a
countRows forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. StyleTree (CSSBox a) -> Bool
isRowGroup) [StyleTree (CSSBox a)]
rest
    countRows [] = a
0
    countCols' :: [StyleTree (CSSBox a)] -> CSSBox a -> Int
countCols' cols :: [StyleTree (CSSBox a)]
cols@(StyleTree (CSSBox a)
_:[StyleTree (CSSBox a)]
_) CSSBox a
_ = forall {a}. [StyleTree (CSSBox a)] -> Int
countCols [StyleTree (CSSBox a)]
cols
    countCols' [StyleTree (CSSBox a)]
_ CSSBox { tableOptions :: forall a. CSSBox a -> TableOptions
tableOptions = TableOptions { colspan :: TableOptions -> Int
colspan = Int
x } } = Int
x
    countCols :: [StyleTree (CSSBox a)] -> Int
countCols (StyleTree CSSBox {
            display :: forall a. CSSBox a -> Display
display = Display
TableColumn,
            tableOptions :: forall a. CSSBox a -> TableOptions
tableOptions = TableOptions { colspan :: TableOptions -> Int
colspan = Int
x }
        } [StyleTree (CSSBox a)]
_:[StyleTree (CSSBox a)]
rest) = Int
x forall a. Num a => a -> a -> a
+ [StyleTree (CSSBox a)] -> Int
countCols [StyleTree (CSSBox a)]
rest
    countCols (StyleTree CSSBox {
            display :: forall a. CSSBox a -> Display
display = Display
TableColumnGroup,
            tableOptions :: forall a. CSSBox a -> TableOptions
tableOptions = TableOptions { colspan :: TableOptions -> Int
colspan = Int
x }
        } []:[StyleTree (CSSBox a)]
rest) = Int
x forall a. Num a => a -> a -> a
+ [StyleTree (CSSBox a)] -> Int
countCols [StyleTree (CSSBox a)]
rest
    countCols (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableColumnGroup } [StyleTree (CSSBox a)]
childs:[StyleTree (CSSBox a)]
rest) =
        [StyleTree (CSSBox a)] -> Int
countCols [StyleTree (CSSBox a)]
childs forall a. Num a => a -> a -> a
+ [StyleTree (CSSBox a)] -> Int
countCols [StyleTree (CSSBox a)]
rest
    countCols (StyleTree (CSSBox a)
_:[StyleTree (CSSBox a)]
rest) = [StyleTree (CSSBox a)] -> Int
countCols [StyleTree (CSSBox a)]
rest
    countCols [] = Int
0

    buildDecor :: CSSBox x
-> Int
-> Int
-> Int
-> Int
-> (GridItem, LayoutItem Length Length x)
buildDecor CSSBox x
self Int
col Int
colspan Int
row Int
rowspan =
        (Int -> Int -> Alignment -> Double -> Double -> GridItem'
GridItem Int
col (Int
col forall a. Num a => a -> a -> a
+ Int
colspan) Alignment
Start Double
0 Double
0 forall m n. n -> m -> Size m n
`Size`
            Int -> Int -> Alignment -> Double -> Double -> GridItem'
GridItem Int
row (Int
row forall a. Num a => a -> a -> a
+ Int
rowspan) Alignment
Start Double
0 Double
0,
            forall x.
PropertyParser x =>
Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS Font'
root Font'
parent forall a b. (a -> b) -> a -> b
$ forall p. p -> [StyleTree p] -> StyleTree p
StyleTree CSSBox x
self {
                display :: Display
display = Display
Block, cssBox :: PaddedBox Unitted Unitted
cssBox = TableOptions
-> PaddedBox Unitted Unitted -> PaddedBox Unitted Unitted
collapseBorders TableOptions
opts forall a b. (a -> b) -> a -> b
$ forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox CSSBox x
self
            } [])

    isRowGroup :: StyleTree (CSSBox a) -> Bool
isRowGroup (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableRow } [StyleTree (CSSBox a)]
_) = Bool
True
    isRowGroup (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableHeaderGroup } [StyleTree (CSSBox a)]
_) = Bool
True
    isRowGroup (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableFooterGroup } [StyleTree (CSSBox a)]
_) = Bool
True
    isRowGroup (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableRowGroup } [StyleTree (CSSBox a)]
_) = Bool
True
    isRowGroup (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableCaption } [StyleTree (CSSBox a)]
_) = Bool
True
    isRowGroup (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableColumn } [StyleTree (CSSBox a)]
_) = Bool
True
    isRowGroup (StyleTree CSSBox { display :: forall a. CSSBox a -> Display
display = Display
TableColumnGroup } [StyleTree (CSSBox a)]
_) = Bool
True
    isRowGroup StyleTree (CSSBox a)
_ = Bool
False

collapseTBorders' :: CSSBox x -> CSSBox x
collapseTBorders' :: forall x. CSSBox x -> CSSBox x
collapseTBorders' CSSBox x
self = CSSBox x
self {
    cssBox :: PaddedBox Unitted Unitted
cssBox = TableOptions
-> PaddedBox Unitted Unitted -> PaddedBox Unitted Unitted
collapseTBorders (forall a. CSSBox a -> TableOptions
tableOptions CSSBox x
self) (forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox CSSBox x
self)
  }