@@ 24,12 24,12 @@ import Graphics.Text.Font.Choose.ObjectSet
import Graphics.Text.Font.Choose.Result
import Graphics.Text.Font.Choose.Weight
-import Stylist (PropertyParser(..))
+import Stylist (PropertyParser(..), parseUnorderedShorthand', parseOperands)
import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Data.Text (Text, unpack)
import qualified Data.Text as Txt
-import Data.Scientific (toRealFloat)
import Data.List (intercalate)
+import Data.Scientific (toRealFloat)
import Data.Maybe as Mb (listToMaybe, fromMaybe, mapMaybe)
import Data.Char (isAscii)
import Prelude as L
@@ 155,13 155,13 @@ parseFontFeatures :: [Token] -> ([(String, Int)], Bool, [Token])
parseFontFeatures (String feat:toks) | feature@(_:_:_:_:[]) <- unpack feat = case toks of
Comma:toks' -> let (feats, b, tail') = parseFontFeatures toks' in ((feature, 1):feats, b, tail')
Ident "on":Comma:toks' -> let (f, b, t) = parseFontFeatures toks' in ((feature, 1):f, b, t)
- Ident "on":toks' -> ([(feature, 1)], True, toks')
+ Ident "on":toks' -> ([(feature, 1)], L.null toks', toks')
Ident "off":Comma:toks' -> let (f, b, t) = parseFontFeatures toks' in ((feature, 1):f, b, t)
- Ident "off":toks' -> ([(feature, 1)], True, toks')
+ Ident "off":toks' -> ([(feature, 1)], L.null toks', toks')
Number _ (NVInteger x):Comma:toks' ->
let (feats, b, tail') = parseFontFeatures toks' in ((feature, fromEnum x):feats, b, tail')
- Number _ (NVInteger x):toks' -> ([(feature, fromEnum x)], True, toks')
- _ -> ([], False, String feat:toks)
+ Number _ (NVInteger x):toks' -> ([(feature, fromEnum x)], L.null toks', toks')
+ _ -> ([(feature, 1)], L.null toks, toks)
parseFontFeatures toks = ([], False, toks)
-- | Parse OpenType variables from CSS syntax.
@@ 177,14 177,14 @@ parseLength super len unit = convert (nv2double len) unit
where
convert = c
c x "pt" = x -- Unit FontConfig expects!
- c x "pc" = x/6 `c` "in"
- c x "in" = x/72 `c` "pt"
- c x "Q" = x/40 `c` "cm"
- c x "mm" = x/10 `c` "cm"
- c x "cm" = x/2.54 `c` "in"
- c x "px" = x/96 `c` "in" -- Conversion factor during early days of CSS, got entrenched.
+ c x "pc" = (x/6) `c` "in"
+ c x "in" = (x/72) `c` "pt"
+ c x "Q" = (x/40) `c` "cm"
+ c x "mm" = (x/10) `c` "cm"
+ c x "cm" = (x/2.54) `c` "in"
+ c x "px" = (x/96) `c` "in" -- Conversion factor during early days of CSS, got entrenched.
c x "em" = x * super
- c x "%" = x/100 `c` "em"
+ c x "%" = (x/100) `c` "em"
c _ _ = 0/0 -- NaN
-- | Parse the CSS font-stretch property.
@@ 239,11 239,30 @@ instance PropertyParser Pattern' where
Pattern' <$> set "size" Strong y self
longhand super self "font-size" [Percentage x y] =
longhand super self "font-size" [Dimension x y "%"]
+ -- NOTE: Approximate implementation, caller should supply a real one!
+ longhand (Pattern' super) (Pattern' self) "font-size" [Ident x] =
+ let y = 10 :: Double in Pattern' <$> case x of
+ -- NOTE: If a caller wants to be more precise about the base size (a.k.a `y`)
+ -- they should parse it themselves!
+ "xx-small" -> set "size" Strong (3/5*y) self
+ "x-small" -> set "size" Strong (3/4*y) self
+ "small" -> set "size" Strong (8/9*y) self
+ "medium" -> set "size" Strong y self
+ "large" -> set "size" Strong (6/5*y) self
+ "x-large" -> set "size" Strong (3/2*y) self
+ "xx-large" -> set "size" Strong (2*y) self
+ "xxx-large" -> set "size" Strong (3*y) self
+ -- NOTE: Spec encourages a more complex formula, caller should implement!
+ "smaller" -> set "size" Strong (getSize super/1.2) self
+ "larger" -> set "size" Strong (getSize super*1.2) self
+ _ -> Nothing
longhand _ (Pattern' self) "font-style" [Ident "initial"] = Pattern' <$> seti "slant" Strong 0 self
longhand _ (Pattern' self) "font-style" [Ident "normal"] = Pattern' <$> seti "slant" Strong 0 self
longhand _ (Pattern' self) "font-style" [Ident "italic"] = Pattern' <$> seti "slant" Strong 100 self
longhand _ (Pattern' self) "font-style" [Ident "oblique"] = Pattern' <$> seti "slant" Strong 110 self
+ longhand _ (Pattern' self) "font-style" [Ident "oblique", Dimension _ _ unit]
+ | unit `elem` Txt.words "deg grad rad turn" = Pattern' <$> seti "slant" Strong 110 self
-- Conversion between CSS scale & FontConfig scale is non-trivial, use lookuptable.
-- FIXME: Use Graphics.Text.Font.Choose.Weight!
@@ 273,14 292,46 @@ instance PropertyParser Pattern' where
| k `elem` ["initial", "normal"] = Pattern' <$> unset' "fontfeatures" self
longhand _ (Pattern' self) "font-feature-settings" toks
| (features, True, []) <- parseFontFeatures toks = Pattern' <$>
- set "fontfeatures" Strong (intercalate "," $ L.map fst features) self
+ sets "fontfeatures" Strong (L.map fst features) self
longhand _ (Pattern' self) "font-variation-settings" [Ident k]
| k `elem` ["initial", "normal"] = Pattern' <$> unset' "variable" self
longhand _ (Pattern' self) "font-variation-settings" toks
- | (_, True, []) <- parseFontVars toks = Pattern' <$> set "variable" Strong True self
+ | (vars , True, []) <- parseFontVars toks =
+ Pattern' <$> (set "variable" Strong True =<<
+ set "fontvariations" Strong (intercalate "," $ L.map fst vars) self)
longhand _ (Pattern' s) "font-stretch" [tok]
| Just x <- parseFontStretch tok = Pattern' <$> seti "width" Strong x s
longhand _ _ _ _ = Nothing
+
+ shorthand self "font" toks = case parseOperands toks of
+ (a:b:c:d:toks') | ret@(_:_) <- unordered [a,b,c,d] -> inner ret toks'
+ (a:b:c:toks') | ret@(_:_) <- unordered [a,b,c] -> inner ret toks'
+ (a:b:toks') | ret@(_:_) <- unordered [a,b] -> inner ret toks'
+ (a:toks') | ret@(_:_) <- unordered [a] -> inner ret toks'
+ toks' -> inner [] toks'
+ where
+ unordered operands =
+ let ret = parseUnorderedShorthand' self [
+ "font-style", "font-variant", "font-weight", "font-stretch"
+ ] operands
+ in if ("", []) `elem` ret then [] else ret -- Check for errors!
+ inner ret (sz:[Delim '/']:height:family)
+ | Just _ <- longhand self self "font-size" sz,
+ Just _ <- longhand self self "line-height" height,
+ Just _ <- longhand self self "font-family" $ concat family =
+ ("font-size", sz):("line-height", height):
+ ("font-family", concat family):ret
+ | otherwise = []
+ inner ret (sz:family)
+ | Just _ <- longhand self self "font-size" sz,
+ Just _ <- longhand self self "font-family" $ concat family =
+ ("font-size", sz):("line-height", [Ident "initial"]):
+ ("font-family", concat family):ret
+ | otherwise = []
+ inner _ _ = []
+
+ shorthand self k v | Just _ <- longhand self self k v = [(k, v)]
+ | otherwise = []
@@ 16,6 16,9 @@ import GHC.Real (infinity)
import Graphics.Text.Font.Choose
import Graphics.Text.Font.Choose.Internal.Test
+import qualified Graphics.Text.Font.Choose.Pattern as Pat
+import Data.CSS.Syntax.Tokens (Token(..), NumericValue(NVInteger), tokenize)
+import Stylist (PropertyParser(..))
main :: IO ()
main = hspec $ do
@@ 133,6 136,7 @@ main = hspec $ do
("weight", [(Strong, ValueRange $ Range 100 200)])
]
describe "CSS Parsing" $ do
+ -- Taking test cases from MDN!
it "unicode-range" $ do
let parseCharSet' = IS.toList . fromMaybe IS.empty . parseCharSet
parseCharSet' "U+26" `shouldBe` [0x26]
@@ 141,3 145,196 @@ main = hspec $ do
parseCharSet' "U+0025-00FF" `shouldBe` [0x0025..0x00ff]
parseCharSet' "U+4??" `shouldBe` [0x400..0x4ff]
parseCharSet' "U+0025-00FF, U+4??" `shouldBe` [0x0025..0x00ff] ++ [0x400..0x4ff]
+ it "font-stretch" $ do
+ let parseFontStretch' = Pat.parseFontStretch . Ident
+ let parseFontStretch_ = Pat.parseFontStretch . Percentage "" . NVInteger
+ parseFontStretch' "condensed" `shouldBe` Just 75
+ parseFontStretch' "expanded" `shouldBe` Just 125
+ parseFontStretch' "ultra-expanded" `shouldBe` Just 200
+ parseFontStretch_ 50 `shouldBe` Just 50
+ parseFontStretch_ 100 `shouldBe` Just 100
+ parseFontStretch_ 150 `shouldBe` Just 150
+ it "font-weight" $ do
+ let parseFontWeight' = Pat.parseFontWeight . Ident
+ let parseFontWeight_ = Pat.parseFontWeight . Number "" . NVInteger
+ parseFontWeight' "normal" `shouldBe` Just 80
+ parseFontWeight' "bold" `shouldBe` Just 200
+ parseFontWeight_ 100 `shouldBe` Just 0
+ parseFontWeight_ 900 `shouldBe` Just 210
+ it "font-feature-settings" $ do
+ Pat.parseFontFeatures [String "liga", Number "0" $ NVInteger 0] `shouldBe` ([
+ ("liga", 0)
+ ], True, [])
+ Pat.parseFontFeatures [String "tnum"] `shouldBe` ([
+ ("tnum", 1)
+ ], True, [])
+ Pat.parseFontFeatures [String "tnum"] `shouldBe` ([
+ ("tnum", 1)
+ ], True, [])
+ Pat.parseFontFeatures [String "scmp", Comma, String "zero"] `shouldBe` ([
+ ("scmp", 1),
+ ("zero", 1)
+ ], True, [])
+ it "font-variation-settings" $ do
+ Pat.parseFontVars [String "wght", Number "50" $ NVInteger 50] `shouldBe` ([
+ ("wght", 50)
+ ], True, [])
+ Pat.parseFontVars [String "wght", Number "850" $ NVInteger 850] `shouldBe` ([
+ ("wght", 850)
+ ], True, [])
+ Pat.parseFontVars [String "wdth", Number "25" $ NVInteger 25] `shouldBe` ([
+ ("wdth", 25)
+ ], True, [])
+ Pat.parseFontVars [String "wdth", Number "75" $ NVInteger 75] `shouldBe` ([
+ ("wdth", 75)
+ ], True, [])
+ it "To FontConfig pattern" $ do
+ let tProp k v =
+ longhand temp temp k $ filter (/= Whitespace) $ tokenize v
+ let list2pat' = Pattern' . M.fromList
+ let list2pat = Just . list2pat'
+
+ tProp "font-family" "Georgia, serif" `shouldBe` list2pat [
+ ("family", [(Strong, ValueString "Georgia"), (Strong, ValueString "serif")])
+ ]
+ tProp "font-family" "\"Gill Sans\", sans-serif" `shouldBe` list2pat [
+ ("family", [
+ (Strong, ValueString "Gill Sans"),
+ (Strong, ValueString "sans-serif")
+ ])
+ ]
+ tProp "font-family" "sans-serif" `shouldBe` list2pat [
+ ("family", [(Strong, ValueString "sans-serif")])
+ ]
+ tProp "font-family" "serif" `shouldBe` list2pat [
+ ("family", [(Strong, ValueString "serif")])
+ ]
+ tProp "font-family" "cursive" `shouldBe` list2pat [
+ ("family", [(Strong, ValueString "cursive")])
+ ]
+ tProp "font-family" "system-ui" `shouldBe` list2pat [
+ ("family", [(Strong, ValueString "system-ui")])
+ ]
+
+ tProp "font-size" "1.2em" `shouldBe` list2pat [
+ ("size", [(Strong, ValueDouble 12)])
+ ]
+ tProp "font-size" "x-small" `shouldBe` list2pat [
+ ("size", [(Strong, ValueDouble 7.5)])
+ ]
+ tProp "font-size" "smaller" `shouldBe` list2pat [
+ ("size", [(Strong, ValueDouble 8.333333333333334)])
+ ]
+ tProp "font-size" "12px" `shouldBe` list2pat [
+ ("size", [(Strong, ValueDouble $ 0.125/72)])
+ ]
+ tProp "font-size" "80%" `shouldBe` list2pat [
+ ("size", [(Strong, ValueDouble 8)])
+ ]
+
+ tProp "font-style" "normal" `shouldBe` list2pat [
+ ("slant", [(Strong, ValueInt 0)])
+ ]
+ tProp "font-style" "italic" `shouldBe` list2pat [
+ ("slant", [(Strong, ValueInt 100)])
+ ]
+ tProp "font-style" "oblique" `shouldBe` list2pat [
+ ("slant", [(Strong, ValueInt 110)])
+ ]
+ tProp "font-style" "oblique 40deg" `shouldBe` list2pat [
+ ("slant", [(Strong, ValueInt 110)])
+ ]
+
+ tProp "font-weight" "normal" `shouldBe` list2pat [
+ ("weight", [(Strong, ValueInt 80)])
+ ]
+ tProp "font-weight" "bold" `shouldBe` list2pat [
+ ("weight", [(Strong, ValueInt 200)])
+ ]
+ tProp "font-weight" "lighter" `shouldBe` list2pat [
+ ("weight", [(Strong, ValueInt 0)])
+ ]
+ tProp "font-weight" "bolder" `shouldBe` list2pat [
+ ("weight", [(Strong, ValueInt 200)])
+ ]
+ tProp "font-weight" "100" `shouldBe` list2pat [
+ ("weight", [(Strong, ValueInt 0)])
+ ]
+ tProp "font-weight" "900" `shouldBe` list2pat [
+ ("weight", [(Strong, ValueInt 210)])
+ ]
+
+ tProp "font-feature-settings" "normal" `shouldBe` list2pat []
+ tProp "font-feature-settings" "\"liga\" 0" `shouldBe` list2pat [
+ ("fontfeatures", [(Strong, ValueString "liga")])
+ ]
+ tProp "font-feature-settings" "\"tnum\"" `shouldBe` list2pat [
+ ("fontfeatures", [(Strong, ValueString "tnum")])
+ ]
+ tProp "font-feature-settings" "\"smcp\", \"zero\"" `shouldBe` list2pat [
+ ("fontfeatures", [
+ (Strong, ValueString "smcp"),
+ (Strong, ValueString "zero")
+ ])
+ ]
+
+ tProp "font-variation-settings" "'wght' 50" `shouldBe` list2pat [
+ ("variable", [(Strong, ValueBool True)]),
+ ("fontvariations", [(Strong, ValueString "wght")])
+ ]
+ tProp "font-variation-settings" "'wght' 850" `shouldBe` list2pat [
+ ("variable", [(Strong, ValueBool True)]),
+ ("fontvariations", [(Strong, ValueString "wght")])
+ ]
+ tProp "font-variation-settings" "'wdth' 25" `shouldBe` list2pat [
+ ("variable", [(Strong, ValueBool True)]),
+ ("fontvariations", [(Strong, ValueString "wdth")])
+ ]
+ tProp "font-variation-settings" "'wdth' 75" `shouldBe` list2pat [
+ ("variable", [(Strong, ValueBool True)]),
+ ("fontvariations", [(Strong, ValueString "wdth")])
+ ]
+
+ tProp "font-stretch" "condensed" `shouldBe` list2pat [
+ ("width", [(Strong, ValueInt 75)])
+ ]
+ tProp "font-stretch" "expanded" `shouldBe` list2pat [
+ ("width", [(Strong, ValueInt 125)])
+ ]
+ tProp "font-stretch" "ultra-expanded" `shouldBe` list2pat [
+ ("width", [(Strong, ValueInt 200)])
+ ]
+ tProp "font-stretch" "50%" `shouldBe` list2pat [
+ ("width", [(Strong, ValueInt 50)])
+ ]
+ tProp "font-stretch" "100%" `shouldBe` list2pat [
+ ("width", [(Strong, ValueInt 100)])
+ ]
+ tProp "font-stretch" "150%" `shouldBe` list2pat [
+ ("width", [(Strong, ValueInt 150)])
+ ]
+
+ let tShort :: PropertyParser p => Txt.Text -> Txt.Text -> p
+ tShort k v = let temp' = temp in
+ foldl (\self (key, val) ->
+ fromMaybe self $ longhand (inherit temp') self key val)
+ temp' $ shorthand temp' k $ filter (/= Whitespace) $ tokenize v
+ tShort "font" "1.2em 'Fira Sans', sans-serif" `shouldBe` list2pat' [
+ ("size", [(Strong, ValueDouble 12)]),
+ ("family", [(Strong, ValueString "Fira Sans"), (Strong, ValueString "sans-serif")])
+ ]
+ tShort "font" "italic 1.2em 'Fira Sans', serif" `shouldBe` list2pat' [
+ ("slant", [(Strong, ValueInt 100)]),
+ ("size", [(Strong, ValueDouble 12)]),
+ ("family", [(Strong, ValueString "Fira Sans"), (Strong, ValueString "serif")]),
+ ("weight",[(Strong,ValueInt 80)]), ("width",[(Strong,ValueInt 100)])
+ ]
+ tShort "font" "italic bold 16px cursive" `shouldBe` list2pat' [
+ ("slant", [(Strong, ValueInt 100)]),
+ ("size", [(Strong, ValueDouble 2.3148148148148147e-3)]),
+ ("weight", [(Strong, ValueInt 200)]),
+ ("family", [(Strong, ValueString "cursive")]),
+ ("width",[(Strong,ValueInt 100)])
+ ]
+ it "@font-face" $ do
+ "I'm procrastinating this" `shouldBe` "I'm procrastinating this"