{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
-- | Infrastructure for parsing & desugaring text related CSS properties.
module Graphics.Layout.Inline.CSS(
    CSSInline(..), Default(..), UnicodeBidi(..), applyFontInline, applyBidi,
    resolveVAlign, resolveBoxOpts, plaintext) where

import Data.CSS.Syntax.Tokens (Token(..))
import Stylist (PropertyParser(..))
import qualified Data.Text as Txt
import Data.Text (Text)
import Data.Text.ParagraphLayout.Rich
import Data.Text.Glyphize (Direction(..))

import Graphics.Layout.CSS.Font (Font'(..), hbUnit)
import Graphics.Layout.CSS.Length (finalizeLength, Unitted)
import Graphics.Layout.Box (Length(..))
import Graphics.Layout.Grid.Table (TableOptions(..)) -- for VAlign
import Data.Char (isSpace)
import Data.Int (Int32)
import Debug.Trace (trace) -- To report unexpected cases.

-- | Document text with Balkón styling options, CSS stylable.
data CSSInline = CSSInline Txt.Text TextOptions UnicodeBidi
-- | To what degree is the text direction isolated?
data UnicodeBidi = BdNormal | BdEmbed | BdOverride | BdIsolate
        | BdIsolateOverride | BdPlainText deriving (UnicodeBidi -> UnicodeBidi -> Bool
(UnicodeBidi -> UnicodeBidi -> Bool)
-> (UnicodeBidi -> UnicodeBidi -> Bool) -> Eq UnicodeBidi
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnicodeBidi -> UnicodeBidi -> Bool
== :: UnicodeBidi -> UnicodeBidi -> Bool
$c/= :: UnicodeBidi -> UnicodeBidi -> Bool
/= :: UnicodeBidi -> UnicodeBidi -> Bool
Eq, Eq UnicodeBidi
Eq UnicodeBidi
-> (UnicodeBidi -> UnicodeBidi -> Ordering)
-> (UnicodeBidi -> UnicodeBidi -> Bool)
-> (UnicodeBidi -> UnicodeBidi -> Bool)
-> (UnicodeBidi -> UnicodeBidi -> Bool)
-> (UnicodeBidi -> UnicodeBidi -> Bool)
-> (UnicodeBidi -> UnicodeBidi -> UnicodeBidi)
-> (UnicodeBidi -> UnicodeBidi -> UnicodeBidi)
-> Ord UnicodeBidi
UnicodeBidi -> UnicodeBidi -> Bool
UnicodeBidi -> UnicodeBidi -> Ordering
UnicodeBidi -> UnicodeBidi -> UnicodeBidi
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnicodeBidi -> UnicodeBidi -> Ordering
compare :: UnicodeBidi -> UnicodeBidi -> Ordering
$c< :: UnicodeBidi -> UnicodeBidi -> Bool
< :: UnicodeBidi -> UnicodeBidi -> Bool
$c<= :: UnicodeBidi -> UnicodeBidi -> Bool
<= :: UnicodeBidi -> UnicodeBidi -> Bool
$c> :: UnicodeBidi -> UnicodeBidi -> Bool
> :: UnicodeBidi -> UnicodeBidi -> Bool
$c>= :: UnicodeBidi -> UnicodeBidi -> Bool
>= :: UnicodeBidi -> UnicodeBidi -> Bool
$cmax :: UnicodeBidi -> UnicodeBidi -> UnicodeBidi
max :: UnicodeBidi -> UnicodeBidi -> UnicodeBidi
$cmin :: UnicodeBidi -> UnicodeBidi -> UnicodeBidi
min :: UnicodeBidi -> UnicodeBidi -> UnicodeBidi
Ord, Int -> UnicodeBidi
UnicodeBidi -> Int
UnicodeBidi -> [UnicodeBidi]
UnicodeBidi -> UnicodeBidi
UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
UnicodeBidi -> UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
(UnicodeBidi -> UnicodeBidi)
-> (UnicodeBidi -> UnicodeBidi)
-> (Int -> UnicodeBidi)
-> (UnicodeBidi -> Int)
-> (UnicodeBidi -> [UnicodeBidi])
-> (UnicodeBidi -> UnicodeBidi -> [UnicodeBidi])
-> (UnicodeBidi -> UnicodeBidi -> [UnicodeBidi])
-> (UnicodeBidi -> UnicodeBidi -> UnicodeBidi -> [UnicodeBidi])
-> Enum UnicodeBidi
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: UnicodeBidi -> UnicodeBidi
succ :: UnicodeBidi -> UnicodeBidi
$cpred :: UnicodeBidi -> UnicodeBidi
pred :: UnicodeBidi -> UnicodeBidi
$ctoEnum :: Int -> UnicodeBidi
toEnum :: Int -> UnicodeBidi
$cfromEnum :: UnicodeBidi -> Int
fromEnum :: UnicodeBidi -> Int
$cenumFrom :: UnicodeBidi -> [UnicodeBidi]
enumFrom :: UnicodeBidi -> [UnicodeBidi]
$cenumFromThen :: UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
enumFromThen :: UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
$cenumFromTo :: UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
enumFromTo :: UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
$cenumFromThenTo :: UnicodeBidi -> UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
enumFromThenTo :: UnicodeBidi -> UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
Enum, ReadPrec [UnicodeBidi]
ReadPrec UnicodeBidi
Int -> ReadS UnicodeBidi
ReadS [UnicodeBidi]
(Int -> ReadS UnicodeBidi)
-> ReadS [UnicodeBidi]
-> ReadPrec UnicodeBidi
-> ReadPrec [UnicodeBidi]
-> Read UnicodeBidi
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS UnicodeBidi
readsPrec :: Int -> ReadS UnicodeBidi
$creadList :: ReadS [UnicodeBidi]
readList :: ReadS [UnicodeBidi]
$creadPrec :: ReadPrec UnicodeBidi
readPrec :: ReadPrec UnicodeBidi
$creadListPrec :: ReadPrec [UnicodeBidi]
readListPrec :: ReadPrec [UnicodeBidi]
Read, Int -> UnicodeBidi -> ShowS
[UnicodeBidi] -> ShowS
UnicodeBidi -> [Char]
(Int -> UnicodeBidi -> ShowS)
-> (UnicodeBidi -> [Char])
-> ([UnicodeBidi] -> ShowS)
-> Show UnicodeBidi
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnicodeBidi -> ShowS
showsPrec :: Int -> UnicodeBidi -> ShowS
$cshow :: UnicodeBidi -> [Char]
show :: UnicodeBidi -> [Char]
$cshowList :: [UnicodeBidi] -> ShowS
showList :: [UnicodeBidi] -> ShowS
Show)

-- | Construct plain text
plaintext :: Txt.Text -> CSSInline
plaintext :: Text -> CSSInline
plaintext Text
txt = Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
txt (Direction -> TextOptions
defaultTextOptions Direction
DirLTR) UnicodeBidi
BdNormal

instance PropertyParser CSSInline where
    temp :: CSSInline
temp = Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
"" (Direction -> TextOptions
defaultTextOptions Direction
DirLTR) UnicodeBidi
BdNormal
    inherit :: CSSInline -> CSSInline
inherit (CSSInline Text
_ TextOptions
opts UnicodeBidi
_) = Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
"" TextOptions
opts UnicodeBidi
BdNormal
    priority :: CSSInline -> [Text]
priority CSSInline
_ = [Text
"direction"] -- To inform logical spacing in caller!

    longhand :: CSSInline -> CSSInline -> Text -> [Token] -> Maybe CSSInline
longhand CSSInline
_ (CSSInline Text
_ TextOptions
opts UnicodeBidi
bidi) Text
"content" [Ident Text
"initial"] =
        CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
"" TextOptions
opts UnicodeBidi
bidi
    longhand CSSInline
_ (CSSInline Text
_ TextOptions
opts UnicodeBidi
bidi) Text
"content" [Token]
toks
        | (Token -> Bool) -> [Token] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Token -> Bool
isString [Token]
toks =
            CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline ([Text] -> Text
Txt.concat [Text
x | String Text
x <- [Token]
toks]) TextOptions
opts UnicodeBidi
bidi
      where
        isString :: Token -> Bool
isString (String Text
_) = Bool
True
        isString Token
_ = Bool
False

    longhand CSSInline
_ (CSSInline Text
t TextOptions
o UnicodeBidi
b) Text
"-argo-lang" [Ident Text
kw]
        | Text
kw Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"initial", Text
"auto"] = CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
t TextOptions
o {textLanguage :: [Char]
textLanguage=[Char]
""} UnicodeBidi
b
    longhand CSSInline
_ (CSSInline Text
txt TextOptions
opts UnicodeBidi
bidi) Text
"-argo-lang" [String Text
x] =
        CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
txt TextOptions
opts { textLanguage :: [Char]
textLanguage = Text -> [Char]
Txt.unpack Text
x } UnicodeBidi
bidi

    longhand CSSInline
_ (CSSInline Text
txt TextOptions
opts UnicodeBidi
bidi) Text
"direction" [Ident Text
"ltr"] =
        CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
txt TextOptions
opts { textDirection :: Direction
textDirection = Direction
DirLTR } UnicodeBidi
bidi
    longhand CSSInline
_ (CSSInline Text
txt TextOptions
opts UnicodeBidi
bidi) Text
"direction" [Ident Text
"rtl"] =
        CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
txt TextOptions
opts { textDirection :: Direction
textDirection = Direction
DirRTL } UnicodeBidi
bidi
    longhand CSSInline
_ (CSSInline Text
txt TextOptions
opts UnicodeBidi
bidi) Text
"direction" [Ident Text
"initial"] =
        CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
txt TextOptions
opts { textDirection :: Direction
textDirection = Direction
DirLTR } UnicodeBidi
bidi

    longhand CSSInline
_ (CSSInline Text
txt TextOptions
opts UnicodeBidi
_) Text
"unicode-bidi" [Ident Text
"initial"] =
        CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
txt TextOptions
opts UnicodeBidi
BdNormal
    longhand CSSInline
_ (CSSInline Text
txt TextOptions
opts UnicodeBidi
_) Text
"unicode-bidi" [Ident Text
"normal"] =
        CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
txt TextOptions
opts UnicodeBidi
BdNormal
    longhand CSSInline
_ (CSSInline Text
txt TextOptions
opts UnicodeBidi
_) Text
"unicode-bidi" [Ident Text
"embed"] =
        CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
txt TextOptions
opts UnicodeBidi
BdEmbed
    longhand CSSInline
_ (CSSInline Text
txt TextOptions
opts UnicodeBidi
_) Text
"unicode-bidi" [Ident Text
"isolate"] =
        CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
txt TextOptions
opts UnicodeBidi
BdIsolate
    longhand CSSInline
_ (CSSInline Text
txt TextOptions
opts UnicodeBidi
_) Text
"unicode-bidi" [Ident Text
"bidi-override"] =
        CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
txt TextOptions
opts UnicodeBidi
BdOverride
    longhand CSSInline
_ (CSSInline Text
txt TextOptions
opts UnicodeBidi
_) Text
"unicode-bidi" [Ident Text
"isolate-override"] =
        CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
txt TextOptions
opts UnicodeBidi
BdIsolateOverride
    longhand CSSInline
_ (CSSInline Text
txt TextOptions
opts UnicodeBidi
_) Text
"unicode-bidi" [Ident Text
"plaintext"] =
        CSSInline -> Maybe CSSInline
forall a. a -> Maybe a
Just (CSSInline -> Maybe CSSInline) -> CSSInline -> Maybe CSSInline
forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
txt TextOptions
opts UnicodeBidi
BdPlainText
    longhand CSSInline
_ CSSInline
_ Text
_ [Token]
_ = Maybe CSSInline
forall a. Maybe a
Nothing

-- | Fills in properties from looked-up fonts.
applyFontInline :: TextOptions -> Font' -> TextOptions
applyFontInline :: TextOptions -> Font' -> TextOptions
applyFontInline TextOptions
opts Font'
font = TextOptions
opts {
    textFont :: Font
textFont = Font' -> Font
hbFont Font'
font,
    textLineHeight :: LineHeight
textLineHeight = Int32 -> LineHeight
Absolute (Int32 -> LineHeight) -> Int32 -> LineHeight
forall a b. (a -> b) -> a -> b
$ Double -> Int32
toHB (Double -> Int32) -> Double -> Int32
forall a b. (a -> b) -> a -> b
$ Font' -> Double
lineheight Font'
font
  }
-- | Apply Bidi chars around the inline text. FIXME: Handle the tree!
applyBidi :: Default d => CSSInline -> [InnerNode Text d] -> [InnerNode Text d]
applyBidi :: forall d.
Default d =>
CSSInline -> [InnerNode Text d] -> [InnerNode Text d]
applyBidi (CSSInline Text
_ TextOptions
_ UnicodeBidi
BdNormal) [InnerNode Text d]
txt = [InnerNode Text d]
txt
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirLTR) UnicodeBidi
BdEmbed) [InnerNode Text d]
txt =
    InnerNode Text d
forall a. Default a => InnerNode Text a
chLREmbedInnerNode Text d -> [InnerNode Text d] -> [InnerNode Text d]
forall a. a -> [a] -> [a]
:[InnerNode Text d]
txt[InnerNode Text d] -> InnerNode Text d -> [InnerNode Text d]
forall {a}. [a] -> a -> [a]
+:InnerNode Text d
forall a. Default a => InnerNode Text a
chPopDir
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirRTL) UnicodeBidi
BdEmbed) [InnerNode Text d]
txt =
    InnerNode Text d
forall a. Default a => InnerNode Text a
chRLEmbedInnerNode Text d -> [InnerNode Text d] -> [InnerNode Text d]
forall a. a -> [a] -> [a]
:[InnerNode Text d]
txt[InnerNode Text d] -> InnerNode Text d -> [InnerNode Text d]
forall {a}. [a] -> a -> [a]
+:InnerNode Text d
forall a. Default a => InnerNode Text a
chPopDir
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirLTR) UnicodeBidi
BdIsolate) [InnerNode Text d]
txt =
    InnerNode Text d
forall a. Default a => InnerNode Text a
chLRIsolateInnerNode Text d -> [InnerNode Text d] -> [InnerNode Text d]
forall a. a -> [a] -> [a]
:[InnerNode Text d]
txt[InnerNode Text d] -> InnerNode Text d -> [InnerNode Text d]
forall {a}. [a] -> a -> [a]
+:InnerNode Text d
forall a. Default a => InnerNode Text a
chPopDirIsolate
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirRTL) UnicodeBidi
BdIsolate) [InnerNode Text d]
txt =
    InnerNode Text d
forall a. Default a => InnerNode Text a
chRLIsolateInnerNode Text d -> [InnerNode Text d] -> [InnerNode Text d]
forall a. a -> [a] -> [a]
:[InnerNode Text d]
txt[InnerNode Text d] -> InnerNode Text d -> [InnerNode Text d]
forall {a}. [a] -> a -> [a]
+:InnerNode Text d
forall a. Default a => InnerNode Text a
chPopDirIsolate
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirLTR) UnicodeBidi
BdOverride) [InnerNode Text d]
txt =
    InnerNode Text d
forall a. Default a => InnerNode Text a
chLROverrideInnerNode Text d -> [InnerNode Text d] -> [InnerNode Text d]
forall a. a -> [a] -> [a]
:[InnerNode Text d]
txt[InnerNode Text d] -> InnerNode Text d -> [InnerNode Text d]
forall {a}. [a] -> a -> [a]
+:InnerNode Text d
forall a. Default a => InnerNode Text a
chPopDir
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirRTL) UnicodeBidi
BdOverride) [InnerNode Text d]
txt =
    InnerNode Text d
forall a. Default a => InnerNode Text a
chRLOverrideInnerNode Text d -> [InnerNode Text d] -> [InnerNode Text d]
forall a. a -> [a] -> [a]
:[InnerNode Text d]
txt[InnerNode Text d] -> InnerNode Text d -> [InnerNode Text d]
forall {a}. [a] -> a -> [a]
+:InnerNode Text d
forall a. Default a => InnerNode Text a
chPopDir
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirLTR) UnicodeBidi
BdIsolateOverride) [InnerNode Text d]
txt =
    InnerNode Text d
forall a. Default a => InnerNode Text a
ch1stStrongIsolateInnerNode Text d -> [InnerNode Text d] -> [InnerNode Text d]
forall a. a -> [a] -> [a]
:InnerNode Text d
forall a. Default a => InnerNode Text a
chLROverrideInnerNode Text d -> [InnerNode Text d] -> [InnerNode Text d]
forall a. a -> [a] -> [a]
:[InnerNode Text d]
txt[InnerNode Text d] -> InnerNode Text d -> [InnerNode Text d]
forall {a}. [a] -> a -> [a]
+:InnerNode Text d
forall a. Default a => InnerNode Text a
chPopDir[InnerNode Text d] -> InnerNode Text d -> [InnerNode Text d]
forall {a}. [a] -> a -> [a]
+:InnerNode Text d
forall a. Default a => InnerNode Text a
chPopDirIsolate
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirRTL) UnicodeBidi
BdIsolateOverride) [InnerNode Text d]
txt =
    InnerNode Text d
forall a. Default a => InnerNode Text a
ch1stStrongIsolateInnerNode Text d -> [InnerNode Text d] -> [InnerNode Text d]
forall a. a -> [a] -> [a]
:InnerNode Text d
forall a. Default a => InnerNode Text a
chRLOverrideInnerNode Text d -> [InnerNode Text d] -> [InnerNode Text d]
forall a. a -> [a] -> [a]
:[InnerNode Text d]
txt[InnerNode Text d] -> InnerNode Text d -> [InnerNode Text d]
forall {a}. [a] -> a -> [a]
+:InnerNode Text d
forall a. Default a => InnerNode Text a
chPopDir[InnerNode Text d] -> InnerNode Text d -> [InnerNode Text d]
forall {a}. [a] -> a -> [a]
+:InnerNode Text d
forall a. Default a => InnerNode Text a
chPopDirIsolate
applyBidi (CSSInline Text
_ TextOptions
_ UnicodeBidi
BdPlainText) [InnerNode Text d]
txt =
    InnerNode Text d
forall a. Default a => InnerNode Text a
ch1stStrongIsolateInnerNode Text d -> [InnerNode Text d] -> [InnerNode Text d]
forall a. a -> [a] -> [a]
:[InnerNode Text d]
txt[InnerNode Text d] -> InnerNode Text d -> [InnerNode Text d]
forall {a}. [a] -> a -> [a]
+:InnerNode Text d
forall a. Default a => InnerNode Text a
chPopDirIsolate
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
dir) UnicodeBidi
_) [InnerNode Text d]
txt =
    [Char] -> [InnerNode Text d] -> [InnerNode Text d]
forall a. [Char] -> a -> a
trace ([Char]
"Unexpected direction! " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Direction -> [Char]
forall a. Show a => a -> [Char]
show Direction
dir) [InnerNode Text d]
txt

-- | Append a single character to the end of a string.
[a]
a +: :: [a] -> a -> [a]
+: a
b = [a]
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
b]

chLREmbed, chRLEmbed, chLROverride, chRLOverride, chPopDir,
    chLRIsolate, chRLIsolate, ch1stStrongIsolate, chPopDirIsolate :: Default a =>
        InnerNode Text a
chLREmbed :: forall a. Default a => InnerNode Text a
chLREmbed = Char -> InnerNode Text a
forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x202A'
chRLEmbed :: forall a. Default a => InnerNode Text a
chRLEmbed = Char -> InnerNode Text a
forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x202B'
chLROverride :: forall a. Default a => InnerNode Text a
chLROverride = Char -> InnerNode Text a
forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x202D'
chRLOverride :: forall a. Default a => InnerNode Text a
chRLOverride = Char -> InnerNode Text a
forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x202E'
chPopDir :: forall a. Default a => InnerNode Text a
chPopDir = Char -> InnerNode Text a
forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x202C'
chLRIsolate :: forall a. Default a => InnerNode Text a
chLRIsolate = Char -> InnerNode Text a
forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x2066'
chRLIsolate :: forall a. Default a => InnerNode Text a
chRLIsolate = Char -> InnerNode Text a
forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x2067'
ch1stStrongIsolate :: forall a. Default a => InnerNode Text a
ch1stStrongIsolate = Char -> InnerNode Text a
forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x2068'
chPopDirIsolate :: forall a. Default a => InnerNode Text a
chPopDirIsolate = Char -> InnerNode Text a
forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x2069'

-- | A Balkón fragment holding a magic character.
leaf :: Char -> InnerNode Text d
leaf Char
ch = d -> Text -> InnerNode Text d
forall t d. d -> t -> InnerNode t d
TextSequence d
forall a. Default a => a
def (Text -> InnerNode Text d) -> Text -> InnerNode Text d
forall a b. (a -> b) -> a -> b
$ Char -> Text
Txt.singleton Char
ch

-- | Types with default values.
-- Used to fill in values into generated fragments from caller.
class Default a where
    def :: a

-- | Converts parsed valign keywords or length units to Balkón alignment.
resolveVAlign :: Font' -> Unitted -> VerticalAlignment
resolveVAlign :: Font' -> Unitted -> VerticalAlignment
resolveVAlign Font'
_ (Double
_,Text
"top") = VerticalAlignment
AlignLineTop
resolveVAlign Font'
_ (Double
_,Text
"super") = VerticalAlignment
AlignLineTop -- FIXME: Is there a better translation?
resolveVAlign Font'
_ (Double
_,Text
"text-top") = VerticalAlignment
AlignLineTop -- FIXME: Better translation?
resolveVAlign Font'
_ (Double
_,Text
"bottom") = VerticalAlignment
AlignLineBottom
resolveVAlign Font'
_ (Double
_,Text
"sub") = VerticalAlignment
AlignLineBottom -- FIXME: Better translation?
resolveVAlign Font'
_ (Double
_,Text
"text-bottom") = VerticalAlignment
AlignLineBottom
resolveVAlign Font'
_ (Double
_,Text
"baseline") = Int32 -> VerticalAlignment
AlignBaseline Int32
0
resolveVAlign Font'
f (Double
_,Text
"middle") = Int32 -> VerticalAlignment
AlignBaseline (Int32 -> VerticalAlignment) -> Int32 -> VerticalAlignment
forall a b. (a -> b) -> a -> b
$ Double -> Int32
toHB (Double -> Int32) -> Double -> Int32
forall a b. (a -> b) -> a -> b
$ Font' -> Char -> Double
fontHeight Font'
f Char
'x' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
resolveVAlign Font'
f Unitted
x | Pixels Double
y <- Unitted -> Font' -> Length
finalizeLength Unitted
x Font'
f = Int32 -> VerticalAlignment
AlignBaseline (Int32 -> VerticalAlignment) -> Int32 -> VerticalAlignment
forall a b. (a -> b) -> a -> b
$ Double -> Int32
toHB Double
y
    | Percent Double
y <- Unitted -> Font' -> Length
finalizeLength Unitted
x Font'
f = Int32 -> VerticalAlignment
AlignBaseline (Int32 -> VerticalAlignment) -> Int32 -> VerticalAlignment
forall a b. (a -> b) -> a -> b
$ Double -> Int32
toHB (Double -> Int32) -> Double -> Int32
forall a b. (a -> b) -> a -> b
$ Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
* Font' -> Double
lineheight Font'
f
    | Bool
otherwise = [Char] -> VerticalAlignment -> VerticalAlignment
forall a. [Char] -> a -> a
trace ([Char]
"Invalid length! " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Unitted -> [Char]
forall a. Show a => a -> [Char]
show Unitted
x) (VerticalAlignment -> VerticalAlignment)
-> VerticalAlignment -> VerticalAlignment
forall a b. (a -> b) -> a -> b
$ Int32 -> VerticalAlignment
AlignBaseline Int32
0
-- | Converts grid options to box options.
resolveBoxOpts :: Font' -> TableOptions -> BoxOptions
resolveBoxOpts Font'
f TableOptions
grid = BoxOptions
defaultBoxOptions {
    boxVerticalAlignment :: VerticalAlignment
boxVerticalAlignment = Font' -> Unitted -> VerticalAlignment
resolveVAlign Font'
f (Unitted -> VerticalAlignment) -> Unitted -> VerticalAlignment
forall a b. (a -> b) -> a -> b
$ TableOptions -> Unitted
verticalAlign TableOptions
grid
  }

-- | Convert from CatTrap units to Balkón|Harfbuzz units.
toHB :: Double -> Int32
toHB :: Double -> Int32
toHB = Int -> Int32
forall a. Enum a => Int -> a
toEnum (Int -> Int32) -> (Double -> Int) -> Double -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a. Enum a => a -> Int
fromEnum (Double -> Int) -> (Double -> Double) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) Double
hbUnit