From b52f3294e5b7747d088a1d7da359aac85ca69683 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Sun, 21 Jul 2024 17:14:09 +1200 Subject: [PATCH] Test CSS property parsing! --- fontconfig-pure.cabal | 2 +- lib/Graphics/Text/Font/Choose/Pattern.hs | 81 ++++++++-- test/Main.hs | 197 +++++++++++++++++++++++ 3 files changed, 264 insertions(+), 16 deletions(-) diff --git a/fontconfig-pure.cabal b/fontconfig-pure.cabal index c7cc2c6..4edb570 100644 --- a/fontconfig-pure.cabal +++ b/fontconfig-pure.cabal @@ -147,4 +147,4 @@ test-suite fontconfig-pure-test base ^>=4.17.0.0, fontconfig-pure, hspec, QuickCheck, - msgpack, containers, text + msgpack, containers, text, css-syntax, stylist-traits diff --git a/lib/Graphics/Text/Font/Choose/Pattern.hs b/lib/Graphics/Text/Font/Choose/Pattern.hs index de5142b..9227caf 100644 --- a/lib/Graphics/Text/Font/Choose/Pattern.hs +++ b/lib/Graphics/Text/Font/Choose/Pattern.hs @@ -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 = [] diff --git a/test/Main.hs b/test/Main.hs index d308909..c239db7 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -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" -- 2.30.2