From dfce3326f7f5b2367df56675e92742b3d5f7fbc3 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Fri, 9 Aug 2024 16:56:37 +1200 Subject: [PATCH] Test @font-face parsing. --- lib/Graphics/Text/Font/Choose/FontSet.hs | 15 +++- test/Main.hs | 103 ++++++++++++++++++++++- 2 files changed, 113 insertions(+), 5 deletions(-) diff --git a/lib/Graphics/Text/Font/Choose/FontSet.hs b/lib/Graphics/Text/Font/Choose/FontSet.hs index 21c3132..938caa6 100644 --- a/lib/Graphics/Text/Font/Choose/FontSet.hs +++ b/lib/Graphics/Text/Font/Choose/FontSet.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CApiFFI, OverloadedStrings #-} -- | A set of fonts to query, or resulting from a query. module Graphics.Text.Font.Choose.FontSet( - FontSet, validFontSet, fontSetList, fontSetMatch, fontSetSort, FontFaceParser(..) + FontSet, validFontSet, fontSetList, fontSetMatch, fontSetSort, FontFaceParser(..), emptyParser ) where import Graphics.Text.Font.Choose.Pattern hiding (map) @@ -18,6 +18,7 @@ import Stylist (StyleSheet(..)) import Stylist.Parse (parseProperties) import Data.CSS.Syntax.Tokens (Token(..), serialize) import Data.Text (Text, unpack) +import qualified Data.Text as Txt import qualified Data.Map as M import Data.List (intercalate) @@ -81,6 +82,9 @@ arg = flip withMessage -- | `StyleSheet` wrapper to parse @font-face rules. data FontFaceParser a = FontFaceParser { cssFonts :: FontSet, cssInner :: a} +emptyParser :: a -> FontFaceParser a +emptyParser = FontFaceParser [] + parseFontFaceSrc :: [Token] -> [String] parseFontFaceSrc (Function "local":Ident name:RightParen:Comma:rest) = ("local:" ++ unpack name):parseFontFaceSrc rest @@ -89,6 +93,9 @@ parseFontFaceSrc (Function "local":String name:RightParen:Comma:rest) = parseFontFaceSrc (Function "local":Ident name:RightParen:[]) = ["local:" ++ unpack name] parseFontFaceSrc (Function "local":String name:RightParen:[]) = ["local:" ++ unpack name] +parseFontFaceSrc (Function "url":String link:RightParen:toks) = + parseFontFaceSrc (Url link:toks) -- TODO: Why's this needed? + parseFontFaceSrc (Url link:toks) | Comma:rest <- skipMeta toks = unpack link:parseFontFaceSrc rest | [] <- skipMeta toks = [unpack link] @@ -118,7 +125,7 @@ properties2font (("font-stretch", [start, end]):props) M.insert "width" [(Strong, v $ iRange x y)] $ properties2font props properties2font (("font-weight", [tok]):props) | Just x <- parseFontWeight tok = - M.insert "width" [(Strong, v x)] $ properties2font props + M.insert "weight" [(Strong, v x)] $ properties2font props properties2font (("font-weight", [start, end]):props) | Just x <- parseFontStretch start, Just y <- parseFontStretch end = M.insert "weight" [(Strong, v $ iRange x y)] $ properties2font props @@ -133,13 +140,13 @@ properties2font (("font-variation-settings", toks):props) M.insert "variable" [(Strong, v $ True)] $ properties2font props properties2font (("unicode-range", toks):props) - | Just chars <- parseCharSet $ unpack $ serialize toks = + | Just chars <- parseCharSet $ unpack $ Txt.replace "/**/" "" $ serialize toks = M.insert "charset" [(Strong, v $ CharSet' chars)] $ properties2font props -- Ignoring metadata & trusting in FreeType's broad support for fonts. properties2font (("src", toks):props) | fonts@(_:_) <- parseFontFaceSrc toks, "" `notElem` fonts = - M.insert "web-src" [(Strong, v $ intercalate "\t" fonts)] $ properties2font props + M.insert "web-src" [(Strong, v f) | f <- fonts] $ properties2font props properties2font (_:props) = properties2font props properties2font [] = M.empty diff --git a/test/Main.hs b/test/Main.hs index c239db7..98f7850 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -19,6 +19,7 @@ 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(..)) +import qualified Stylist.Parse as CSS main :: IO () main = hspec $ do @@ -337,4 +338,104 @@ main = hspec $ do ("width",[(Strong,ValueInt 100)]) ] it "@font-face" $ do - "I'm procrastinating this" `shouldBe` "I'm procrastinating this" + let tRule = cssFonts . CSS.parse (emptyParser ()) + let tRule' = tRule . Txt.unlines + let list2pat = M.fromList + tRule "" `shouldBe` [] + tRule "@font-face {font-family: OpenSans}" `shouldBe` [list2pat [ + ("family", [(Strong, ValueString "OpenSans")]) + ]] + tRule "@font-face {font-family: 'Open Sans'}" `shouldBe` [list2pat [ + ("family", [(Strong, ValueString "Open Sans")]) + ]] + + tRule "@font-face {font-stretch: condensed}" `shouldBe` [list2pat [ + ("width", [(Strong, ValueInt 75)]) + ]] + tRule "@font-face {font-stretch: expanded}" `shouldBe` [list2pat [ + ("width", [(Strong, ValueInt 125)]) + ]] + tRule "@font-face {font-stretch: ultra-expanded}" `shouldBe` [list2pat [ + ("width", [(Strong, ValueInt 200)]) + ]] + tRule "@font-face {font-stretch: 50%}" `shouldBe` [list2pat [ + ("width", [(Strong, ValueInt 50)]) + ]] + tRule "@font-face {font-stretch: 100%}" `shouldBe` [list2pat [ + ("width", [(Strong, ValueInt 100)]) + ]] + tRule "@font-face {font-stretch: 150%}" `shouldBe` [list2pat [ + ("width", [(Strong, ValueInt 150)]) + ]] + + tRule "@font-face {font-weight: normal}" `shouldBe` [list2pat [ + ("weight", [(Strong, ValueInt 80)]) + ]] + tRule "@font-face {font-weight: bold}" `shouldBe` [list2pat [ + ("weight", [(Strong, ValueInt 200)]) + ]] + tRule "@font-face {font-weight: 100}" `shouldBe` [list2pat [ + ("weight", [(Strong, ValueInt 0)]) + ]] + tRule "@font-face {font-weight: 900}" `shouldBe` [list2pat [ + ("weight", [(Strong, ValueInt 210)]) + ]] + + tRule "@font-face {font-feature-settings: normal}" `shouldBe` [list2pat []] + tRule "@font-face {font-feature-settings: \"liga\" 0}" `shouldBe` [list2pat [ + ("fontfeatures", [(Strong, ValueString "liga")]) + ]] + tRule "@font-face {font-feature-settings: \"tnum\"}" `shouldBe` [list2pat [ + ("fontfeatures", [(Strong, ValueString "tnum")]) + ]] + tRule "@font-face {font-feature-settings: \"smcp\", \"zero\"}" `shouldBe` [list2pat [ + ("fontfeatures", [ + (Strong, ValueString "smcp,zero") -- Is this right? + ]) + ]] + + tRule "@font-face {font-variation-settings: 'wght' 50}" `shouldBe` [list2pat [ + ("variable", [(Strong, ValueBool True)]) + ]] + tRule "@font-face {font-variation-settings: 'wght' 850}" `shouldBe` [list2pat [ + ("variable", [(Strong, ValueBool True)]) + ]] + tRule "@font-face {font-variation-settings: 'wdth' 25}" `shouldBe` [list2pat [ + ("variable", [(Strong, ValueBool True)]) + ]] + tRule "@font-face {font-variation-settings: 'wdth' 75}" `shouldBe` [list2pat [ + ("variable", [(Strong, ValueBool True)]) + ]] + + tRule "@font-face {unicode-range: U+26}" `shouldBe` [list2pat [ + ("charset", [(Strong, ValueCharSet $ IS.fromList [0x26])]) + ]] + tRule "@font-face {unicode-range: U+0-7F}" `shouldBe` [list2pat [ + ("charset", [(Strong, ValueCharSet $ IS.fromList [0..0x7f])]) + ]] + tRule "@font-face {unicode-range: U+0025-00FF}" `shouldBe` [list2pat [ + ("charset", [(Strong, ValueCharSet $ IS.fromList [0x25..0xff])]) + ]] + tRule "@font-face {unicode-range: U+4??}" `shouldBe` [list2pat [ + ("charset", [(Strong, ValueCharSet $ IS.fromList [0x400..0x4ff])]) + ]] + tRule "@font-face {unicode-range: U+0025-00FF, U+4??}" `shouldBe` [list2pat [ + ("charset", [(Strong, ValueCharSet $ IS.fromList ([0x25..0xff] ++ [0x400..0x4ff]))]) + ]] + + tRule' [ + "@font-face {", + " font-family: \"Trickster\";", + " src:", + " local(\"Trickster\"),", + " url(\"trickster-COLRv1.otf\") format(\"opentype\") tech(color-COLRv1),", + " url(\"trickster-outline.otf\") format(\"opentype\"),", + " url(\"trickster-outline.woff\") format(\"woff\");", + "}" + ] `shouldBe` [list2pat [ + ("family", [(Strong, ValueString "Trickster")]), + ("web-src", [(Strong, ValueString "local:Trickster"), + (Strong, ValueString "trickster-COLRv1.otf"), + (Strong, ValueString "trickster-outline.otf"), + (Strong, ValueString "trickster-outline.woff")]) + ]] -- 2.30.2