{-# 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.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, captionBelow :: forall a. CSSBox a -> 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 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 {p} {p} {x} {p}.
p -> p -> x -> p -> LayoutItem Length Length x
finalizeTable Font'
root Font'
font_ (forall a. CSSBox a -> a
inner 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, captionBelow :: forall a. CSSBox a -> 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 CSSBox x
self' Font'
font_)
        (forall {p} {p} {x} {p}.
p -> p -> x -> p -> LayoutItem Length Length x
finalizeTable Font'
root Font'
font_ forall a. PropertyParser a => a
temp [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)]
childs')
    | 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...
    | Bool
otherwise = forall x.
PropertyParser x =>
Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS Font'
root Font'
parent StyleTree (CSSBox x)
child 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)]
childs'
  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 { children :: forall p. StyleTree p -> [StyleTree p]
children = child :: [StyleTree (CSSBox a)]
child@(StyleTree (CSSBox a)
_:[StyleTree (CSSBox a)]
_), style :: forall p. StyleTree p -> p
style = CSSBox a
self }) =
        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)
                BoxOptions
defaultBoxOptions -- Fill in during layout.
      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'
_ Font'
_ CSSBox x
_ [] = []

-- | 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

-- | (Unused, incomplete) Desugar a styletree of table elements to a grid layout.
finalizeTable :: p -> p -> x -> p -> LayoutItem Length Length x
finalizeTable p
root p
parent x
val p
childs = forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val PaddedBox Length Length
lengthBox [] -- Placeholder!
{- 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")),
        rowBounds = [],
        subgridRows = 0,
        columns = take height $ repeat ("", (0,"auto")),
        colBounds = [],
        subgridCols = 0,
        gap = Size (0,"px") (0,"px"), -- FIXME where to get this from?
        containerSize = Size Auto Auto, -- Proper size is set on parent.
        containerMin = Size Auto Auto,
        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?
        (rows, width', height') = lowerCells rest
    lowerCells (StyleTree self@CSSBox { display = TableHeaderGroup } childs ) =
        -}