{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
-- | Infrastructure for parsing & desugaring text related CSS properties.
module Graphics.Layout.Inline.CSS(
    CSSInline(..), Default(..), UnicodeBidi(..), applyFontInline, applyBidi) 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 Data.Char (isSpace)
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnicodeBidi -> UnicodeBidi -> Bool
$c/= :: UnicodeBidi -> UnicodeBidi -> Bool
== :: UnicodeBidi -> UnicodeBidi -> Bool
$c== :: UnicodeBidi -> UnicodeBidi -> Bool
Eq, Eq 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
min :: UnicodeBidi -> UnicodeBidi -> UnicodeBidi
$cmin :: UnicodeBidi -> UnicodeBidi -> UnicodeBidi
max :: UnicodeBidi -> UnicodeBidi -> UnicodeBidi
$cmax :: UnicodeBidi -> UnicodeBidi -> UnicodeBidi
>= :: UnicodeBidi -> UnicodeBidi -> Bool
$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
compare :: UnicodeBidi -> UnicodeBidi -> Ordering
$ccompare :: UnicodeBidi -> UnicodeBidi -> Ordering
Ord, Int -> UnicodeBidi
UnicodeBidi -> Int
UnicodeBidi -> [UnicodeBidi]
UnicodeBidi -> UnicodeBidi
UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
UnicodeBidi -> UnicodeBidi -> UnicodeBidi -> [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
enumFromThenTo :: UnicodeBidi -> UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
$cenumFromThenTo :: UnicodeBidi -> UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
enumFromTo :: UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
$cenumFromTo :: UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
enumFromThen :: UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
$cenumFromThen :: UnicodeBidi -> UnicodeBidi -> [UnicodeBidi]
enumFrom :: UnicodeBidi -> [UnicodeBidi]
$cenumFrom :: UnicodeBidi -> [UnicodeBidi]
fromEnum :: UnicodeBidi -> Int
$cfromEnum :: UnicodeBidi -> Int
toEnum :: Int -> UnicodeBidi
$ctoEnum :: Int -> UnicodeBidi
pred :: UnicodeBidi -> UnicodeBidi
$cpred :: UnicodeBidi -> UnicodeBidi
succ :: UnicodeBidi -> UnicodeBidi
$csucc :: UnicodeBidi -> UnicodeBidi
Enum, ReadPrec [UnicodeBidi]
ReadPrec UnicodeBidi
Int -> ReadS UnicodeBidi
ReadS [UnicodeBidi]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnicodeBidi]
$creadListPrec :: ReadPrec [UnicodeBidi]
readPrec :: ReadPrec UnicodeBidi
$creadPrec :: ReadPrec UnicodeBidi
readList :: ReadS [UnicodeBidi]
$creadList :: ReadS [UnicodeBidi]
readsPrec :: Int -> ReadS UnicodeBidi
$creadsPrec :: Int -> ReadS UnicodeBidi
Read, Int -> UnicodeBidi -> ShowS
[UnicodeBidi] -> ShowS
UnicodeBidi -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UnicodeBidi] -> ShowS
$cshowList :: [UnicodeBidi] -> ShowS
show :: UnicodeBidi -> [Char]
$cshow :: UnicodeBidi -> [Char]
showsPrec :: Int -> UnicodeBidi -> ShowS
$cshowsPrec :: Int -> UnicodeBidi -> ShowS
Show)

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"] =
        forall a. a -> Maybe a
Just 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
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Token -> Bool
isString [Token]
toks =
            forall a. a -> Maybe a
Just 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"initial", Text
"auto"] = forall a. a -> Maybe a
Just 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] =
        forall a. a -> Maybe a
Just 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"] =
        forall a. a -> Maybe a
Just 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"] =
        forall a. a -> Maybe a
Just 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"] =
        forall a. a -> Maybe a
Just 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"] =
        forall a. a -> Maybe a
Just 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"] =
        forall a. a -> Maybe a
Just 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"] =
        forall a. a -> Maybe a
Just 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"] =
        forall a. a -> Maybe a
Just 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"] =
        forall a. a -> Maybe a
Just 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"] =
        forall a. a -> Maybe a
Just 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"] =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> TextOptions -> UnicodeBidi -> CSSInline
CSSInline Text
txt TextOptions
opts UnicodeBidi
BdPlainText
    longhand CSSInline
_ CSSInline
_ Text
_ [Token]
_ = forall a. Maybe a
Nothing

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 forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ Font' -> Double
lineheight Font'
font forall a. Num a => a -> a -> a
* Double
hbUnit
  }
-- | 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 =
    forall a. Default a => InnerNode Text a
chLREmbedforall a. a -> [a] -> [a]
:[InnerNode Text d]
txtforall {a}. [a] -> a -> [a]
+:forall a. Default a => InnerNode Text a
chPopDir
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirRTL) UnicodeBidi
BdEmbed) [InnerNode Text d]
txt =
    forall a. Default a => InnerNode Text a
chRLEmbedforall a. a -> [a] -> [a]
:[InnerNode Text d]
txtforall {a}. [a] -> a -> [a]
+:forall a. Default a => InnerNode Text a
chPopDir
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirLTR) UnicodeBidi
BdIsolate) [InnerNode Text d]
txt =
    forall a. Default a => InnerNode Text a
chLRIsolateforall a. a -> [a] -> [a]
:[InnerNode Text d]
txtforall {a}. [a] -> a -> [a]
+:forall a. Default a => InnerNode Text a
chPopDirIsolate
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirRTL) UnicodeBidi
BdIsolate) [InnerNode Text d]
txt =
    forall a. Default a => InnerNode Text a
chRLIsolateforall a. a -> [a] -> [a]
:[InnerNode Text d]
txtforall {a}. [a] -> a -> [a]
+:forall a. Default a => InnerNode Text a
chPopDirIsolate
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirLTR) UnicodeBidi
BdOverride) [InnerNode Text d]
txt =
    forall a. Default a => InnerNode Text a
chLROverrideforall a. a -> [a] -> [a]
:[InnerNode Text d]
txtforall {a}. [a] -> a -> [a]
+:forall a. Default a => InnerNode Text a
chPopDir
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirRTL) UnicodeBidi
BdOverride) [InnerNode Text d]
txt =
    forall a. Default a => InnerNode Text a
chRLOverrideforall a. a -> [a] -> [a]
:[InnerNode Text d]
txtforall {a}. [a] -> a -> [a]
+:forall a. Default a => InnerNode Text a
chPopDir
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirLTR) UnicodeBidi
BdIsolateOverride) [InnerNode Text d]
txt =
    forall a. Default a => InnerNode Text a
ch1stStrongIsolateforall a. a -> [a] -> [a]
:forall a. Default a => InnerNode Text a
chLROverrideforall a. a -> [a] -> [a]
:[InnerNode Text d]
txtforall {a}. [a] -> a -> [a]
+:forall a. Default a => InnerNode Text a
chPopDirforall {a}. [a] -> a -> [a]
+:forall a. Default a => InnerNode Text a
chPopDirIsolate
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
DirRTL) UnicodeBidi
BdIsolateOverride) [InnerNode Text d]
txt =
    forall a. Default a => InnerNode Text a
ch1stStrongIsolateforall a. a -> [a] -> [a]
:forall a. Default a => InnerNode Text a
chRLOverrideforall a. a -> [a] -> [a]
:[InnerNode Text d]
txtforall {a}. [a] -> a -> [a]
+:forall a. Default a => InnerNode Text a
chPopDirforall {a}. [a] -> a -> [a]
+:forall a. Default a => InnerNode Text a
chPopDirIsolate
applyBidi (CSSInline Text
_ TextOptions
_ UnicodeBidi
BdPlainText) [InnerNode Text d]
txt =
    forall a. Default a => InnerNode Text a
ch1stStrongIsolateforall a. a -> [a] -> [a]
:[InnerNode Text d]
txtforall {a}. [a] -> a -> [a]
+:forall a. Default a => InnerNode Text a
chPopDirIsolate
applyBidi (CSSInline Text
_ (TextOptions -> Direction
textDirection -> Direction
dir) UnicodeBidi
_) [InnerNode Text d]
txt =
    forall a. [Char] -> a -> a
trace ([Char]
"Unexpected direction! " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Direction
dir) [InnerNode Text d]
txt

[a]
a +: :: [a] -> a -> [a]
+: a
b = [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 = forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x202A'
chRLEmbed :: forall a. Default a => InnerNode Text a
chRLEmbed = forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x202B'
chLROverride :: forall a. Default a => InnerNode Text a
chLROverride = forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x202D'
chRLOverride :: forall a. Default a => InnerNode Text a
chRLOverride = forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x202E'
chPopDir :: forall a. Default a => InnerNode Text a
chPopDir = forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x202C'
chLRIsolate :: forall a. Default a => InnerNode Text a
chLRIsolate = forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x2066'
chRLIsolate :: forall a. Default a => InnerNode Text a
chRLIsolate = forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x2067'
ch1stStrongIsolate :: forall a. Default a => InnerNode Text a
ch1stStrongIsolate = forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x2068'
chPopDirIsolate :: forall a. Default a => InnerNode Text a
chPopDirIsolate = forall {d}. Default d => Char -> InnerNode Text d
leaf Char
'\x2069'

leaf :: Char -> InnerNode Text d
leaf Char
ch = forall t d. d -> t -> InnerNode t d
TextSequence forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ Char -> Text
Txt.singleton Char
ch

class Default a where
    def :: a