{-# 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 (paragraphLineHeight, constructParagraph,
        defaultParagraphOptions, 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

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

-- | Desugar parsed CSS into more generic layout parameters.
finalizeCSS :: PropertyParser x => Font' -> Font' -> StyleTree (CSSBox x) ->
        LayoutItem Length Length x
finalizeCSS :: Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS root :: Font'
root parent :: Font'
parent StyleTree { style :: forall p. StyleTree p -> p
style = self' :: CSSBox x
self'@CSSBox { display :: forall a. CSSBox a -> Display
display = Display
None } } =
    x
-> PaddedBox Length Length
-> [LayoutItem Length Length x]
-> LayoutItem Length Length x
forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow (CSSBox x -> x
forall a. CSSBox a -> a
inner CSSBox x
self') PaddedBox Length Length
lengthBox []
finalizeCSS root :: Font'
root parent :: 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, inner :: forall a. CSSBox a -> a
inner = x
val }, children :: forall p. StyleTree p -> [StyleTree p]
children = [StyleTree (CSSBox x)]
childs
  } = x
-> PaddedBox Length Length
-> [LayoutItem Length Length x]
-> LayoutItem Length Length x
forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val (CSSBox x -> Font' -> PaddedBox Length Length
forall a. CSSBox a -> Font' -> PaddedBox Length Length
finalizeBox CSSBox x
self' Font'
font_) [
        CSSGrid
-> Font'
-> [CSSCell]
-> [LayoutItem Length Length x]
-> LayoutItem Length Length x
forall x.
PropertyParser x =>
CSSGrid
-> Font'
-> [CSSCell]
-> [LayoutItem Length Length x]
-> LayoutItem Length Length x
finalizeGrid (CSSBox x -> CSSGrid
forall a. CSSBox a -> CSSGrid
gridStyles CSSBox x
self') Font'
font_ ((CSSBox x -> CSSCell) -> [CSSBox x] -> [CSSCell]
forall a b. (a -> b) -> [a] -> [b]
map CSSBox x -> CSSCell
forall a. CSSBox a -> CSSCell
cellStyles ([CSSBox x] -> [CSSCell]) -> [CSSBox x] -> [CSSCell]
forall a b. (a -> b) -> a -> b
$ (StyleTree (CSSBox x) -> CSSBox x)
-> [StyleTree (CSSBox x)] -> [CSSBox x]
forall a b. (a -> b) -> [a] -> [b]
map StyleTree (CSSBox x) -> CSSBox x
forall p. StyleTree p -> p
style [StyleTree (CSSBox x)]
childs)
            (Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
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 (CSSBox x -> Pattern
forall a. CSSBox a -> Pattern
font CSSBox x
self') (CSSBox x -> CSSFont
forall a. CSSBox a -> CSSFont
font' CSSBox x
self') Font'
parent Font'
root
finalizeCSS root :: Font'
root parent :: 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
    } = x
-> PaddedBox Length Length
-> [LayoutItem Length Length x]
-> LayoutItem Length Length x
forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow (CSSBox x -> x
forall a. CSSBox a -> a
inner CSSBox x
self') (CSSBox x -> Font' -> PaddedBox Length Length
forall a. CSSBox a -> Font' -> PaddedBox Length Length
finalizeBox CSSBox x
self' Font'
font_)
        ([Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
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] [LayoutItem Length Length x]
-> [LayoutItem Length Length x] -> [LayoutItem Length Length x]
forall a. [a] -> [a] -> [a]
++
        [Font'
-> Font'
-> x
-> [StyleTree (CSSBox x)]
-> LayoutItem Length Length x
forall p p x p. p -> p -> x -> p -> LayoutItem Length Length x
finalizeTable Font'
root Font'
font_ (CSSBox x -> x
forall a. CSSBox a -> a
inner CSSBox x
self') [StyleTree (CSSBox x)]
childs])
  where
    font_ :: Font'
font_ = Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font (CSSBox x -> Pattern
forall a. CSSBox a -> Pattern
font CSSBox x
self') (CSSBox x -> CSSFont
forall a. CSSBox a -> CSSFont
font' CSSBox x
self') Font'
parent Font'
root
finalizeCSS root :: Font'
root parent :: 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
    } = x
-> PaddedBox Length Length
-> [LayoutItem Length Length x]
-> LayoutItem Length Length x
forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow (CSSBox x -> x
forall a. CSSBox a -> a
inner CSSBox x
self') (CSSBox x -> Font' -> PaddedBox Length Length
forall a. CSSBox a -> Font' -> PaddedBox Length Length
finalizeBox CSSBox x
self' Font'
font_)
        (Font'
-> Font'
-> x
-> [StyleTree (CSSBox x)]
-> LayoutItem Length Length x
forall p p x p. p -> p -> x -> p -> LayoutItem Length Length x
finalizeTable Font'
root Font'
font_ x
forall a. PropertyParser a => a
temp [StyleTree (CSSBox x)]
childsLayoutItem Length Length x
-> [LayoutItem Length Length x] -> [LayoutItem Length Length x]
forall a. a -> [a] -> [a]
:
        [Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
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 (CSSBox x -> Pattern
forall a. CSSBox a -> Pattern
font CSSBox x
self') (CSSBox x -> CSSFont
forall a. CSSBox a -> CSSFont
font' CSSBox x
self') Font'
parent Font'
root
finalizeCSS root :: Font'
root parent :: Font'
parent self :: StyleTree (CSSBox x)
self@StyleTree {
    style :: forall p. StyleTree p -> p
style = self' :: CSSBox x
self'@CSSBox { inner :: forall a. CSSBox a -> a
inner = x
val }, children :: forall p. StyleTree p -> [StyleTree p]
children = [StyleTree (CSSBox x)]
childs
  } = x
-> PaddedBox Length Length
-> [LayoutItem Length Length x]
-> LayoutItem Length Length x
forall m n x.
x -> PaddedBox m n -> [LayoutItem m n x] -> LayoutItem m n x
LayoutFlow x
val (CSSBox x -> Font' -> PaddedBox Length Length
forall a. CSSBox a -> Font' -> PaddedBox Length Length
finalizeBox CSSBox x
self' Font'
font_) (Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
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 (CSSBox x -> Pattern
forall a. CSSBox a -> Pattern
font CSSBox x
self') (CSSBox x -> CSSFont
forall a. CSSBox a -> CSSFont
font' CSSBox x
self') Font'
parent Font'
root
finalizeCSS' :: Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS' sysfont :: Font'
sysfont self :: StyleTree (CSSBox x)
self@StyleTree { style :: forall p. StyleTree p -> p
style = CSSBox x
self' } =
    Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
forall x.
PropertyParser x =>
Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS (Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font (CSSBox x -> Pattern
forall a. CSSBox a -> Pattern
font CSSBox x
self') (CSSBox x -> CSSFont
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 :: Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds root :: Font'
root parent :: Font'
parent style' :: CSSBox x
style' (StyleTree { style :: forall p. StyleTree p -> p
style = CSSBox { display :: forall a. CSSBox a -> Display
display = Display
None } }:childs :: [StyleTree (CSSBox x)]
childs) =
    Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
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 root :: Font'
root parent :: Font'
parent style' :: CSSBox x
style' childs :: [StyleTree (CSSBox x)]
childs@(child :: StyleTree (CSSBox x)
child:childs' :: [StyleTree (CSSBox x)]
childs')
    | [StyleTree (CSSBox x)] -> Bool
forall a. [StyleTree (CSSBox a)] -> Bool
isInlineTree [StyleTree (CSSBox x)]
childs, Just self :: Paragraph ((Font', Int), PaddedBox Length Length, x)
self <- RootNode Text ((Font', Int), PaddedBox Length Length, x)
-> Maybe (Paragraph ((Font', Int), PaddedBox Length Length, x))
forall d. RootNode Text d -> Maybe (Paragraph d)
finalizeParagraph ([StyleTree (CSSBox x)]
-> RootNode Text ((Font', Int), PaddedBox Length Length, x)
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) =
        [x
-> Paragraph ((Font', Int), PaddedBox Length Length, x)
-> PageOptions
-> LayoutItem Length Length x
forall m n x.
x -> Paragraph (UserData m n x) -> PageOptions -> LayoutItem m n x
LayoutInline (x -> x
forall a. PropertyParser a => a -> a
inherit (x -> x) -> x -> x
forall a b. (a -> b) -> a -> b
$ CSSBox x -> x
forall a. CSSBox a -> a
inner CSSBox x
style') Paragraph ((Font', Int), PaddedBox Length Length, x)
self PageOptions
paging]
    | (inlines :: [StyleTree (CSSBox x)]
inlines@(_:_), blocks :: [StyleTree (CSSBox x)]
blocks) <- [StyleTree (CSSBox x)]
-> ([StyleTree (CSSBox x)], [StyleTree (CSSBox x)])
forall a.
[StyleTree (CSSBox a)]
-> ([StyleTree (CSSBox a)], [StyleTree (CSSBox a)])
spanInlines [StyleTree (CSSBox x)]
childs,
        Just self :: Paragraph ((Font', Int), PaddedBox Length Length, x)
self <- RootNode Text ((Font', Int), PaddedBox Length Length, x)
-> Maybe (Paragraph ((Font', Int), PaddedBox Length Length, x))
forall d. RootNode Text d -> Maybe (Paragraph d)
finalizeParagraph ([StyleTree (CSSBox x)]
-> RootNode Text ((Font', Int), PaddedBox Length Length, x)
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) =
            x
-> Paragraph ((Font', Int), PaddedBox Length Length, x)
-> PageOptions
-> LayoutItem Length Length x
forall m n x.
x -> Paragraph (UserData m n x) -> PageOptions -> LayoutItem m n x
LayoutInline (x -> x
forall a. PropertyParser a => a -> a
inherit (x -> x) -> x -> x
forall a b. (a -> b) -> a -> b
$ CSSBox x -> x
forall a. CSSBox a -> a
inner CSSBox x
style') Paragraph ((Font', Int), PaddedBox Length Length, x)
self PageOptions
paging LayoutItem Length Length x
-> [LayoutItem Length Length x] -> [LayoutItem Length Length x]
forall a. a -> [a] -> [a]
:
                Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
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 } }:childs' :: [StyleTree (CSSBox x)]
childs') <- [StyleTree (CSSBox x)]
childs =
        Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
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 = Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
forall x.
PropertyParser x =>
Font'
-> Font' -> StyleTree (CSSBox x) -> LayoutItem Length Length x
finalizeCSS Font'
root Font'
parent StyleTree (CSSBox x)
child LayoutItem Length Length x
-> [LayoutItem Length Length x] -> [LayoutItem Length Length x]
forall a. a -> [a] -> [a]
: Font'
-> Font'
-> CSSBox x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
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 = CSSBox x -> PageOptions
forall a. CSSBox a -> PageOptions
pageOptions (CSSBox x -> PageOptions) -> CSSBox x -> PageOptions
forall a b. (a -> b) -> a -> b
$ StyleTree (CSSBox x) -> CSSBox x
forall p. StyleTree p -> p
style StyleTree (CSSBox x)
child
    isInlineTree :: [StyleTree (CSSBox a)] -> Bool
isInlineTree = (StyleTree (CSSBox a) -> Bool) -> [StyleTree (CSSBox a)] -> Bool
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 _ = Bool
False
    spanInlines :: [StyleTree (CSSBox a)]
-> ([StyleTree (CSSBox a)], [StyleTree (CSSBox a)])
spanInlines childs :: [StyleTree (CSSBox a)]
childs = case (StyleTree (CSSBox a) -> Bool)
-> [StyleTree (CSSBox a)]
-> ([StyleTree (CSSBox a)], [StyleTree (CSSBox a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span StyleTree (CSSBox a) -> Bool
forall a. StyleTree (CSSBox a) -> Bool
isInlineTree0 [StyleTree (CSSBox a)]
childs of
        (inlines :: [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
          }:blocks :: [StyleTree (CSSBox a)]
blocks)) -> let (inlines' :: [StyleTree (CSSBox a)]
inlines', blocks' :: [StyleTree (CSSBox a)]
blocks') = [StyleTree (CSSBox a)]
-> ([StyleTree (CSSBox a)], [StyleTree (CSSBox a)])
spanInlines [StyleTree (CSSBox a)]
tail
            in ([StyleTree (CSSBox a)]
inlines [StyleTree (CSSBox a)]
-> [StyleTree (CSSBox a)] -> [StyleTree (CSSBox a)]
forall a. [a] -> [a] -> [a]
++ [StyleTree (CSSBox a)]
inlines', [StyleTree (CSSBox a)]
blocks' [StyleTree (CSSBox a)]
-> [StyleTree (CSSBox a)] -> [StyleTree (CSSBox a)]
forall a. [a] -> [a] -> [a]
++ [StyleTree (CSSBox a)]
blocks)
        ret :: ([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 childs :: [StyleTree (CSSBox a)]
childs
        | iStyle :: CSSInline
iStyle@(CSSInline _ _ bidi :: UnicodeBidi
bidi) <- CSSBox x -> CSSInline
forall a. CSSBox a -> CSSInline
inlineStyles CSSBox x
style',
            UnicodeBidi
bidi UnicodeBidi -> [UnicodeBidi] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UnicodeBidi
BdOverride, UnicodeBidi
BdIsolateOverride] = Box Text ((Font', Int), PaddedBox Length Length, a)
-> RootNode Text ((Font', Int), PaddedBox Length Length, a)
forall t d. Box t d -> RootNode t d
RootBox (Box Text ((Font', Int), PaddedBox Length Length, a)
 -> RootNode Text ((Font', Int), PaddedBox Length Length, a))
-> Box Text ((Font', Int), PaddedBox Length Length, a)
-> RootNode Text ((Font', Int), PaddedBox Length Length, a)
forall a b. (a -> b) -> a -> b
$ [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
-> TextOptions
-> Box Text ((Font', Int), PaddedBox Length Length, a)
forall t d. [InnerNode t d] -> TextOptions -> Box t d
Box
                (CSSInline
-> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
-> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
forall d.
Default d =>
CSSInline -> [InnerNode Text d] -> [InnerNode Text d]
applyBidi CSSInline
iStyle ([InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
 -> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)])
-> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
-> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
forall a b. (a -> b) -> a -> b
$ ((Int, StyleTree (CSSBox a))
 -> InnerNode Text ((Font', Int), PaddedBox Length Length, a))
-> [(Int, StyleTree (CSSBox a))]
-> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
forall a b. (a -> b) -> [a] -> [b]
map (Font'
-> (Int, StyleTree (CSSBox a))
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
forall a.
(Default ((Font', Int), PaddedBox Length Length, a),
 PropertyParser a) =>
Font'
-> (Int, StyleTree (CSSBox a))
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
flattenTree Font'
parent) ([(Int, StyleTree (CSSBox a))]
 -> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)])
-> [(Int, StyleTree (CSSBox a))]
-> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
forall a b. (a -> b) -> a -> b
$ [StyleTree (CSSBox a)] -> [(Int, StyleTree (CSSBox a))]
forall b. [b] -> [(Int, b)]
enumerate [StyleTree (CSSBox a)]
childs)
                (TextOptions
 -> Box Text ((Font', Int), PaddedBox Length Length, a))
-> TextOptions
-> Box Text ((Font', Int), PaddedBox Length Length, a)
forall a b. (a -> b) -> a -> b
$ (TextOptions -> Font' -> TextOptions)
-> Font' -> TextOptions -> TextOptions
forall a b c. (a -> b -> c) -> b -> a -> c
flip TextOptions -> Font' -> TextOptions
applyFontInline Font'
parent (TextOptions -> TextOptions) -> TextOptions -> TextOptions
forall a b. (a -> b) -> a -> b
$ CSSBox x -> TextOptions
forall a. CSSBox a -> TextOptions
txtOpts CSSBox x
style'
        | Bool
otherwise = Box Text ((Font', Int), PaddedBox Length Length, a)
-> RootNode Text ((Font', Int), PaddedBox Length Length, a)
forall t d. Box t d -> RootNode t d
RootBox (Box Text ((Font', Int), PaddedBox Length Length, a)
 -> RootNode Text ((Font', Int), PaddedBox Length Length, a))
-> Box Text ((Font', Int), PaddedBox Length Length, a)
-> RootNode Text ((Font', Int), PaddedBox Length Length, a)
forall a b. (a -> b) -> a -> b
$ [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
-> TextOptions
-> Box Text ((Font', Int), PaddedBox Length Length, a)
forall t d. [InnerNode t d] -> TextOptions -> Box t d
Box (((Int, StyleTree (CSSBox a))
 -> InnerNode Text ((Font', Int), PaddedBox Length Length, a))
-> [(Int, StyleTree (CSSBox a))]
-> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
forall a b. (a -> b) -> [a] -> [b]
map (Font'
-> (Int, StyleTree (CSSBox a))
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
forall a.
(Default ((Font', Int), PaddedBox Length Length, a),
 PropertyParser a) =>
Font'
-> (Int, StyleTree (CSSBox a))
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
flattenTree Font'
parent) ([(Int, StyleTree (CSSBox a))]
 -> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)])
-> [(Int, StyleTree (CSSBox a))]
-> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
forall a b. (a -> b) -> a -> b
$ [StyleTree (CSSBox a)] -> [(Int, StyleTree (CSSBox a))]
forall b. [b] -> [(Int, b)]
enumerate [StyleTree (CSSBox a)]
childs)
            (TextOptions
 -> Box Text ((Font', Int), PaddedBox Length Length, a))
-> TextOptions
-> Box Text ((Font', Int), PaddedBox Length Length, a)
forall a b. (a -> b) -> a -> b
$ (TextOptions -> Font' -> TextOptions)
-> Font' -> TextOptions -> TextOptions
forall a b c. (a -> b -> c) -> b -> a -> c
flip TextOptions -> Font' -> TextOptions
applyFontInline Font'
parent (TextOptions -> TextOptions) -> TextOptions -> TextOptions
forall a b. (a -> b) -> a -> b
$ CSSBox x -> TextOptions
forall a. CSSBox a -> TextOptions
txtOpts CSSBox x
style'
    flattenTree :: Font'
-> (Int, StyleTree (CSSBox a))
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
flattenTree p :: Font'
p (i :: Int
i, StyleTree { children :: forall p. StyleTree p -> [StyleTree p]
children = child :: [StyleTree (CSSBox a)]
child@(_:_), style :: forall p. StyleTree p -> p
style = CSSBox a
self }) =
        Font'
-> Int
-> CSSBox a
-> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
forall b 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 ([InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
 -> InnerNode Text ((Font', Int), PaddedBox Length Length, a))
-> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
forall a b. (a -> b) -> a -> b
$ ((Int, StyleTree (CSSBox a))
 -> InnerNode Text ((Font', Int), PaddedBox Length Length, a))
-> [(Int, StyleTree (CSSBox a))]
-> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
forall a b. (a -> b) -> [a] -> [b]
map (Font'
-> (Int, StyleTree (CSSBox a))
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
flattenTree Font'
f) ([(Int, StyleTree (CSSBox a))]
 -> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)])
-> [(Int, StyleTree (CSSBox a))]
-> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
forall a b. (a -> b) -> a -> b
$ [StyleTree (CSSBox a)] -> [(Int, StyleTree (CSSBox a))]
forall b. [b] -> [(Int, b)]
enumerate [StyleTree (CSSBox a)]
child
      where f :: Font'
f = Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font (CSSBox a -> Pattern
forall a. CSSBox a -> Pattern
font CSSBox a
self) (CSSBox a -> CSSFont
forall a. CSSBox a -> CSSFont
font' CSSBox a
self) Font'
p Font'
root
    flattenTree f :: Font'
f (i :: Int
i,StyleTree {style :: forall p. StyleTree p -> p
style=self :: CSSBox a
self@CSSBox {inlineStyles :: forall a. CSSBox a -> CSSInline
inlineStyles=CSSInline txt :: Text
txt _ _}})
        = Font'
-> Int
-> CSSBox a
-> [InnerNode Text ((Font', Int), PaddedBox Length Length, a)]
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
forall b 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 [((Font', Int), PaddedBox Length Length, a)
-> Text
-> InnerNode Text ((Font', Int), PaddedBox Length Length, a)
forall t d. d -> t -> InnerNode t d
TextSequence ((Font'
f,0),PaddedBox Length Length
forall a. Zero a => a
zero,a -> a
forall a. PropertyParser a => a -> a
inherit (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ CSSBox a -> a
forall a. CSSBox a -> a
inner 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 f :: Font'
f i :: b
i self :: CSSBox a
self childs :: [InnerNode Text ((Font', b), PaddedBox Length Length, a)]
childs =
        ((Font', b), PaddedBox Length Length, a)
-> Box Text ((Font', b), PaddedBox Length Length, a)
-> BoxOptions
-> InnerNode Text ((Font', b), PaddedBox Length Length, a)
forall t d. d -> Box t d -> BoxOptions -> InnerNode t d
InlineBox ((Font'
f, b
i), CSSBox a -> Font' -> PaddedBox Length Length
forall a. CSSBox a -> Font' -> PaddedBox Length Length
finalizeBox CSSBox a
self Font'
f, CSSBox a -> a
forall a. CSSBox a -> a
inner CSSBox a
self)
                ([InnerNode Text ((Font', b), PaddedBox Length Length, a)]
-> TextOptions -> Box Text ((Font', b), PaddedBox Length Length, a)
forall t d. [InnerNode t d] -> TextOptions -> Box t d
Box [InnerNode Text ((Font', b), PaddedBox Length Length, a)]
childs' (TextOptions -> Box Text ((Font', b), PaddedBox Length Length, a))
-> TextOptions -> Box Text ((Font', b), PaddedBox Length Length, a)
forall a b. (a -> b) -> a -> b
$ (TextOptions -> Font' -> TextOptions)
-> Font' -> TextOptions -> TextOptions
forall a b c. (a -> b -> c) -> b -> a -> c
flip TextOptions -> Font' -> TextOptions
applyFontInline Font'
f (TextOptions -> TextOptions) -> TextOptions -> TextOptions
forall a b. (a -> b) -> a -> b
$ CSSBox a -> TextOptions
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' = CSSInline
-> [InnerNode Text ((Font', b), PaddedBox Length Length, a)]
-> [InnerNode Text ((Font', b), PaddedBox Length Length, a)]
forall d.
Default d =>
CSSInline -> [InnerNode Text d] -> [InnerNode Text d]
applyBidi (CSSBox a -> CSSInline
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 _ txt :: Text
txt] _))
        | (Char -> Bool) -> Text -> Bool
Txt.all Char -> Bool
isSpace Text
txt = Maybe (Paragraph d)
forall a. Maybe a
Nothing -- Discard isolated whitespace.
    finalizeParagraph tree :: RootNode Text d
tree =
        Paragraph d -> Maybe (Paragraph d)
forall a. a -> Maybe a
Just (Paragraph d -> Maybe (Paragraph d))
-> Paragraph d -> Maybe (Paragraph d)
forall a b. (a -> b) -> a -> b
$ Text -> RootNode Text d -> Text -> ParagraphOptions -> Paragraph d
forall d.
Text -> RootNode Text d -> Text -> ParagraphOptions -> Paragraph d
constructParagraph "" RootNode Text d
tree "" ParagraphOptions
defaultParagraphOptions {
            paragraphLineHeight :: LineHeight
paragraphLineHeight = Int32 -> LineHeight
Absolute (Int32 -> LineHeight) -> Int32 -> LineHeight
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a. Enum a => Int -> a
toEnum (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a. Enum a => a -> Int
fromEnum
                    (Font' -> Double
lineheight Font'
parent Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
hbUnit)
          }
    enumerate :: [b] -> [(Int, b)]
enumerate = [Int] -> [b] -> [(Int, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int] -> [b] -> [(Int, b)]) -> [Int] -> [b] -> [(Int, b)]
forall a b. (a -> b) -> a -> b
$ Int -> [Int]
forall a. Enum a => a -> [a]
enumFrom 0
finalizeChilds _ _ _ [] = []

-- | 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'
font_ =
    (Unitted -> Length)
-> PaddedBox Unitted Length -> PaddedBox Length Length
forall m mm n. (m -> mm) -> PaddedBox m n -> PaddedBox mm n
mapY' ((Unitted -> Font' -> Length) -> Font' -> Unitted -> Length
forall a b c. (a -> b -> c) -> b -> a -> c
flip Unitted -> Font' -> Length
finalizeLength Font'
font_) (PaddedBox Unitted Length -> PaddedBox Length Length)
-> PaddedBox Unitted Length -> PaddedBox Length Length
forall a b. (a -> b) -> a -> b
$ (Unitted -> Length)
-> PaddedBox Unitted Unitted -> PaddedBox Unitted Length
forall n nn m. (n -> nn) -> PaddedBox m n -> PaddedBox m nn
mapX' ((Unitted -> Font' -> Length) -> Font' -> Unitted -> Length
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 root :: p
root parent :: p
parent val :: x
val childs :: p
childs = x
-> PaddedBox Length Length
-> [LayoutItem Length Length x]
-> LayoutItem Length Length x
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 ) =
        -}