{-# LANGUAGE DeriveGeneric, OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
module Graphics.Text.Font.Choose.Pattern (Pattern(..), Binding(..), equalSubset,
normalizePattern, filter, defaultSubstitute, nameParse, nameUnparse, format,
Pattern_, withPattern, thawPattern, thawPattern_, patternAsPointer,
setValue, setValues, unset, getValues, getValues', getValue, getValue', getValue0,
parseFontFamily, parseFontFeatures, parseFontVars, parseLength,
parseFontStretch, parseFontWeight) where
import Prelude hiding (filter)
import Data.List (nub)
import Graphics.Text.Font.Choose.Value
import Graphics.Text.Font.Choose.ObjectSet (ObjectSet, ObjectSet_, withObjectSet)
import Data.Hashable (Hashable(..))
import GHC.Generics (Generic)
import Graphics.Text.Font.Choose.Result (throwFalse, throwNull, throwInt)
import Foreign.Ptr (Ptr)
import Foreign.Marshal.Alloc (alloca, allocaBytes, free)
import Foreign.Storable (Storable(..))
import Foreign.C.String (CString, withCString, peekCString)
import Debug.Trace (trace)
import System.IO.Unsafe (unsafePerformIO)
import Control.Monad (forM, join)
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import Control.Exception (bracket)
import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Data.Text (unpack, Text)
import Stylist (PropertyParser(..))
import Data.Scientific (toRealFloat)
import Data.List (intercalate)
import Graphics.Text.Font.Choose.Weight (weightFromOpenType)
type Pattern = [(String, [(Binding, Value)])]
data Binding = Strong | Weak | Same deriving (Binding -> Binding -> Bool
(Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool) -> Eq Binding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Binding -> Binding -> Bool
$c/= :: Binding -> Binding -> Bool
== :: Binding -> Binding -> Bool
$c== :: Binding -> Binding -> Bool
Eq, Eq Binding
Eq Binding =>
(Binding -> Binding -> Ordering)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool)
-> (Binding -> Binding -> Binding)
-> (Binding -> Binding -> Binding)
-> Ord Binding
Binding -> Binding -> Bool
Binding -> Binding -> Ordering
Binding -> Binding -> Binding
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 :: Binding -> Binding -> Binding
$cmin :: Binding -> Binding -> Binding
max :: Binding -> Binding -> Binding
$cmax :: Binding -> Binding -> Binding
>= :: Binding -> Binding -> Bool
$c>= :: Binding -> Binding -> Bool
> :: Binding -> Binding -> Bool
$c> :: Binding -> Binding -> Bool
<= :: Binding -> Binding -> Bool
$c<= :: Binding -> Binding -> Bool
< :: Binding -> Binding -> Bool
$c< :: Binding -> Binding -> Bool
compare :: Binding -> Binding -> Ordering
$ccompare :: Binding -> Binding -> Ordering
$cp1Ord :: Eq Binding
Ord, Int -> Binding
Binding -> Int
Binding -> [Binding]
Binding -> Binding
Binding -> Binding -> [Binding]
Binding -> Binding -> Binding -> [Binding]
(Binding -> Binding)
-> (Binding -> Binding)
-> (Int -> Binding)
-> (Binding -> Int)
-> (Binding -> [Binding])
-> (Binding -> Binding -> [Binding])
-> (Binding -> Binding -> [Binding])
-> (Binding -> Binding -> Binding -> [Binding])
-> Enum Binding
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 :: Binding -> Binding -> Binding -> [Binding]
$cenumFromThenTo :: Binding -> Binding -> Binding -> [Binding]
enumFromTo :: Binding -> Binding -> [Binding]
$cenumFromTo :: Binding -> Binding -> [Binding]
enumFromThen :: Binding -> Binding -> [Binding]
$cenumFromThen :: Binding -> Binding -> [Binding]
enumFrom :: Binding -> [Binding]
$cenumFrom :: Binding -> [Binding]
fromEnum :: Binding -> Int
$cfromEnum :: Binding -> Int
toEnum :: Int -> Binding
$ctoEnum :: Int -> Binding
pred :: Binding -> Binding
$cpred :: Binding -> Binding
succ :: Binding -> Binding
$csucc :: Binding -> Binding
Enum, Int -> Binding -> ShowS
[Binding] -> ShowS
Binding -> String
(Int -> Binding -> ShowS)
-> (Binding -> String) -> ([Binding] -> ShowS) -> Show Binding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binding] -> ShowS
$cshowList :: [Binding] -> ShowS
show :: Binding -> String
$cshow :: Binding -> String
showsPrec :: Int -> Binding -> ShowS
$cshowsPrec :: Int -> Binding -> ShowS
Show, (forall x. Binding -> Rep Binding x)
-> (forall x. Rep Binding x -> Binding) -> Generic Binding
forall x. Rep Binding x -> Binding
forall x. Binding -> Rep Binding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Binding x -> Binding
$cfrom :: forall x. Binding -> Rep Binding x
Generic)
instance Hashable Binding where
hash :: Binding -> Int
hash Strong = 0
hash Weak = 1
hash Same = 2
setValue :: ToValue x => String -> Binding -> x -> Pattern -> Pattern
setValue :: String -> Binding -> x -> Pattern -> Pattern
setValue key :: String
key b :: Binding
b value :: x
value pat :: Pattern
pat = (String
key, [(Binding
b, x -> Value
forall x. ToValue x => x -> Value
toValue x
value)])(String, [(Binding, Value)]) -> Pattern -> Pattern
forall a. a -> [a] -> [a]
:String -> Pattern -> Pattern
forall a b. Eq a => a -> [(a, b)] -> [(a, b)]
unset String
key Pattern
pat
setValues :: ToValue x => String -> Binding -> [x] -> Pattern -> Pattern
setValues :: String -> Binding -> [x] -> Pattern -> Pattern
setValues key :: String
key b :: Binding
b values :: [x]
values pat :: Pattern
pat = (String
key, [(Binding
b, x -> Value
forall x. ToValue x => x -> Value
toValue x
v) | x
v <- [x]
values])(String, [(Binding, Value)]) -> Pattern -> Pattern
forall a. a -> [a] -> [a]
:String -> Pattern -> Pattern
forall a b. Eq a => a -> [(a, b)] -> [(a, b)]
unset String
key Pattern
pat
getValues :: String -> Pattern -> [Value]
getValues :: String -> Pattern -> [Value]
getValues key :: String
key pat :: Pattern
pat | Just ret :: [(Binding, Value)]
ret <- String -> Pattern -> Maybe [(Binding, Value)]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
key Pattern
pat = ((Binding, Value) -> Value) -> [(Binding, Value)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Binding, Value) -> Value
forall a b. (a, b) -> b
snd [(Binding, Value)]
ret
| Bool
otherwise = []
getValues' :: String -> Pattern -> [b]
getValues' key :: String
key pat :: Pattern
pat = (Value -> Maybe b) -> [Value] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Value -> Maybe b
forall x. ToValue x => Value -> Maybe x
fromValue ([Value] -> [b]) -> [Value] -> [b]
forall a b. (a -> b) -> a -> b
$ String -> Pattern -> [Value]
getValues String
key Pattern
pat
getValue :: String -> Pattern -> Value
getValue :: String -> Pattern -> Value
getValue key :: String
key pat :: Pattern
pat | Just ((_, ret :: Value
ret):_) <- String -> Pattern -> Maybe [(Binding, Value)]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
key Pattern
pat = Value
ret
| Bool
otherwise = Value
ValueVoid
getValue' :: ToValue x => String -> Pattern -> Maybe x
getValue' :: String -> Pattern -> Maybe x
getValue' key :: String
key pat :: Pattern
pat = Value -> Maybe x
forall x. ToValue x => Value -> Maybe x
fromValue (Value -> Maybe x) -> Value -> Maybe x
forall a b. (a -> b) -> a -> b
$ String -> Pattern -> Value
getValue String
key Pattern
pat
getValue0 :: ToValue x => String -> Pattern -> x
getValue0 :: String -> Pattern -> x
getValue0 key :: String
key pat :: Pattern
pat = Value -> x
forall x. ToValue x => Value -> x
fromValue' (Value -> x) -> Value -> x
forall a b. (a -> b) -> a -> b
$ String -> Pattern -> Value
getValue String
key Pattern
pat
unset :: a -> [(a, b)] -> [(a, b)]
unset key :: a
key mapping :: [(a, b)]
mapping = [(a
key', b
val') | (key' :: a
key', val' :: b
val') <- [(a, b)]
mapping, a
key' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
key]
normalizePattern :: Pattern -> Pattern
normalizePattern :: Pattern -> Pattern
normalizePattern pat :: Pattern
pat =
[(String
key, [(Binding, Value)
val | (key' :: String
key', vals :: [(Binding, Value)]
vals) <- Pattern
pat, String
key' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
key, (Binding, Value)
val <- [(Binding, Value)]
vals]) | String
key <- [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, [(Binding, Value)]) -> String) -> Pattern -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [(Binding, Value)]) -> String
forall a b. (a, b) -> a
fst Pattern
pat]
equalSubset :: Pattern -> Pattern -> ObjectSet -> Bool
equalSubset :: Pattern -> Pattern -> [String] -> Bool
equalSubset a :: Pattern
a b :: Pattern
b objs :: [String]
objs = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Pattern -> (Pattern_ -> IO Bool) -> IO Bool
forall a. Pattern -> (Pattern_ -> IO a) -> IO a
withPattern Pattern
a ((Pattern_ -> IO Bool) -> IO Bool)
-> (Pattern_ -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \a' :: Pattern_
a' -> Pattern -> (Pattern_ -> IO Bool) -> IO Bool
forall a. Pattern -> (Pattern_ -> IO a) -> IO a
withPattern Pattern
b ((Pattern_ -> IO Bool) -> IO Bool)
-> (Pattern_ -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \b' :: Pattern_
b' ->
[String] -> (ObjectSet_ -> IO Bool) -> IO Bool
forall a. [String] -> (ObjectSet_ -> IO a) -> IO a
withObjectSet [String]
objs ((ObjectSet_ -> IO Bool) -> IO Bool)
-> (ObjectSet_ -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ Pattern_ -> Pattern_ -> ObjectSet_ -> IO Bool
fcPatternEqualSubset Pattern_
a' Pattern_
b'
foreign import ccall "FcPatternEqualSubset" fcPatternEqualSubset ::
Pattern_ -> Pattern_ -> ObjectSet_ -> IO Bool
filter :: Pattern -> ObjectSet -> Pattern
filter :: Pattern -> [String] -> Pattern
filter pat :: Pattern
pat objs :: [String]
objs =
IO Pattern -> Pattern
forall a. IO a -> a
unsafePerformIO (IO Pattern -> Pattern) -> IO Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ Pattern -> (Pattern_ -> IO Pattern) -> IO Pattern
forall a. Pattern -> (Pattern_ -> IO a) -> IO a
withPattern Pattern
pat ((Pattern_ -> IO Pattern) -> IO Pattern)
-> (Pattern_ -> IO Pattern) -> IO Pattern
forall a b. (a -> b) -> a -> b
$ \pat' :: Pattern_
pat' -> [String] -> (ObjectSet_ -> IO Pattern) -> IO Pattern
forall a. [String] -> (ObjectSet_ -> IO a) -> IO a
withObjectSet [String]
objs ((ObjectSet_ -> IO Pattern) -> IO Pattern)
-> (ObjectSet_ -> IO Pattern) -> IO Pattern
forall a b. (a -> b) -> a -> b
$ \objs' :: ObjectSet_
objs' ->
IO Pattern_ -> IO Pattern
thawPattern_ (IO Pattern_ -> IO Pattern) -> IO Pattern_ -> IO Pattern
forall a b. (a -> b) -> a -> b
$ Pattern_ -> ObjectSet_ -> IO Pattern_
fcPatternFilter Pattern_
pat' ObjectSet_
objs'
foreign import ccall "FcPatternFilter" fcPatternFilter ::
Pattern_ -> ObjectSet_ -> IO Pattern_
defaultSubstitute :: Pattern -> Pattern
defaultSubstitute :: Pattern -> Pattern
defaultSubstitute pat :: Pattern
pat = IO Pattern -> Pattern
forall a. IO a -> a
unsafePerformIO (IO Pattern -> Pattern) -> IO Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ Pattern -> (Pattern_ -> IO Pattern) -> IO Pattern
forall a. Pattern -> (Pattern_ -> IO a) -> IO a
withPattern Pattern
pat ((Pattern_ -> IO Pattern) -> IO Pattern)
-> (Pattern_ -> IO Pattern) -> IO Pattern
forall a b. (a -> b) -> a -> b
$ \pat' :: Pattern_
pat' -> do
()
ret <- Pattern_ -> IO ()
fcDefaultSubstitute Pattern_
pat'
Pattern_ -> IO Pattern
thawPattern Pattern_
pat'
foreign import ccall "FcDefaultSubstitute" fcDefaultSubstitute :: Pattern_ -> IO ()
nameParse :: String -> Pattern
nameParse :: String -> Pattern
nameParse name :: String
name = IO Pattern -> Pattern
forall a. IO a -> a
unsafePerformIO (IO Pattern -> Pattern) -> IO Pattern -> Pattern
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO Pattern) -> IO Pattern
forall a. String -> (CString -> IO a) -> IO a
withCString String
name ((CString -> IO Pattern) -> IO Pattern)
-> (CString -> IO Pattern) -> IO Pattern
forall a b. (a -> b) -> a -> b
$ \name' :: CString
name' ->
IO Pattern_ -> IO Pattern
thawPattern_ (IO Pattern_ -> IO Pattern) -> IO Pattern_ -> IO Pattern
forall a b. (a -> b) -> a -> b
$ CString -> IO Pattern_
fcNameParse CString
name'
foreign import ccall "FcNameParse" fcNameParse :: CString -> IO Pattern_
nameUnparse :: Pattern -> String
nameUnparse :: Pattern -> String
nameUnparse pat :: Pattern
pat = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ Pattern -> (Pattern_ -> IO String) -> IO String
forall a. Pattern -> (Pattern_ -> IO a) -> IO a
withPattern Pattern
pat ((Pattern_ -> IO String) -> IO String)
-> (Pattern_ -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \pat' :: Pattern_
pat' ->
IO CString
-> (CString -> IO ()) -> (CString -> IO String) -> IO String
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (CString -> CString
forall a. Ptr a -> Ptr a
throwNull (CString -> CString) -> IO CString -> IO CString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern_ -> IO CString
fcNameUnparse Pattern_
pat') CString -> IO ()
forall a. Ptr a -> IO ()
free CString -> IO String
peekCString
foreign import ccall "FcNameUnparse" fcNameUnparse :: Pattern_ -> IO CString
format :: Pattern -> String -> String
format :: Pattern -> ShowS
format pat :: Pattern
pat fmt :: String
fmt =
IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ Pattern -> (Pattern_ -> IO String) -> IO String
forall a. Pattern -> (Pattern_ -> IO a) -> IO a
withPattern Pattern
pat ((Pattern_ -> IO String) -> IO String)
-> (Pattern_ -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \pat' :: Pattern_
pat' -> String -> (CString -> IO String) -> IO String
forall a. String -> (CString -> IO a) -> IO a
withCString String
fmt ((CString -> IO String) -> IO String)
-> (CString -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \fmt' :: CString
fmt' -> do
IO CString
-> (CString -> IO ()) -> (CString -> IO String) -> IO String
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (CString -> CString
forall a. Ptr a -> Ptr a
throwNull (CString -> CString) -> IO CString -> IO CString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern_ -> CString -> IO CString
fcPatternFormat Pattern_
pat' CString
fmt') CString -> IO ()
forall a. Ptr a -> IO ()
free CString -> IO String
peekCString
foreign import ccall "FcPatternFormat" fcPatternFormat ::
Pattern_ -> CString -> IO CString
data Pattern'
type Pattern_ = Ptr Pattern'
withPattern :: Pattern -> (Pattern_ -> IO a) -> IO a
withPattern :: Pattern -> (Pattern_ -> IO a) -> IO a
withPattern pat :: Pattern
pat cb :: Pattern_ -> IO a
cb = (Pattern_ -> IO a) -> IO a
forall c. (Pattern_ -> IO c) -> IO c
withNewPattern ((Pattern_ -> IO a) -> IO a) -> (Pattern_ -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \pat' :: Pattern_
pat' -> do
Pattern
-> ((String, [(Binding, Value)]) -> IO [IO ()]) -> IO [[IO ()]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Pattern
pat (((String, [(Binding, Value)]) -> IO [IO ()]) -> IO [[IO ()]])
-> ((String, [(Binding, Value)]) -> IO [IO ()]) -> IO [[IO ()]]
forall a b. (a -> b) -> a -> b
$ \(obj :: String
obj, vals :: [(Binding, Value)]
vals) -> String -> (CString -> IO [IO ()]) -> IO [IO ()]
forall a. String -> (CString -> IO a) -> IO a
withCString String
obj ((CString -> IO [IO ()]) -> IO [IO ()])
-> (CString -> IO [IO ()]) -> IO [IO ()]
forall a b. (a -> b) -> a -> b
$ \obj' :: CString
obj' -> do
[(Binding, Value)]
-> ((Binding, Value) -> IO (IO ())) -> IO [IO ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Binding, Value)]
vals (((Binding, Value) -> IO (IO ())) -> IO [IO ()])
-> ((Binding, Value) -> IO (IO ())) -> IO [IO ()]
forall a b. (a -> b) -> a -> b
$ \(strength :: Binding
strength, val :: Value
val) -> Bool -> IO ()
throwFalse (Bool -> IO ()) -> IO Bool -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> (Value_ -> IO Bool) -> IO Bool
forall a. Value -> (Value_ -> IO a) -> IO a
withValue Value
val
(Pattern_ -> CString -> Bool -> Bool -> Value_ -> IO Bool
fcPatternAdd_ Pattern_
pat' CString
obj' (Binding
strength Binding -> Binding -> Bool
forall a. Eq a => a -> a -> Bool
== Binding
Strong) Bool
True)
Pattern_ -> IO a
cb Pattern_
pat'
foreign import ccall "my_FcPatternAdd" fcPatternAdd_ ::
Pattern_ -> CString -> Bool -> Bool -> Value_ -> IO Bool
patternAsPointer :: Pattern -> IO Pattern_
patternAsPointer :: Pattern -> IO Pattern_
patternAsPointer = (Pattern -> (Pattern_ -> IO Pattern_) -> IO Pattern_)
-> (Pattern_ -> IO Pattern_) -> Pattern -> IO Pattern_
forall a b c. (a -> b -> c) -> b -> a -> c
flip Pattern -> (Pattern_ -> IO Pattern_) -> IO Pattern_
forall a. Pattern -> (Pattern_ -> IO a) -> IO a
withPattern ((Pattern_ -> IO Pattern_) -> Pattern -> IO Pattern_)
-> (Pattern_ -> IO Pattern_) -> Pattern -> IO Pattern_
forall a b. (a -> b) -> a -> b
$ \ret :: Pattern_
ret -> do
Pattern_ -> IO ()
fcPatternReference Pattern_
ret
Pattern_ -> IO Pattern_
forall (m :: * -> *) a. Monad m => a -> m a
return Pattern_
ret
foreign import ccall "FcPatternReference" fcPatternReference :: Pattern_ -> IO ()
data PatternIter'
type PatternIter_ = Ptr PatternIter'
foreign import ccall "size_PatternIter" patIter'Size :: Int
thawPattern :: Pattern_ -> IO Pattern
thawPattern :: Pattern_ -> IO Pattern
thawPattern pat' :: Pattern_
pat' = Int -> (Ptr PatternIter' -> IO Pattern) -> IO Pattern
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
patIter'Size ((Ptr PatternIter' -> IO Pattern) -> IO Pattern)
-> (Ptr PatternIter' -> IO Pattern) -> IO Pattern
forall a b. (a -> b) -> a -> b
$ \iter' :: Ptr PatternIter'
iter' -> do
Pattern_ -> Ptr PatternIter' -> IO ()
fcPatternIterStart Pattern_
pat' Ptr PatternIter'
iter'
Pattern
ret <- Ptr PatternIter' -> IO Pattern
go Ptr PatternIter'
iter'
Pattern -> IO Pattern
forall (m :: * -> *) a. Monad m => a -> m a
return (Pattern -> IO Pattern) -> Pattern -> IO Pattern
forall a b. (a -> b) -> a -> b
$ Pattern -> Pattern
normalizePattern Pattern
ret
where
go :: PatternIter_ -> IO Pattern
go :: Ptr PatternIter' -> IO Pattern
go iter' :: Ptr PatternIter'
iter' = do
Bool
ok <- Pattern_ -> Ptr PatternIter' -> IO Bool
fcPatternIterIsValid Pattern_
pat' Ptr PatternIter'
iter'
if Bool
ok then do
(String, [(Binding, Value)])
x <- Pattern_ -> Ptr PatternIter' -> IO (String, [(Binding, Value)])
thawPattern' Pattern_
pat' Ptr PatternIter'
iter'
Bool
ok' <- Pattern_ -> Ptr PatternIter' -> IO Bool
fcPatternIterNext Pattern_
pat' Ptr PatternIter'
iter'
Pattern
xs <- if Bool
ok' then Ptr PatternIter' -> IO Pattern
go Ptr PatternIter'
iter' else Pattern -> IO Pattern
forall (m :: * -> *) a. Monad m => a -> m a
return []
Pattern -> IO Pattern
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, [(Binding, Value)])
x (String, [(Binding, Value)]) -> Pattern -> Pattern
forall a. a -> [a] -> [a]
: Pattern
xs)
else Pattern -> IO Pattern
forall (m :: * -> *) a. Monad m => a -> m a
return []
foreign import ccall "FcPatternIterStart" fcPatternIterStart ::
Pattern_ -> PatternIter_ -> IO ()
foreign import ccall "FcPatternIterIsValid" fcPatternIterIsValid ::
Pattern_ -> PatternIter_ -> IO Bool
foreign import ccall "FcPatternIterNext" fcPatternIterNext ::
Pattern_ -> PatternIter_ -> IO Bool
thawPattern' :: Pattern_ -> PatternIter_ -> IO (String, [(Binding, Value)])
thawPattern' :: Pattern_ -> Ptr PatternIter' -> IO (String, [(Binding, Value)])
thawPattern' pat' :: Pattern_
pat' iter' :: Ptr PatternIter'
iter' = do
String
obj <- CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CString -> CString
forall a. Ptr a -> Ptr a
throwNull (CString -> CString) -> IO CString -> IO CString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern_ -> Ptr PatternIter' -> IO CString
fcPatternIterGetObject Pattern_
pat' Ptr PatternIter'
iter'
Int
count <- Pattern_ -> Ptr PatternIter' -> IO Int
fcPatternIterValueCount Pattern_
pat' Ptr PatternIter'
iter'
[Maybe (Maybe (Binding, Value))]
values <- [Int]
-> (Int -> IO (Maybe (Maybe (Binding, Value))))
-> IO [Maybe (Maybe (Binding, Value))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [0..Int -> Int
forall a. Enum a => a -> a
pred Int
count] ((Int -> IO (Maybe (Maybe (Binding, Value))))
-> IO [Maybe (Maybe (Binding, Value))])
-> (Int -> IO (Maybe (Maybe (Binding, Value))))
-> IO [Maybe (Maybe (Binding, Value))]
forall a b. (a -> b) -> a -> b
$ \i :: Int
i ->
Int
-> (Value_ -> IO (Maybe (Maybe (Binding, Value))))
-> IO (Maybe (Maybe (Binding, Value)))
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
value'Size ((Value_ -> IO (Maybe (Maybe (Binding, Value))))
-> IO (Maybe (Maybe (Binding, Value))))
-> (Value_ -> IO (Maybe (Maybe (Binding, Value))))
-> IO (Maybe (Maybe (Binding, Value)))
forall a b. (a -> b) -> a -> b
$ \val' :: Value_
val' -> (Value_ -> IO (Maybe (Maybe (Binding, Value))))
-> IO (Maybe (Maybe (Binding, Value)))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Value_ -> IO (Maybe (Maybe (Binding, Value))))
-> IO (Maybe (Maybe (Binding, Value))))
-> (Value_ -> IO (Maybe (Maybe (Binding, Value))))
-> IO (Maybe (Maybe (Binding, Value)))
forall a b. (a -> b) -> a -> b
$ \binding' :: Value_
binding' -> do
Int
res <- Pattern_ -> Ptr PatternIter' -> Int -> Value_ -> Value_ -> IO Int
fcPatternIterGetValue Pattern_
pat' Ptr PatternIter'
iter' Int
i Value_
val' Value_
binding'
Int
-> IO (Maybe (Binding, Value))
-> IO (Maybe (Maybe (Binding, Value)))
forall a. Int -> IO a -> IO (Maybe a)
throwInt Int
res (IO (Maybe (Binding, Value))
-> IO (Maybe (Maybe (Binding, Value))))
-> IO (Maybe (Binding, Value))
-> IO (Maybe (Maybe (Binding, Value)))
forall a b. (a -> b) -> a -> b
$ do
Int
binding <- Value_ -> IO Int
forall a. Storable a => Ptr a -> IO a
peek Value_
binding'
Maybe Value
val' <- Value_ -> IO (Maybe Value)
thawValue Value_
val'
Maybe (Binding, Value) -> IO (Maybe (Binding, Value))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Binding, Value) -> IO (Maybe (Binding, Value)))
-> Maybe (Binding, Value) -> IO (Maybe (Binding, Value))
forall a b. (a -> b) -> a -> b
$ case Maybe Value
val' of
Just val :: Value
val | Int
binding Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Int
binding Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 2 -> (Binding, Value) -> Maybe (Binding, Value)
forall a. a -> Maybe a
Just (Int -> Binding
forall a. Enum a => Int -> a
toEnum Int
binding, Value
val)
Just val :: Value
val -> (Binding, Value) -> Maybe (Binding, Value)
forall a. a -> Maybe a
Just (Binding
Same, Value
val)
Nothing -> Maybe (Binding, Value)
forall a. Maybe a
Nothing
(String, [(Binding, Value)]) -> IO (String, [(Binding, Value)])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
obj, [Maybe (Binding, Value)] -> [(Binding, Value)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Binding, Value)] -> [(Binding, Value)])
-> [Maybe (Binding, Value)] -> [(Binding, Value)]
forall a b. (a -> b) -> a -> b
$ (Maybe (Maybe (Binding, Value)) -> Maybe (Binding, Value))
-> [Maybe (Maybe (Binding, Value))] -> [Maybe (Binding, Value)]
forall a b. (a -> b) -> [a] -> [b]
map Maybe (Maybe (Binding, Value)) -> Maybe (Binding, Value)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [Maybe (Maybe (Binding, Value))]
values)
foreign import ccall "FcPatternIterGetObject" fcPatternIterGetObject ::
Pattern_ -> PatternIter_ -> IO CString
foreign import ccall "FcPatternIterValueCount" fcPatternIterValueCount ::
Pattern_ -> PatternIter_ -> IO Int
foreign import ccall "FcPatternIterGetValue" fcPatternIterGetValue ::
Pattern_ -> PatternIter_ -> Int -> Value_ -> Ptr Int -> IO Int
thawPattern_ :: IO Pattern_ -> IO Pattern
thawPattern_ cb :: IO Pattern_
cb = IO Pattern_
-> (Pattern_ -> IO ()) -> (Pattern_ -> IO Pattern) -> IO Pattern
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Pattern_ -> Pattern_
forall a. Ptr a -> Ptr a
throwNull (Pattern_ -> Pattern_) -> IO Pattern_ -> IO Pattern_
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Pattern_
cb) Pattern_ -> IO ()
fcPatternDestroy Pattern_ -> IO Pattern
thawPattern
withNewPattern :: (Pattern_ -> IO c) -> IO c
withNewPattern cb :: Pattern_ -> IO c
cb = IO Pattern_ -> (Pattern_ -> IO ()) -> (Pattern_ -> IO c) -> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Pattern_ -> Pattern_
forall a. Ptr a -> Ptr a
throwNull (Pattern_ -> Pattern_) -> IO Pattern_ -> IO Pattern_
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Pattern_
fcPatternCreate) Pattern_ -> IO ()
fcPatternDestroy Pattern_ -> IO c
cb
foreign import ccall "FcPatternCreate" fcPatternCreate :: IO Pattern_
foreign import ccall "FcPatternDestroy" fcPatternDestroy :: Pattern_ -> IO ()
parseFontFamily :: [Token] -> ([String], Bool, [Token])
parseFontFamily :: [Token] -> ([String], Bool, [Token])
parseFontFamily (String font :: Text
font:Comma:tail :: [Token]
tail) = let (fonts :: [String]
fonts, b :: Bool
b, tail' :: [Token]
tail') = [Token] -> ([String], Bool, [Token])
parseFontFamily [Token]
tail
in (Text -> String
unpack Text
fontString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
fonts, Bool
b, [Token]
tail')
parseFontFamily (Ident font :: Text
font:Comma:tail :: [Token]
tail) = let (fonts :: [String]
fonts, b :: Bool
b, tail' :: [Token]
tail') = [Token] -> ([String], Bool, [Token])
parseFontFamily [Token]
tail
in (Text -> String
unpack Text
fontString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
fonts, Bool
b, [Token]
tail')
parseFontFamily (String font :: Text
font:tail :: [Token]
tail) = ([Text -> String
unpack Text
font], Bool
True, [Token]
tail)
parseFontFamily (Ident font :: Text
font:tail :: [Token]
tail) = ([Text -> String
unpack Text
font], Bool
True, [Token]
tail)
parseFontFamily toks :: [Token]
toks = ([], Bool
False, [Token]
toks)
parseFontFeatures :: [Token] -> ([(String, Int)], Bool, [Token])
parseFontFeatures :: [Token] -> ([(String, Int)], Bool, [Token])
parseFontFeatures (String feat :: Text
feat:toks :: [Token]
toks) | feature :: String
feature@(_:_:_:_:[]) <- Text -> String
unpack Text
feat = case [Token]
toks of
Comma:tail :: [Token]
tail -> let (feats :: [(String, Int)]
feats, b :: Bool
b, tail' :: [Token]
tail') = [Token] -> ([(String, Int)], Bool, [Token])
parseFontFeatures [Token]
tail in ((String
feature, 1)(String, Int) -> [(String, Int)] -> [(String, Int)]
forall a. a -> [a] -> [a]
:[(String, Int)]
feats, Bool
b, [Token]
tail')
Ident "on":Comma:tail :: [Token]
tail -> let (f :: [(String, Int)]
f, b :: Bool
b, t :: [Token]
t) = [Token] -> ([(String, Int)], Bool, [Token])
parseFontFeatures [Token]
tail in ((String
feature, 1)(String, Int) -> [(String, Int)] -> [(String, Int)]
forall a. a -> [a] -> [a]
:[(String, Int)]
f, Bool
b, [Token]
t)
Ident "on":tail :: [Token]
tail -> ([(String
feature, 1)], Bool
True, [Token]
tail)
Ident "off":Comma:tail :: [Token]
tail -> let (f :: [(String, Int)]
f, b :: Bool
b, t :: [Token]
t) = [Token] -> ([(String, Int)], Bool, [Token])
parseFontFeatures [Token]
tail in ((String
feature, 1)(String, Int) -> [(String, Int)] -> [(String, Int)]
forall a. a -> [a] -> [a]
:[(String, Int)]
f, Bool
b, [Token]
t)
Ident "off":tail :: [Token]
tail -> ([(String
feature, 1)], Bool
True, [Token]
tail)
Number _ (NVInteger x :: Integer
x):Comma:tail :: [Token]
tail ->
let (feats :: [(String, Int)]
feats, b :: Bool
b, tail' :: [Token]
tail') = [Token] -> ([(String, Int)], Bool, [Token])
parseFontFeatures [Token]
tail in ((String
feature, Integer -> Int
forall a. Enum a => a -> Int
fromEnum Integer
x)(String, Int) -> [(String, Int)] -> [(String, Int)]
forall a. a -> [a] -> [a]
:[(String, Int)]
feats, Bool
b, [Token]
tail')
Number _ (NVInteger x :: Integer
x):tail :: [Token]
tail -> ([(String
feature, Integer -> Int
forall a. Enum a => a -> Int
fromEnum Integer
x)], Bool
True, [Token]
tail)
parseFontFeatures toks :: [Token]
toks = ([], Bool
False, [Token]
toks)
parseFontVars :: [Token] -> ([(String, Double)], Bool, [Token])
parseFontVars :: [Token] -> ([(String, Double)], Bool, [Token])
parseFontVars (String var' :: Text
var':Number _ x :: NumericValue
x:Comma:tail :: [Token]
tail) | var :: String
var@(_:_:_:_:[]) <- Text -> String
unpack Text
var' =
let (vars :: [(String, Double)]
vars, b :: Bool
b, tail' :: [Token]
tail') = [Token] -> ([(String, Double)], Bool, [Token])
parseFontVars [Token]
tail in ((String
var, NumericValue -> Double
forall p. RealFloat p => NumericValue -> p
nv2double NumericValue
x)(String, Double) -> [(String, Double)] -> [(String, Double)]
forall a. a -> [a] -> [a]
:[(String, Double)]
vars, Bool
b, [Token]
tail')
parseFontVars (String var' :: Text
var':Number _ x :: NumericValue
x:tail :: [Token]
tail) | var :: String
var@(_:_:_:_:[]) <- Text -> String
unpack Text
var' =
([(String
var, NumericValue -> Double
forall p. RealFloat p => NumericValue -> p
nv2double NumericValue
x)], Bool
True, [Token]
tail)
parseFontVars toks :: [Token]
toks = ([], Bool
False, [Token]
toks)
parseLength :: Double -> NumericValue -> Text -> Double
parseLength :: Double -> NumericValue -> Text -> Double
parseLength super :: Double
super length :: NumericValue
length unit :: Text
unit = Double -> Text -> Double
convert (NumericValue -> Double
forall p. RealFloat p => NumericValue -> p
nv2double NumericValue
length) Text
unit
where
convert :: Double -> Text -> Double
convert = Double -> Text -> Double
forall t. (Eq t, IsString t) => Double -> t -> Double
c
c :: Double -> t -> Double
c x :: Double
x "pt" = Double
x
c x :: Double
x "pc" = Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/6 Double -> t -> Double
`c` "in"
c x :: Double
x "in" = Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/72 Double -> t -> Double
`c` "pt"
c x :: Double
x "Q" = Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/40 Double -> t -> Double
`c` "cm"
c x :: Double
x "mm" = Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/10 Double -> t -> Double
`c` "cm"
c x :: Double
x "cm" = Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2.54 Double -> t -> Double
`c` "in"
c x :: Double
x "px" = Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/96 Double -> t -> Double
`c` "in"
c x :: Double
x "em" = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
super
c x :: Double
x "%" = Double
xDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/100 Double -> t -> Double
`c` "em"
c _ _ = 0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/0
parseFontStretch :: Token -> Maybe Int
parseFontStretch :: Token -> Maybe Int
parseFontStretch (Percentage _ x :: NumericValue
x) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a. Enum a => a -> Int
fromEnum (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ NumericValue -> Double
forall p. RealFloat p => NumericValue -> p
nv2double NumericValue
x
parseFontStretch (Ident "ultra-condensed") = Int -> Maybe Int
forall a. a -> Maybe a
Just 50
parseFontStretch (Ident "extra-condensed") = Int -> Maybe Int
forall a. a -> Maybe a
Just 63
parseFontStretch (Ident "condensed") = Int -> Maybe Int
forall a. a -> Maybe a
Just 75
parseFontStretch (Ident "semi-condensed") = Int -> Maybe Int
forall a. a -> Maybe a
Just 88
parseFontStretch (Ident "normal") = Int -> Maybe Int
forall a. a -> Maybe a
Just 100
parseFontStretch (Ident "initial") = Int -> Maybe Int
forall a. a -> Maybe a
Just 100
parseFontStretch (Ident "semi-expanded") = Int -> Maybe Int
forall a. a -> Maybe a
Just 112
parseFontStretch (Ident "expanded") = Int -> Maybe Int
forall a. a -> Maybe a
Just 125
parseFontStretch (Ident "extra-expanded") = Int -> Maybe Int
forall a. a -> Maybe a
Just 150
parseFontStretch (Ident "ultra-expanded") = Int -> Maybe Int
forall a. a -> Maybe a
Just 200
parseFontStretch _ = Maybe Int
forall a. Maybe a
Nothing
parseFontWeight :: Token -> Maybe Int
parseFontWeight :: Token -> Maybe Int
parseFontWeight (Ident k :: Text
k) | Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["initial", "normal"] = Int -> Maybe Int
forall a. a -> Maybe a
Just 80
parseFontWeight (Ident "bold") = Int -> Maybe Int
forall a. a -> Maybe a
Just 200
parseFontWeight (Number _ (NVInteger x :: Integer
x)) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Int
weightFromOpenType (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Enum a => a -> Int
fromEnum Integer
x
parseFontWeight _ = Maybe Int
forall a. Maybe a
Nothing
nv2double :: NumericValue -> p
nv2double (NVInteger x :: Integer
x) = Integer -> p
forall a. Num a => Integer -> a
fromInteger Integer
x
nv2double (NVNumber x :: Scientific
x) = Scientific -> p
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
x
sets :: String -> Binding -> [x] -> Pattern -> Maybe Pattern
sets a :: String
a b :: Binding
b c :: [x]
c d :: Pattern
d = Pattern -> Maybe Pattern
forall a. a -> Maybe a
Just (Pattern -> Maybe Pattern) -> Pattern -> Maybe Pattern
forall a b. (a -> b) -> a -> b
$ String -> Binding -> [x] -> Pattern -> Pattern
forall x.
ToValue x =>
String -> Binding -> [x] -> Pattern -> Pattern
setValues String
a Binding
b [x]
c Pattern
d
set :: String -> Binding -> x -> Pattern -> Maybe Pattern
set a :: String
a b :: Binding
b c :: x
c d :: Pattern
d = Pattern -> Maybe Pattern
forall a. a -> Maybe a
Just (Pattern -> Maybe Pattern) -> Pattern -> Maybe Pattern
forall a b. (a -> b) -> a -> b
$ String -> Binding -> x -> Pattern -> Pattern
forall x. ToValue x => String -> Binding -> x -> Pattern -> Pattern
setValue String
a Binding
b x
c Pattern
d
seti :: String -> Binding -> Int -> Pattern -> Maybe Pattern
seti a :: String
a b :: Binding
b c :: Int
c d :: Pattern
d = Pattern -> Maybe Pattern
forall a. a -> Maybe a
Just (Pattern -> Maybe Pattern) -> Pattern -> Maybe Pattern
forall a b. (a -> b) -> a -> b
$ String -> Binding -> Int -> Pattern -> Pattern
forall x. ToValue x => String -> Binding -> x -> Pattern -> Pattern
setValue String
a Binding
b (Int
c :: Int) Pattern
d
unset' :: a -> [(a, b)] -> Maybe [(a, b)]
unset' a :: a
a b :: [(a, b)]
b = [(a, b)] -> Maybe [(a, b)]
forall a. a -> Maybe a
Just ([(a, b)] -> Maybe [(a, b)]) -> [(a, b)] -> Maybe [(a, b)]
forall a b. (a -> b) -> a -> b
$ a -> [(a, b)] -> [(a, b)]
forall a b. Eq a => a -> [(a, b)] -> [(a, b)]
unset a
a [(a, b)]
b
getSize :: Pattern -> Double
getSize pat :: Pattern
pat | ValueDouble x :: Double
x <- String -> Pattern -> Value
getValue "size" Pattern
pat = Double
x
| Bool
otherwise = 10
instance PropertyParser Pattern where
temp :: Pattern
temp = []
longhand :: Pattern -> Pattern -> Text -> [Token] -> Maybe Pattern
longhand _ self :: Pattern
self "font-family" toks :: [Token]
toks
| (fonts :: [String]
fonts, True, []) <- [Token] -> ([String], Bool, [Token])
parseFontFamily [Token]
toks = String -> Binding -> [String] -> Pattern -> Maybe Pattern
forall x.
ToValue x =>
String -> Binding -> [x] -> Pattern -> Maybe Pattern
sets "family" Binding
Strong [String]
fonts Pattern
self
longhand super :: Pattern
super self :: Pattern
self "font-size" [Dimension _ x :: NumericValue
x unit :: Text
unit]
| let y :: Double
y = Double -> NumericValue -> Text -> Double
parseLength (Pattern -> Double
getSize Pattern
super) NumericValue
x Text
unit, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
y =
String -> Binding -> Double -> Pattern -> Maybe Pattern
forall x.
ToValue x =>
String -> Binding -> x -> Pattern -> Maybe Pattern
set "size" Binding
Strong Double
y Pattern
self
longhand super :: Pattern
super self :: Pattern
self "font-size" [Percentage x :: Text
x y :: NumericValue
y] =
Pattern -> Pattern -> Text -> [Token] -> Maybe Pattern
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand Pattern
super Pattern
self "font-size" [Text -> NumericValue -> Text -> Token
Dimension Text
x NumericValue
y "%"]
longhand _ self :: Pattern
self "font-style" [Ident "initial"] = String -> Binding -> Int -> Pattern -> Maybe Pattern
seti "slant" Binding
Strong 0 Pattern
self
longhand _ self :: Pattern
self "font-style" [Ident "normal"] = String -> Binding -> Int -> Pattern -> Maybe Pattern
seti "slant" Binding
Strong 0 Pattern
self
longhand _ self :: Pattern
self "font-style" [Ident "italic"] = String -> Binding -> Int -> Pattern -> Maybe Pattern
seti "slant" Binding
Strong 100 Pattern
self
longhand _ self :: Pattern
self "font-style" [Ident "oblique"] = String -> Binding -> Int -> Pattern -> Maybe Pattern
seti "slant" Binding
Strong 110 Pattern
self
longhand _ self :: Pattern
self "font-weight" [tok :: Token
tok]
| Just x :: Int
x <- Token -> Maybe Int
parseFontWeight Token
tok = String -> Binding -> Int -> Pattern -> Maybe Pattern
seti "weight" Binding
Strong Int
x Pattern
self
longhand super :: Pattern
super self :: Pattern
self "font-weight" [Number _ (NVInteger x :: Integer
x)]
| Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> 920 = Pattern -> Pattern -> Text -> [Token] -> Maybe Pattern
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand Pattern
super Pattern
self "font-weight" [Text -> NumericValue -> Token
Number "" (NumericValue -> Token) -> NumericValue -> Token
forall a b. (a -> b) -> a -> b
$ Integer -> NumericValue
NVInteger 950]
| Bool
otherwise = Pattern -> Pattern -> Text -> [Token] -> Maybe Pattern
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand Pattern
super Pattern
self "font-weight" [Text -> NumericValue -> Token
Number "" (NumericValue -> Token) -> NumericValue -> Token
forall a b. (a -> b) -> a -> b
$ Integer -> NumericValue
NVInteger (Integer -> NumericValue) -> Integer -> NumericValue
forall a b. (a -> b) -> a -> b
$ (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 100) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 100]
longhand _ self :: Pattern
self "font-weight" [Ident "lighter"]
| ValueInt x :: Int
x <- String -> Pattern -> Value
getValue "weight" Pattern
self, Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 200 = String -> Binding -> Int -> Pattern -> Maybe Pattern
seti "weight" Binding
Strong 200 Pattern
self
| ValueInt x :: Int
x <- String -> Pattern -> Value
getValue "weight" Pattern
self = String -> Binding -> Int -> Pattern -> Maybe Pattern
seti "weight" Binding
Strong (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 100) 0) Pattern
self
| Bool
otherwise = String -> Binding -> Int -> Pattern -> Maybe Pattern
seti "weight" Binding
Strong 0 Pattern
self
longhand _ self :: Pattern
self "font-weight" [Ident "bolder"]
| ValueInt x :: Int
x <- String -> Pattern -> Value
getValue "weight" Pattern
self, Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 65 = String -> Binding -> Int -> Pattern -> Maybe Pattern
seti "weight" Binding
Strong 80 Pattern
self
| ValueInt x :: Int
x <- String -> Pattern -> Value
getValue "weight" Pattern
self, Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 150 = String -> Binding -> Int -> Pattern -> Maybe Pattern
seti "weight" Binding
Strong 200 Pattern
self
| ValueInt x :: Int
x <- String -> Pattern -> Value
getValue "weight" Pattern
self, Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 210 = String -> Binding -> Int -> Pattern -> Maybe Pattern
seti "weight" Binding
Strong 210 Pattern
self
| ValueInt _ <- String -> Pattern -> Value
getValue "weight" Pattern
self = Pattern -> Maybe Pattern
forall a. a -> Maybe a
Just Pattern
self
| Bool
otherwise = String -> Binding -> Int -> Pattern -> Maybe Pattern
seti "weight" Binding
Strong 200 Pattern
self
longhand _ self :: Pattern
self "font-feature-settings" [Ident k :: Text
k]
| Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["initial", "normal"] = String -> Pattern -> Maybe Pattern
forall a b. Eq a => a -> [(a, b)] -> Maybe [(a, b)]
unset' "fontfeatures" Pattern
self
longhand _ self :: Pattern
self "font-feature-settings" toks :: [Token]
toks
| (features :: [(String, Int)]
features, True, []) <- [Token] -> ([(String, Int)], Bool, [Token])
parseFontFeatures [Token]
toks =
String -> Binding -> String -> Pattern -> Maybe Pattern
forall x.
ToValue x =>
String -> Binding -> x -> Pattern -> Maybe Pattern
set "fontfeatures" Binding
Strong (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "," ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> String) -> [(String, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> String
forall a b. (a, b) -> a
fst [(String, Int)]
features) Pattern
self
longhand _ self :: Pattern
self "font-variation-settings" [Ident k :: Text
k]
| Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["initial", "normal"] = String -> Pattern -> Maybe Pattern
forall a b. Eq a => a -> [(a, b)] -> Maybe [(a, b)]
unset' "variable" Pattern
self
longhand _ self :: Pattern
self "font-variation-settings" toks :: [Token]
toks
| (_, True, []) <- [Token] -> ([(String, Double)], Bool, [Token])
parseFontVars [Token]
toks = String -> Binding -> Bool -> Pattern -> Maybe Pattern
forall x.
ToValue x =>
String -> Binding -> x -> Pattern -> Maybe Pattern
set "variable" Binding
Strong Bool
True Pattern
self
longhand _ s :: Pattern
s "font-stretch" [tok :: Token
tok]
| Just x :: Int
x <- Token -> Maybe Int
parseFontStretch Token
tok = String -> Binding -> Int -> Pattern -> Maybe Pattern
seti "width" Binding
Strong Int
x Pattern
s
longhand _ _ _ _ = Maybe Pattern
forall a. Maybe a
Nothing