{-# LANGUAGE OverloadedStrings #-}
-- | Infrastructure for parsing & desugaring CSS properties related to fonts.
module Graphics.Layout.CSS.Font(Font'(..), placeholderFont, hbUnit,
        pattern2hbfont, pattern2font, CSSFont(..), variations') where

import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..), serialize)
import Stylist (PropertyParser(..))
import qualified Data.Text as Txt
import Data.Maybe (fromMaybe)

import Graphics.Layout.Box
import Graphics.Layout.CSS.Length

import Data.Text.Glyphize as HB
import Graphics.Text.Font.Choose (Pattern(..), Value(..), normalizePattern,
                                  getValue', getValue0, setValue, Binding(..),
                                  configSubstitute', defaultSubstitute,
                                  fontSort', MatchKind(..), fontRenderPrepare')
import qualified Data.ByteString as B
import System.IO.Unsafe (unsafePerformIO)

-- | zero'd `Font'` to serve as the root's parent in a font heirarchy.
placeholderFont :: Font'
placeholderFont = Font
-> Pattern
-> (Char -> Double)
-> (Char -> Double)
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Font'
Font' Font
forall a. HasCallStack => a
undefined [] (Double -> Char -> Double
forall a b. a -> b -> a
const 0) (Double -> Char -> Double
forall a b. a -> b -> a
const 0) 0 0 0 0  0 0 0 0  1
-- | Scale-factor for text-shaping APIs.
hbUnit :: Double
hbUnit = 64 :: Double

-- | Convert from FontConfig query result to a Harfbuzz font.
pattern2hbfont :: Pattern -> Int -> [Variation] -> Font
pattern2hbfont :: Pattern -> Int -> [Variation] -> Font
pattern2hbfont pat :: Pattern
pat scale :: Int
scale variations :: [Variation]
variations = FontOptions -> Face -> Font
createFontWithOptions FontOptions
options Face
face
  where
    bytes :: ByteString
bytes = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
B.readFile (FilePath -> IO ByteString) -> FilePath -> IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Pattern -> FilePath
forall x. ToValue x => FilePath -> Pattern -> x
getValue0 "file" Pattern
pat
    face :: Face
face = ByteString -> Word -> Face
createFace ByteString
bytes (Word -> Face) -> Word -> Face
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ FilePath -> Pattern -> Maybe Int
forall x. ToValue x => FilePath -> Pattern -> Maybe x
getValue' "index" Pattern
pat
    options :: FontOptions
options = (FontOptions -> (FilePath, [(Binding, Value)]) -> FontOptions)
-> FontOptions -> Pattern -> FontOptions
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FontOptions -> (FilePath, [(Binding, Value)]) -> FontOptions
forall a a.
(Eq a, IsString a) =>
FontOptions -> (a, [(a, Value)]) -> FontOptions
value2opt FontOptions
defaultFontOptions { optionScale :: Maybe (Int, Int)
optionScale = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
scale, Int
scale) } (Pattern -> FontOptions) -> Pattern -> FontOptions
forall a b. (a -> b) -> a -> b
$
                Pattern -> Pattern
normalizePattern Pattern
pat

    value2opt :: FontOptions -> (a, [(a, Value)]) -> FontOptions
value2opt opts :: FontOptions
opts ("slant", (_, ValueInt x :: Int
x):_) = FontOptions
opts {
        optionSynthSlant :: Maybe Float
optionSynthSlant = Float -> Maybe Float
forall a. a -> Maybe a
Just (Float -> Maybe Float) -> Float -> Maybe Float
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
x
      }
    value2opt opts :: FontOptions
opts ("fontvariations", _:_) = FontOptions
opts {optionVariations :: [Variation]
optionVariations = [Variation]
variations}
    value2opt opts :: FontOptions
opts _ = FontOptions
opts

-- | Convert Parsed CSS to a `Font'`.
-- Includes sizing parameters derived from a root & parent `Font'`.
pattern2font :: Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font :: Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font pat :: Pattern
pat styles :: CSSFont
styles@CSSFont { cssFontSize :: CSSFont -> Unitted
cssFontSize = (x :: Double
x,"initial") } parent :: Font'
parent root :: Font'
root =
    Pattern -> CSSFont -> Font' -> Font' -> Font'
pattern2font Pattern
pat CSSFont
styles { cssFontSize :: Unitted
cssFontSize = (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Font' -> Double
fontSize Font'
root," ") } Font'
parent Font'
root
pattern2font pat :: Pattern
pat styles :: CSSFont
styles parent :: Font'
parent root :: Font'
root = Font' :: Font
-> Pattern
-> (Char -> Double)
-> (Char -> Double)
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Font'
Font' {
        hbFont :: Font
hbFont = Font
font',
        pattern :: Pattern
pattern = Pattern
font,
        fontHeight :: Char -> Double
fontHeight = Maybe GlyphExtents -> Double
height' (Maybe GlyphExtents -> Double)
-> (Char -> Maybe GlyphExtents) -> Char -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Word32 -> Maybe GlyphExtents
fontGlyphExtents Font
font' (Word32 -> Maybe GlyphExtents)
-> (Char -> Word32) -> Char -> Maybe GlyphExtents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word32
fontGlyph',
        fontAdvance :: Char -> Double
fontAdvance = Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Double) -> (Char -> Int32) -> Char -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Word32 -> Int32
fontGlyphHAdvance Font
font' (Word32 -> Int32) -> (Char -> Word32) -> Char -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word32
fontGlyph',
        fontSize :: Double
fontSize = Double
fontSize',
        rootEm :: Double
rootEm = Font' -> Double
fontSize Font'
root,
        lineheight :: Double
lineheight = Double
lineheight',
        rlh :: Double
rlh = Font' -> Double
lineheight Font'
root,

        vh :: Double
vh = Font' -> Double
vh Font'
root,
        vw :: Double
vw = Font' -> Double
vw Font'
root,
        vmax :: Double
vmax = Font' -> Double
vmax Font'
root,
        vmin :: Double
vmin = Font' -> Double
vmin Font'
root,
        scale :: Double
scale = Font' -> Double
scale Font'
root
    } where
        height' :: Maybe GlyphExtents -> Double
height' (Just x :: GlyphExtents
x) = Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Double) -> Word32 -> Double
forall a b. (a -> b) -> a -> b
$ GlyphExtents -> Word32
HB.height GlyphExtents
x
        height' Nothing = Double
fontSize'
        lineheight' :: Double
lineheight' | Unitted -> Text
forall a b. (a, b) -> b
snd (CSSFont -> Unitted
cssLineheight CSSFont
styles) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "normal",
            Just extents :: FontExtents
extents <- Font -> Maybe FontExtents
fontHExtents Font
font' = (Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Double) -> Int32 -> Double
forall a b. (a -> b) -> a -> b
$ FontExtents -> Int32
lineGap FontExtents
extents)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
hbUnit
            | Bool
otherwise = Unitted -> Font' -> Double
lowerLength' (CSSFont -> Unitted
cssLineheight CSSFont
styles) Font'
parent
        fontSize' :: Double
fontSize' = Unitted -> Font' -> Double
lowerLength' (CSSFont -> Unitted
cssFontSize CSSFont
styles) Font'
parent
        lowerLength' :: Unitted -> Font' -> Double
lowerLength' a :: Unitted
a = Double -> Length -> Double
lowerLength (Font' -> Double
fontSize Font'
parent) (Length -> Double) -> (Font' -> Length) -> Font' -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unitted -> Font' -> Length
finalizeLength Unitted
a
        fontGlyph' :: Char -> Word32
fontGlyph' ch :: Char
ch = Word32 -> Maybe Word32 -> Word32
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Word32 -> Word32) -> Maybe Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Font -> Char -> Maybe Char -> Maybe Word32
fontGlyph Font
font' Char
ch Maybe Char
forall a. Maybe a
Nothing
        q :: Pattern
q | Maybe [(Binding, Value)]
Nothing <- FilePath -> Pattern -> Maybe [(Binding, Value)]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "family" Pattern
pat, Just val :: [(Binding, Value)]
val <- FilePath -> Pattern -> Maybe [(Binding, Value)]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "family" (Pattern -> Maybe [(Binding, Value)])
-> Pattern -> Maybe [(Binding, Value)]
forall a b. (a -> b) -> a -> b
$ Font' -> Pattern
pattern Font'
root =
                ("family", [(Binding, Value)]
val)(FilePath, [(Binding, Value)]) -> Pattern -> Pattern
forall a. a -> [a] -> [a]
:FilePath -> Binding -> Double -> Pattern -> Pattern
forall x.
ToValue x =>
FilePath -> Binding -> x -> Pattern -> Pattern
setValue "size" Binding
Weak (Font' -> Double -> Double
px2pt Font'
root Double
fontSize') Pattern
pat
            | Bool
otherwise = FilePath -> Binding -> Double -> Pattern -> Pattern
forall x.
ToValue x =>
FilePath -> Binding -> x -> Pattern -> Pattern
setValue "size" Binding
Weak (Font' -> Double -> Double
px2pt Font'
root Double
fontSize') Pattern
pat
        font :: Pattern
font = case Pattern -> Bool -> Maybe (FontSet, CharSet)
fontSort' (Pattern -> Pattern
defaultSubstitute (Pattern -> Pattern) -> Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ Pattern -> MatchKind -> Pattern
configSubstitute' Pattern
q MatchKind
MatchPattern) Bool
False of
            Just (font :: Pattern
font:_, _) -> Pattern -> Pattern -> Pattern
fontRenderPrepare' Pattern
q Pattern
font
            _ -> FilePath -> Pattern
forall a. HasCallStack => FilePath -> a
error "TODO: Set fallback font!"
        font' :: Font
font' = Pattern -> Int -> [Variation] -> Font
pattern2hbfont Pattern
font (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Double
scale') ([Variation] -> Font) -> [Variation] -> Font
forall a b. (a -> b) -> a -> b
$ Double -> CSSFont -> [Variation]
variations' Double
fontSize' CSSFont
styles
        scale' :: Double
scale' = Double
fontSize' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
hbUnit

-- | Parsed CSS font properties, excluding the FontConfig query.
data CSSFont = CSSFont {
    -- | Parsed CSS font-size.
    CSSFont -> Unitted
cssFontSize :: Unitted,
    -- | Parsed CSS line-height.
    CSSFont -> Unitted
cssLineheight :: Unitted,
    -- | Parsed CSS font-variation-settings.
    CSSFont -> [Variation]
variations :: [Variation],
    -- | Parsed CSS font-weight.
    CSSFont -> Variation
weightVariation :: Variation,
    -- | Parsed CSS font-stretch.
    CSSFont -> Variation
widthVariation :: Variation,
    -- | Parsed CSS font-style.
    CSSFont -> Variation
slantVariation :: Variation,
    -- | Parsed CSS font-optical-sizing.
    CSSFont -> Bool
opticalSize :: Bool
}
-- | All font-variations from the parsed CSS properties.
-- | Requires the resolved font-size in case font-optical-sizing is set.
variations' :: Double -> CSSFont -> [Variation]
variations' :: Double -> CSSFont -> [Variation]
variations' fontsize :: Double
fontsize self :: CSSFont
self =
    (if CSSFont -> Bool
opticalSize CSSFont
self then (Word32 -> Float -> Variation
Variation Word32
opsz (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
fontsize)Variation -> [Variation] -> [Variation]
forall a. a -> [a] -> [a]
:) else [Variation] -> [Variation]
forall a. a -> a
id)
    (CSSFont -> Variation
slantVariation CSSFont
selfVariation -> [Variation] -> [Variation]
forall a. a -> [a] -> [a]
:CSSFont -> Variation
widthVariation CSSFont
selfVariation -> [Variation] -> [Variation]
forall a. a -> [a] -> [a]
:CSSFont -> Variation
weightVariation CSSFont
selfVariation -> [Variation] -> [Variation]
forall a. a -> [a] -> [a]
:CSSFont -> [Variation]
variations CSSFont
self)

-- | Represents a multiple of the initial font-size.
-- Resolved by `pattern2font`.
fracDefault :: CSSFont -> Double -> Maybe CSSFont
fracDefault :: CSSFont -> Double -> Maybe CSSFont
fracDefault self :: CSSFont
self frac :: Double
frac = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self {
    cssFontSize :: Unitted
cssFontSize = (Double
frac,"initial")
}
instance PropertyParser CSSFont where
    temp :: CSSFont
temp = CSSFont :: Unitted
-> Unitted
-> [Variation]
-> Variation
-> Variation
-> Variation
-> Bool
-> CSSFont
CSSFont {
        cssFontSize :: Unitted
cssFontSize = (12,"pt"),
        cssLineheight :: Unitted
cssLineheight = (1,""),
        variations :: [Variation]
variations = [],
        weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght 400,
        widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth 100,
        slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
ital 0,
        opticalSize :: Bool
opticalSize = Bool
True
    }
    inherit :: CSSFont -> CSSFont
inherit parent :: CSSFont
parent = CSSFont
parent
    priority :: CSSFont -> [Text]
priority _ = []

    longhand :: CSSFont -> CSSFont -> Text -> [Token] -> Maybe CSSFont
longhand _ self :: CSSFont
self "font-size" [Ident "xx-small"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self (Double -> Maybe CSSFont) -> Double -> Maybe CSSFont
forall a b. (a -> b) -> a -> b
$ 3Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/5
    longhand _ self :: CSSFont
self "font-size" [Ident "x-small"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self (Double -> Maybe CSSFont) -> Double -> Maybe CSSFont
forall a b. (a -> b) -> a -> b
$ 3Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/4
    longhand _ self :: CSSFont
self "font-size" [Ident "small"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self (Double -> Maybe CSSFont) -> Double -> Maybe CSSFont
forall a b. (a -> b) -> a -> b
$ 8Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/9
    longhand _ self :: CSSFont
self "font-size" [Ident "medium"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self 1
    longhand _ self :: CSSFont
self "font-size" [Ident "initial"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self 1
    longhand _ self :: CSSFont
self "font-size" [Ident "large"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self (Double -> Maybe CSSFont) -> Double -> Maybe CSSFont
forall a b. (a -> b) -> a -> b
$ 6Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/5
    longhand _ self :: CSSFont
self "font-size" [Ident "x-large"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self (Double -> Maybe CSSFont) -> Double -> Maybe CSSFont
forall a b. (a -> b) -> a -> b
$ 3Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2
    longhand _ self :: CSSFont
self "font-size" [Ident "xx-large"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self 2
    longhand _ self :: CSSFont
self "font-size" [Ident "xxx-large"] = CSSFont -> Double -> Maybe CSSFont
fracDefault CSSFont
self 3
    longhand parent :: CSSFont
parent self :: CSSFont
self "font-size" [Ident "larger"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { cssFontSize :: Unitted
cssFontSize = (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*1.2,Text
unit) }
      where (x :: Double
x,unit :: Text
unit) = CSSFont -> Unitted
cssFontSize CSSFont
parent
    longhand parent :: CSSFont
parent self :: CSSFont
self "font-size" [Ident "smaller"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { cssFontSize :: Unitted
cssFontSize = (Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/1.2,Text
unit) }
      where (x :: Double
x, unit :: Text
unit) = CSSFont -> Unitted
cssFontSize CSSFont
parent
    longhand _ self :: CSSFont
self "font-size" toks :: [Token]
toks
        | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { cssFontSize :: Unitted
cssFontSize = Unitted
x }

    longhand _ self :: CSSFont
self "line-height" [Ident "normal"] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { cssLineheight :: Unitted
cssLineheight = (0,"normal") }
    longhand _ self :: CSSFont
self "line-height" [Number _ x :: NumericValue
x] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { cssLineheight :: Unitted
cssLineheight = (NumericValue -> Double
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x,"em") }
    longhand _ self :: CSSFont
self "line-height" toks :: [Token]
toks
        | Just x :: Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
toks = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { cssLineheight :: Unitted
cssLineheight = Unitted
x }

    longhand _ self :: CSSFont
self "font-variation-settings" [Ident "normal"] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { variations :: [Variation]
variations = [] }
    longhand _ self :: CSSFont
self "font-variation-settings" [Ident "initial"] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self {variations :: [Variation]
variations = []}
    longhand _ self :: CSSFont
self "font-variation-settings" toks :: [Token]
toks
        | Just x :: [Variation]
x <- [Token] -> Maybe [Variation]
parseVariations [Token]
toks = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { variations :: [Variation]
variations = [Variation]
x }

    longhand _ self :: CSSFont
self "font-weight" [Ident "normal"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght 400 }
    longhand _ self :: CSSFont
self "font-weight" [Ident "initial"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght 400 }
    longhand _ self :: CSSFont
self "font-weight" [Ident "bold"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght 700 }
    longhand _ self :: CSSFont
self "font-weight" [Number _ (NVInteger x :: Integer
x)] | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 100 Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 1000 =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght (Float -> Variation) -> Float -> Variation
forall a b. (a -> b) -> a -> b
$ Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x }
    longhand parent :: CSSFont
parent self :: CSSFont
self "font-weight" [Ident "bolder"]
        | Variation -> Float
varValue (CSSFont -> Variation
weightVariation CSSFont
parent) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< 400 =
            CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght 400 }
        | Variation -> Float
varValue (CSSFont -> Variation
weightVariation CSSFont
parent) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< 600 =
            CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght 700 }
        | Bool
otherwise = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght 900 }
    longhand parent :: CSSFont
parent self :: CSSFont
self "font-weight" [Ident "lighter"]
        | Variation -> Float
varValue (CSSFont -> Variation
weightVariation CSSFont
parent) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< 600 =
            CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght 100 }
        | Variation -> Float
varValue (CSSFont -> Variation
weightVariation CSSFont
parent) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< 800 =
            CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght 400 }
        | Bool
otherwise = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { weightVariation :: Variation
weightVariation = Word32 -> Float -> Variation
Variation Word32
wght 700 }

    longhand _ self :: CSSFont
self "font-stretch" [Ident "ultra-condensed"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth 50 }
    longhand _ self :: CSSFont
self "font-stretch" [Ident "extra-condensed"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth 62.5 }
    longhand _ self :: CSSFont
self "font-stretch" [Ident "condensed"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth 75 }
    longhand _ self :: CSSFont
self "font-stretch" [Ident "semi-condensed"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth 87.5 }
    longhand _ self :: CSSFont
self "font-stretch" [Ident k :: Text
k] | Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["initial", "normal"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth 100 }
    longhand _ self :: CSSFont
self "font-stretch" [Ident "semi-expanded"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth 112.5 }
    longhand _ self :: CSSFont
self "font-stretch" [Ident "expanded"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth 125 }
    longhand _ self :: CSSFont
self "font-stretch" [Ident "extra-expanded"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth 150 }
    longhand _ self :: CSSFont
self "font-stretch" [Ident "ultra-expanded"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth 200 }
    longhand _ self :: CSSFont
self "font-stretch" [Percentage _ x :: NumericValue
x] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { widthVariation :: Variation
widthVariation = Word32 -> Float -> Variation
Variation Word32
wdth (Float -> Variation) -> Float -> Variation
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x }

    longhand _ self :: CSSFont
self "font-style" [Ident "oblique", Dimension _ x :: NumericValue
x "deg"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
slnt (Float -> Variation) -> Float -> Variation
forall a b. (a -> b) -> a -> b
$ NumericValue -> Float
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
x }
    longhand _ self :: CSSFont
self "font-style" [Ident "oblique", Dimension _ x :: NumericValue
x "grad"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
slnt (NumericValue -> Float
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
xFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/400Float -> Float -> Float
forall a. Num a => a -> a -> a
*360) }
    longhand _ self :: CSSFont
self "font-style" [Ident "oblique", Dimension _ x :: NumericValue
x "rad"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
slnt (NumericValue -> Float
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
*180Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
forall a. Floating a => a
pi) }
    longhand _ self :: CSSFont
self "font-style" [Ident "oblique", Dimension _ x :: NumericValue
x "turn"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
slnt (NumericValue -> Float
forall x. (Fractional x, RealFloat x) => NumericValue -> x
n2f NumericValue
xFloat -> Float -> Float
forall a. Num a => a -> a -> a
*360) }
    longhand _ self :: CSSFont
self "font-style" [Ident "italic"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
ital 1 }
    longhand _ self :: CSSFont
self "font-style" [Ident "normal"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
ital 0 }
    longhand _ self :: CSSFont
self "font-style" [Ident "initial"] =
        CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
self { slantVariation :: Variation
slantVariation = Word32 -> Float -> Variation
Variation Word32
ital 0 }

    longhand _ s :: CSSFont
s "font-optical-sizing" [Ident "auto"] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
s {opticalSize :: Bool
opticalSize = Bool
True}
    longhand _ s :: CSSFont
s "font-optical-sizing" [Ident "initial"] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
s {opticalSize :: Bool
opticalSize = Bool
True}
    longhand _ s :: CSSFont
s "font-optical-sizing" [Ident "none"] = CSSFont -> Maybe CSSFont
forall a. a -> Maybe a
Just CSSFont
s {opticalSize :: Bool
opticalSize = Bool
False}

    longhand _ _ _ _ = Maybe CSSFont
forall a. Maybe a
Nothing

-- | Utility for parsing multiple font variations (via Harfbuzz).
parseVariations :: [Token] -> Maybe [Variation]
parseVariations (x :: Token
x@(String _):y :: Token
y@(Number _ _):Comma:toks :: [Token]
toks)
    | Just var :: Variation
var <- FilePath -> Maybe Variation
parseVariation (FilePath -> Maybe Variation) -> FilePath -> Maybe Variation
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Txt.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ [Token] -> Text
serialize [Token
x, Token
y],
        Just vars :: [Variation]
vars <- [Token] -> Maybe [Variation]
parseVariations [Token]
toks = [Variation] -> Maybe [Variation]
forall a. a -> Maybe a
Just ([Variation] -> Maybe [Variation])
-> [Variation] -> Maybe [Variation]
forall a b. (a -> b) -> a -> b
$ Variation
varVariation -> [Variation] -> [Variation]
forall a. a -> [a] -> [a]
:[Variation]
vars
parseVariations toks :: [Token]
toks@[String _, Number _ _]
    | Just var :: Variation
var <- FilePath -> Maybe Variation
parseVariation (FilePath -> Maybe Variation) -> FilePath -> Maybe Variation
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Txt.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ [Token] -> Text
serialize [Token]
toks = [Variation] -> Maybe [Variation]
forall a. a -> Maybe a
Just [Variation
var]
parseVariations _ = Maybe [Variation]
forall a. Maybe a
Nothing

wght :: Word32
wght = FilePath -> Word32
tag_from_string "wght"
wdth :: Word32
wdth = FilePath -> Word32
tag_from_string "wdth"
slnt :: Word32
slnt = FilePath -> Word32
tag_from_string "slnt"
ital :: Word32
ital = FilePath -> Word32
tag_from_string "ital"
opsz :: Word32
opsz = FilePath -> Word32
tag_from_string "opsz"