{-# LANGUAGE OverloadedStrings #-}
-- | Parses & desugars CSS properties to general CatTrap datastructures.
module Graphics.Layout.CSS(CSSBox(..), BoxSizing(..), Display(..),
        finalizeCSS, finalizeCSS') where

import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import qualified Data.Text as Txt
import Stylist (PropertyParser(..), TrivialPropertyParser)
import Stylist.Tree (StyleTree(..))
import Data.Text.ParagraphLayout (PageOptions(..))

import Graphics.Layout.Box as B
import Graphics.Layout
import Graphics.Text.Font.Choose (Pattern(..), unset)
import Graphics.Layout.CSS.Length
import Graphics.Layout.CSS.Font
import Graphics.Layout.Grid.CSS
import Graphics.Layout.Inline.CSS

-- | Parsed CSS properties relevant to layout.
data CSSBox a = CSSBox {
    -- | Which layout formula to use, a.k.a. parsed CSS display property.
    CSSBox a -> Display
display :: Display,
    -- | (Unused) Parsed CSS box-sizing
    CSSBox a -> BoxSizing
boxSizing :: BoxSizing,
    -- | sizing, margins, border-width, & padding CSS properties.
    -- Stores units in case they're needed for font-related units.
    CSSBox a -> PaddedBox Unitted Unitted
cssBox :: PaddedBox Unitted Unitted, -- calc()?
    -- | Query parameters describing desired font.
    CSSBox a -> Pattern
font :: Pattern,
    -- | Additional font-related CSS properties.
    CSSBox a -> CSSFont
font' :: CSSFont,
    -- | Caller-specified data, to parse additional CSS properties.
    CSSBox a -> a
inner :: a,
    -- | Grid-related CSS properties.
    CSSBox a -> CSSGrid
gridStyles :: CSSGrid,
    -- | Grid item related CSS properties.
    CSSBox a -> CSSCell
cellStyles :: CSSCell,
    -- | inline-related CSS properties.
    CSSBox a -> CSSInline
inlineStyles :: CSSInline,
    -- | Parsed CSS caption-side.
    CSSBox a -> Bool
captionBelow :: Bool,
    -- | Parsed widows & orphans controlling pagination.
    CSSBox a -> PageOptions
pageOptions :: PageOptions
}
-- | Possible values for CSS box-sizing.
data BoxSizing = BorderBox | ContentBox
-- | Empty border, to use as default value.
noborder :: Border Unitted Unitted
noborder = Unitted -> Unitted -> Unitted -> Unitted -> Border Unitted Unitted
forall m n. m -> m -> n -> n -> Border m n
Border (0,"px") (0,"px") (0,"px") (0,"px")

-- | Possibly values for CSS display property.
data Display = Block | Grid | Inline | Table | None |
    TableRow | TableHeaderGroup | TableRowGroup | TableFooterGroup | TableCell |
    TableColumn | TableColumnGroup | TableCaption deriving Display -> Display -> Bool
(Display -> Display -> Bool)
-> (Display -> Display -> Bool) -> Eq Display
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Display -> Display -> Bool
$c/= :: Display -> Display -> Bool
== :: Display -> Display -> Bool
$c== :: Display -> Display -> Bool
Eq
-- | Can the display value contain table-rows?
rowContainer :: CSSBox a -> Bool
rowContainer CSSBox { display :: forall a. CSSBox a -> Display
display = Display
d } =
    Display
d Display -> [Display] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Display
Table, Display
TableHeaderGroup, Display
TableRowGroup, Display
TableFooterGroup]

instance PropertyParser a => PropertyParser (CSSBox a) where
    temp :: CSSBox a
temp = CSSBox :: forall a.
Display
-> BoxSizing
-> PaddedBox Unitted Unitted
-> Pattern
-> CSSFont
-> a
-> CSSGrid
-> CSSCell
-> CSSInline
-> Bool
-> PageOptions
-> CSSBox a
CSSBox {
        boxSizing :: BoxSizing
boxSizing = BoxSizing
ContentBox,
        display :: Display
display = Display
Inline,
        cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox :: forall m n.
Size m n
-> Size m n
-> Size Double Double
-> Size m n
-> Border m n
-> Border m n
-> Border m n
-> PaddedBox m n
PaddedBox {
            min :: Size Unitted Unitted
B.min = Unitted -> Unitted -> Size Unitted Unitted
forall m n. n -> m -> Size m n
Size Unitted
auto Unitted
auto,
            size :: Size Unitted Unitted
size = Unitted -> Unitted -> Size Unitted Unitted
forall m n. n -> m -> Size m n
Size Unitted
auto Unitted
auto,
            nat :: Size Double Double
nat = Double -> Double -> Size Double Double
forall m n. n -> m -> Size m n
Size 0 0,
            max :: Size Unitted Unitted
B.max = Unitted -> Unitted -> Size Unitted Unitted
forall m n. n -> m -> Size m n
Size Unitted
auto Unitted
auto,
            padding :: Border Unitted Unitted
padding = Border Unitted Unitted
noborder,
            border :: Border Unitted Unitted
border = Border Unitted Unitted
noborder,
            margin :: Border Unitted Unitted
margin = Border Unitted Unitted
noborder
        },
        font :: Pattern
font = Pattern
forall a. PropertyParser a => a
temp,
        font' :: CSSFont
font' = CSSFont
forall a. PropertyParser a => a
temp,
        inner :: a
inner = a
forall a. PropertyParser a => a
temp,
        gridStyles :: CSSGrid
gridStyles = CSSGrid
forall a. PropertyParser a => a
temp,
        cellStyles :: CSSCell
cellStyles = CSSCell
forall a. PropertyParser a => a
temp,
        inlineStyles :: CSSInline
inlineStyles = CSSInline
forall a. PropertyParser a => a
temp,
        captionBelow :: Bool
captionBelow = Bool
False,
        pageOptions :: PageOptions
pageOptions = Int32 -> Int32 -> Word -> Word -> PageOptions
PageOptions 0 0 2 2
      }
    inherit :: CSSBox a -> CSSBox a
inherit parent :: CSSBox a
parent = CSSBox :: forall a.
Display
-> BoxSizing
-> PaddedBox Unitted Unitted
-> Pattern
-> CSSFont
-> a
-> CSSGrid
-> CSSCell
-> CSSInline
-> Bool
-> PageOptions
-> CSSBox a
CSSBox {
        boxSizing :: BoxSizing
boxSizing = CSSBox a -> BoxSizing
forall a. CSSBox a -> BoxSizing
boxSizing CSSBox a
parent,
        display :: Display
display = Display
Inline,
        cssBox :: PaddedBox Unitted Unitted
cssBox = CSSBox TrivialPropertyParser -> PaddedBox Unitted Unitted
forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox (CSSBox TrivialPropertyParser
forall a. PropertyParser a => a
temp :: CSSBox TrivialPropertyParser),
        font :: Pattern
font = Pattern -> Pattern
forall a. PropertyParser a => a -> a
inherit (Pattern -> Pattern) -> Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ CSSBox a -> Pattern
forall a. CSSBox a -> Pattern
font CSSBox a
parent,
        font' :: CSSFont
font' = CSSFont -> CSSFont
forall a. PropertyParser a => a -> a
inherit (CSSFont -> CSSFont) -> CSSFont -> CSSFont
forall a b. (a -> b) -> a -> b
$ CSSBox a -> CSSFont
forall a. CSSBox a -> CSSFont
font' CSSBox a
parent,
        inner :: a
inner = 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
parent,
        gridStyles :: CSSGrid
gridStyles = CSSGrid -> CSSGrid
forall a. PropertyParser a => a -> a
inherit (CSSGrid -> CSSGrid) -> CSSGrid -> CSSGrid
forall a b. (a -> b) -> a -> b
$ CSSBox a -> CSSGrid
forall a. CSSBox a -> CSSGrid
gridStyles CSSBox a
parent,
        cellStyles :: CSSCell
cellStyles = CSSCell -> CSSCell
forall a. PropertyParser a => a -> a
inherit (CSSCell -> CSSCell) -> CSSCell -> CSSCell
forall a b. (a -> b) -> a -> b
$ CSSBox a -> CSSCell
forall a. CSSBox a -> CSSCell
cellStyles CSSBox a
parent,
        inlineStyles :: CSSInline
inlineStyles = CSSInline -> CSSInline
forall a. PropertyParser a => a -> a
inherit (CSSInline -> CSSInline) -> CSSInline -> CSSInline
forall a b. (a -> b) -> a -> b
$ CSSBox a -> CSSInline
forall a. CSSBox a -> CSSInline
inlineStyles CSSBox a
parent,
        captionBelow :: Bool
captionBelow = CSSBox a -> Bool
forall a. CSSBox a -> Bool
captionBelow CSSBox a
parent,
        pageOptions :: PageOptions
pageOptions = CSSBox a -> PageOptions
forall a. CSSBox a -> PageOptions
pageOptions CSSBox a
parent
      }

    -- Wasn't sure how to implement in FontConfig-Pure
    longhand :: CSSBox a -> CSSBox a -> Text -> [Token] -> Maybe (CSSBox a)
longhand _ self :: CSSBox a
self "font-family" [Ident "initial"] =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { font :: Pattern
font = String -> Pattern -> Pattern
forall a b. Eq a => a -> [(a, b)] -> [(a, b)]
unset "family" (Pattern -> Pattern) -> Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ CSSBox a -> Pattern
forall a. CSSBox a -> Pattern
font CSSBox a
self}

    longhand _ self :: CSSBox a
self "box-sizing" [Ident "content-box"] = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self {boxSizing :: BoxSizing
boxSizing = BoxSizing
ContentBox}
    longhand _ self :: CSSBox a
self "box-sizing" [Ident "border-box"] = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self {boxSizing :: BoxSizing
boxSizing = BoxSizing
BorderBox}
    longhand _ self :: CSSBox a
self "box-sizing" [Ident "initial"] = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self {boxSizing :: BoxSizing
boxSizing = BoxSizing
ContentBox}

    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "padding-top" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { padding :: Border Unitted Unitted
padding = (PaddedBox Unitted Unitted -> Border Unitted Unitted
forall m n. PaddedBox m n -> Border m n
padding PaddedBox Unitted Unitted
box) { top :: Unitted
top = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "padding-bottom" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { padding :: Border Unitted Unitted
padding = (PaddedBox Unitted Unitted -> Border Unitted Unitted
forall m n. PaddedBox m n -> Border m n
padding PaddedBox Unitted Unitted
box) { bottom :: Unitted
bottom = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "padding-left" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { padding :: Border Unitted Unitted
padding = (PaddedBox Unitted Unitted -> Border Unitted Unitted
forall m n. PaddedBox m n -> Border m n
padding PaddedBox Unitted Unitted
box) { left :: Unitted
left = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "padding-right" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { padding :: Border Unitted Unitted
padding = (PaddedBox Unitted Unitted -> Border Unitted Unitted
forall m n. PaddedBox m n -> Border m n
padding PaddedBox Unitted Unitted
box) { right :: Unitted
right = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "border-top-width" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { border :: Border Unitted Unitted
border = (PaddedBox Unitted Unitted -> Border Unitted Unitted
forall m n. PaddedBox m n -> Border m n
border PaddedBox Unitted Unitted
box) { top :: Unitted
top = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "border-bottom-width" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { border :: Border Unitted Unitted
border = (PaddedBox Unitted Unitted -> Border Unitted Unitted
forall m n. PaddedBox m n -> Border m n
border PaddedBox Unitted Unitted
box) { bottom :: Unitted
bottom = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "border-left-width" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { border :: Border Unitted Unitted
border = (PaddedBox Unitted Unitted -> Border Unitted Unitted
forall m n. PaddedBox m n -> Border m n
border PaddedBox Unitted Unitted
box) { left :: Unitted
left = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "border-right-width" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { border :: Border Unitted Unitted
border = (PaddedBox Unitted Unitted -> Border Unitted Unitted
forall m n. PaddedBox m n -> Border m n
border PaddedBox Unitted Unitted
box) { right :: Unitted
right = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "margin-top" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { margin :: Border Unitted Unitted
margin = (PaddedBox Unitted Unitted -> Border Unitted Unitted
forall m n. PaddedBox m n -> Border m n
margin PaddedBox Unitted Unitted
box) { top :: Unitted
top = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "margin-bottom" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { margin :: Border Unitted Unitted
margin = (PaddedBox Unitted Unitted -> Border Unitted Unitted
forall m n. PaddedBox m n -> Border m n
margin PaddedBox Unitted Unitted
box) { bottom :: Unitted
bottom = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "margin-left" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { margin :: Border Unitted Unitted
margin = (PaddedBox Unitted Unitted -> Border Unitted Unitted
forall m n. PaddedBox m n -> Border m n
margin PaddedBox Unitted Unitted
box) { left :: Unitted
left = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "margin-right" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { margin :: Border Unitted Unitted
margin = (PaddedBox Unitted Unitted -> Border Unitted Unitted
forall m n. PaddedBox m n -> Border m n
margin PaddedBox Unitted Unitted
box) { right :: Unitted
right = Unitted
x } } }

    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "width" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength' [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { size :: Size Unitted Unitted
size = (PaddedBox Unitted Unitted -> Size Unitted Unitted
forall m n. PaddedBox m n -> Size m n
size PaddedBox Unitted Unitted
box) { inline :: Unitted
inline = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "height" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength' [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { size :: Size Unitted Unitted
size = (PaddedBox Unitted Unitted -> Size Unitted Unitted
forall m n. PaddedBox m n -> Size m n
size PaddedBox Unitted Unitted
box) { block :: Unitted
block = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "max-width" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength' [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { max :: Size Unitted Unitted
B.max = (PaddedBox Unitted Unitted -> Size Unitted Unitted
forall m n. PaddedBox m n -> Size m n
B.max PaddedBox Unitted Unitted
box) { inline :: Unitted
inline = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "min-width" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength' [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { min :: Size Unitted Unitted
B.min = (PaddedBox Unitted Unitted -> Size Unitted Unitted
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox Unitted Unitted
box) { inline :: Unitted
inline = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "max-height" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength' [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { max :: Size Unitted Unitted
B.max = (PaddedBox Unitted Unitted -> Size Unitted Unitted
forall m n. PaddedBox m n -> Size m n
B.max PaddedBox Unitted Unitted
box) { block :: Unitted
block = Unitted
x } } }
    longhand _ self :: CSSBox a
self@CSSBox {cssBox :: forall a. CSSBox a -> PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box} "min-height" toks :: [Token]
toks | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength' [Token]
toks =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { cssBox :: PaddedBox Unitted Unitted
cssBox = PaddedBox Unitted Unitted
box { min :: Size Unitted Unitted
B.min = (PaddedBox Unitted Unitted -> Size Unitted Unitted
forall m n. PaddedBox m n -> Size m n
B.min PaddedBox Unitted Unitted
box) { block :: Unitted
block = Unitted
x } } }

    longhand _ self :: CSSBox a
self "display" [Ident "block"] = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { display :: Display
display = Display
Block }
    longhand _ self :: CSSBox a
self "display" [Ident "none"] = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { display :: Display
display = Display
None }
    longhand _ self :: CSSBox a
self "display" [Ident "grid"] = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { display :: Display
display = Display
Grid }
    {-longhand _ self "display" [Ident "table"] = Just self { display = Table }
    longhand CSSBox { display = Table } self "display" [Ident "table-row-group"] =
        Just self { display=TableRowGroup }
    longhand CSSBox { display = Table } self "display" [Ident "table-header-group"] =
        Just self { display = TableHeaderGroup }
    longhand CSSBox { display = Table } self "display" [Ident "table-footer-group"] =
        Just self { display = TableFooterGroup }
    longhand parent self "display" [Ident "table-row"] | rowContainer parent =
        Just self { display = TableRow }
    longhand CSSBox { display = TableRow } self "display" [Ident "table-cell"] =
        Just self { display = TableCell }
    longhand CSSBox { display = Table } self "display" [Ident "table-column-group"] =
        Just self { display = TableColumnGroup }
    longhand CSSBox { display = TableColumnGroup } self "display" [Ident "table-column"] =
        Just self { display = TableColumn }
    longhand CSSBox { display = Table } self "display" [Ident "table-caption"] =
        Just self { display=TableCaption } -}
    longhand _ self :: CSSBox a
self "display" [Ident "inline"] = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { display :: Display
display = Display
Inline }
    longhand _ self :: CSSBox a
self "display" [Ident "initial"] = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { display :: Display
display = Display
Inline }

    longhand _ self :: CSSBox a
self "caption-side" [Ident "top"] = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { captionBelow :: Bool
captionBelow = Bool
False }
    longhand _ self :: CSSBox a
self "caption-side" [Ident "bottom"] = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { captionBelow :: Bool
captionBelow = Bool
True }
    longhand _ self :: CSSBox a
self "caption-side" [Ident "initial"] = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self {captionBelow :: Bool
captionBelow = Bool
False}

    longhand _ self :: CSSBox a
self "orphans" [Number _ (NVInteger x :: Integer
x)] =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { pageOptions :: PageOptions
pageOptions = (CSSBox a -> PageOptions
forall a. CSSBox a -> PageOptions
pageOptions CSSBox a
self) { pageOrphans :: Word
pageOrphans = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
x } }
    longhand _ self :: CSSBox a
self "widows" [Number _ (NVInteger x :: Integer
x)] =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
self { pageOptions :: PageOptions
pageOptions = (CSSBox a -> PageOptions
forall a. CSSBox a -> PageOptions
pageOptions CSSBox a
self) { pageWidows :: Word
pageWidows = Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
x } }

    longhand a :: CSSBox a
a b :: CSSBox a
b c :: Text
c d :: [Token]
d | Just x :: Pattern
x <- Pattern -> Pattern -> Text -> [Token] -> Maybe Pattern
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (CSSBox a -> Pattern
forall a. CSSBox a -> Pattern
font CSSBox a
a) (CSSBox a -> Pattern
forall a. CSSBox a -> Pattern
font CSSBox a
b) Text
c [Token]
d,
        Just y :: CSSFont
y <- CSSFont -> CSSFont -> Text -> [Token] -> Maybe CSSFont
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (CSSBox a -> CSSFont
forall a. CSSBox a -> CSSFont
font' CSSBox a
a) (CSSBox a -> CSSFont
forall a. CSSBox a -> CSSFont
font' CSSBox a
b) Text
c [Token]
d =
            CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
b { font :: Pattern
font = Pattern
x, font' :: CSSFont
font' = CSSFont
y } -- Those properties can overlap!
    longhand a :: CSSBox a
a b :: CSSBox a
b c :: Text
c d :: [Token]
d | Just font' :: Pattern
font' <- Pattern -> Pattern -> Text -> [Token] -> Maybe Pattern
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (CSSBox a -> Pattern
forall a. CSSBox a -> Pattern
font CSSBox a
a) (CSSBox a -> Pattern
forall a. CSSBox a -> Pattern
font CSSBox a
b) Text
c [Token]
d = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
b {
        font :: Pattern
font = Pattern
font'
      }
    longhand a :: CSSBox a
a b :: CSSBox a
b c :: Text
c d :: [Token]
d | Just font :: CSSFont
font <- CSSFont -> CSSFont -> Text -> [Token] -> Maybe CSSFont
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (CSSBox a -> CSSFont
forall a. CSSBox a -> CSSFont
font' CSSBox a
a) (CSSBox a -> CSSFont
forall a. CSSBox a -> CSSFont
font' CSSBox a
b) Text
c [Token]
d = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
b {
        font' :: CSSFont
font' = CSSFont
font
      }
    longhand a :: CSSBox a
a b :: CSSBox a
b c :: Text
c d :: [Token]
d | Just inline' :: CSSInline
inline' <- CSSInline -> CSSInline -> Text -> [Token] -> Maybe CSSInline
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (CSSBox a -> CSSInline
forall a. CSSBox a -> CSSInline
inlineStyles CSSBox a
a) (CSSBox a -> CSSInline
forall a. CSSBox a -> CSSInline
inlineStyles CSSBox a
b) Text
c [Token]
d =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
b { inlineStyles :: CSSInline
inlineStyles = CSSInline
inline' }
    longhand a :: CSSBox a
a b :: CSSBox a
b c :: Text
c d :: [Token]
d | Just grid' :: CSSGrid
grid' <- CSSGrid -> CSSGrid -> Text -> [Token] -> Maybe CSSGrid
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (CSSBox a -> CSSGrid
forall a. CSSBox a -> CSSGrid
gridStyles CSSBox a
a) (CSSBox a -> CSSGrid
forall a. CSSBox a -> CSSGrid
gridStyles CSSBox a
b) Text
c [Token]
d =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
b { gridStyles :: CSSGrid
gridStyles = CSSGrid
grid' }
    longhand a :: CSSBox a
a b :: CSSBox a
b c :: Text
c d :: [Token]
d | Just cell' :: CSSCell
cell' <- CSSCell -> CSSCell -> Text -> [Token] -> Maybe CSSCell
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (CSSBox a -> CSSCell
forall a. CSSBox a -> CSSCell
cellStyles CSSBox a
a) (CSSBox a -> CSSCell
forall a. CSSBox a -> CSSCell
cellStyles CSSBox a
b) Text
c [Token]
d =
        CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
b { cellStyles :: CSSCell
cellStyles = CSSCell
cell' }
    longhand a :: CSSBox a
a b :: CSSBox a
b c :: Text
c d :: [Token]
d | Just inner' :: a
inner' <- a -> a -> Text -> [Token] -> Maybe a
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (CSSBox a -> a
forall a. CSSBox a -> a
inner CSSBox a
a) (CSSBox a -> a
forall a. CSSBox a -> a
inner CSSBox a
b) Text
c [Token]
d = CSSBox a -> Maybe (CSSBox a)
forall a. a -> Maybe a
Just CSSBox a
b {
        inner :: a
inner = a
inner'
      }
    longhand _ _ _ _ = Maybe (CSSBox a)
forall a. Maybe a
Nothing

-- | 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'
-> x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
forall x.
PropertyParser x =>
Font'
-> Font'
-> x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds 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
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'
-> x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
forall x.
PropertyParser x =>
Font'
-> Font'
-> x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds Font'
root Font'
font_ x
val [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' -> x -> [StyleTree (CSSBox x)] ->
        [LayoutItem Length Length x]
finalizeChilds :: Font'
-> Font'
-> x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds root :: Font'
root parent :: Font'
parent style' :: 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'
-> x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
forall x.
PropertyParser x =>
Font'
-> Font'
-> x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds Font'
root Font'
parent x
style' [StyleTree (CSSBox x)]
childs
finalizeChilds root :: Font'
root parent :: Font'
parent style' :: 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
self <- ParagraphBuilder -> Font' -> Maybe Paragraph
finalizeParagraph ([StyleTree (CSSBox x)] -> ParagraphBuilder
forall a. [StyleTree (CSSBox a)] -> ParagraphBuilder
flattenTree [StyleTree (CSSBox x)]
childs) Font'
parent =
        -- FIXME propagate display properties, how to handle the hierarchy.
        -- NOTE: Playing around in firefox, it appears the CSS borders should cover
        -- their entire span, doubling up on borders where needed.
        [x
-> Font'
-> Paragraph
-> PageOptions
-> [x]
-> LayoutItem Length Length x
forall m n x.
x -> Font' -> Paragraph -> PageOptions -> [x] -> LayoutItem m n x
LayoutInline (x -> x
forall a. PropertyParser a => a -> a
inherit x
style') Font'
parent Paragraph
self PageOptions
paging (x -> [x]
forall a. a -> [a]
repeat (x -> [x]) -> x -> [x]
forall a b. (a -> b) -> a -> b
$ x -> x
forall a. PropertyParser a => a -> a
inherit x
style')]
    | (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
self <- ParagraphBuilder -> Font' -> Maybe Paragraph
finalizeParagraph ([StyleTree (CSSBox x)] -> ParagraphBuilder
forall a. [StyleTree (CSSBox a)] -> ParagraphBuilder
flattenTree [StyleTree (CSSBox x)]
inlines) Font'
parent  =
            x
-> Font'
-> Paragraph
-> PageOptions
-> [x]
-> LayoutItem Length Length x
forall m n x.
x -> Font' -> Paragraph -> PageOptions -> [x] -> LayoutItem m n x
LayoutInline (x -> x
forall a. PropertyParser a => a -> a
inherit x
style') Font'
parent Paragraph
self PageOptions
paging (x -> [x]
forall a. a -> [a]
repeat (x -> [x]) -> x -> [x]
forall a b. (a -> b) -> a -> b
$ x -> x
forall a. PropertyParser a => a -> a
inherit x
style') 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 x.
PropertyParser x =>
Font'
-> Font'
-> x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds Font'
root Font'
parent 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'
-> x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
forall x.
PropertyParser x =>
Font'
-> Font'
-> x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds Font'
root Font'
parent 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'
-> x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
forall x.
PropertyParser x =>
Font'
-> Font'
-> x
-> [StyleTree (CSSBox x)]
-> [LayoutItem Length Length x]
finalizeChilds Font'
root Font'
parent 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
    flattenTree :: [StyleTree (CSSBox a)] -> ParagraphBuilder
flattenTree (StyleTree { children :: forall p. StyleTree p -> [StyleTree p]
children = child :: [StyleTree (CSSBox a)]
child@(_:_) }:childs :: [StyleTree (CSSBox a)]
childs) =
        [StyleTree (CSSBox a)] -> ParagraphBuilder
flattenTree [StyleTree (CSSBox a)]
child ParagraphBuilder -> ParagraphBuilder -> ParagraphBuilder
`concatParagraph` [StyleTree (CSSBox a)] -> ParagraphBuilder
flattenTree [StyleTree (CSSBox a)]
childs
    flattenTree (child :: StyleTree (CSSBox a)
child:childs :: [StyleTree (CSSBox a)]
childs) =
        CSSInline -> ParagraphBuilder
buildParagraph (CSSBox a -> CSSInline
forall a. CSSBox a -> CSSInline
inlineStyles (CSSBox a -> CSSInline) -> CSSBox a -> CSSInline
forall a b. (a -> b) -> a -> b
$ StyleTree (CSSBox a) -> CSSBox a
forall p. StyleTree p -> p
style StyleTree (CSSBox a)
child) ParagraphBuilder -> ParagraphBuilder -> ParagraphBuilder
`concatParagraph` [StyleTree (CSSBox a)] -> ParagraphBuilder
flattenTree [StyleTree (CSSBox a)]
childs
    flattenTree [] = Text -> [Span] -> ParagraphBuilder
ParagraphBuilder "" []
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 ) =
        -}