From 67bb6d072c5754ffde9298cbd262273eb7fd4051 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Fri, 2 Dec 2022 13:51:59 +1300
Subject: [PATCH] Parse unicode-range property for @font-face.

---
 Graphics/Text/Font/Choose/CharSet.hs | 27 +++++++++++++++++++++++++--
 Graphics/Text/Font/Choose/FontSet.hs |  7 ++++++-
 2 files changed, 31 insertions(+), 3 deletions(-)

diff --git a/Graphics/Text/Font/Choose/CharSet.hs b/Graphics/Text/Font/Choose/CharSet.hs
index 303ae7d..2af63e3 100644
--- a/Graphics/Text/Font/Choose/CharSet.hs
+++ b/Graphics/Text/Font/Choose/CharSet.hs
@@ -1,6 +1,6 @@
 module Graphics.Text.Font.Choose.CharSet where
 
-import Data.Set (Set)
+import Data.Set (Set, union)
 import qualified Data.Set as Set
 import Graphics.Text.Font.Choose.Result (throwNull, throwFalse)
 
@@ -10,10 +10,33 @@ import Control.Exception (bracket)
 import Control.Monad (forM)
 import Foreign.Marshal.Alloc (alloca, allocaBytes)
 import GHC.Base (unsafeChr)
-import Data.Char (ord)
+import Data.Char (ord, isHexDigit)
+import Numeric (readHex)
 
 type CharSet = Set Char
 
+parseChar :: String -> Char
+parseChar str | ((x, _):_) <- readHex str = toEnum x
+replaceWild ch ('?':rest) = ch:replaceWild ch rest
+replaceWild ch (c:cs) = c:replaceWild ch cs
+replaceWild _ "" = ""
+parseWild ch str = parseChar $ replaceWild ch str
+parseCharSet ('U':rest) = parseCharSet ('u':rest) -- lowercase initial "u"
+parseCharSet ('u':'+':cs)
+    | (start@(_:_), '-':ends) <- span isHexDigit cs,
+        (end@(_:_), rest) <- span isHexDigit ends, Just set <- parseCharSet' rest =
+            Just $ Set.union set $ Set.fromList [parseChar start..parseChar end]
+    | (codepoint@(_:_), rest) <- span isHexDigit cs, Just set <- parseCharSet' rest =
+        Just $ flip Set.insert set $ parseChar codepoint
+    | (codepoint@(_:_), rest) <- span (\c -> isHexDigit c || c == '?') cs,
+        Just set <- parseCharSet' rest =
+            Just $ Set.union set $ Set.fromList [
+                parseWild '0' codepoint..parseWild 'f' codepoint]
+parseCharSet _ = Nothing
+parseCharSet' (',':rest) = parseCharSet rest
+parseCharSet' "" = Just Set.empty
+parseCharSet' _ = Nothing
+
 ------
 --- Low-level
 ------
diff --git a/Graphics/Text/Font/Choose/FontSet.hs b/Graphics/Text/Font/Choose/FontSet.hs
index cb1f84f..85ca81c 100644
--- a/Graphics/Text/Font/Choose/FontSet.hs
+++ b/Graphics/Text/Font/Choose/FontSet.hs
@@ -13,9 +13,10 @@ import Control.Exception (bracket)
 
 -- For CSS bindings
 import Stylist.Parse (StyleSheet(..), parseProperties)
-import Data.CSS.Syntax.Tokens (Token(..))
+import Data.CSS.Syntax.Tokens (Token(..), serialize)
 import Data.Text (unpack, Text)
 import Graphics.Text.Font.Choose.Range (iRange)
+import Graphics.Text.Font.Choose.CharSet (parseCharSet)
 import Data.List (intercalate)
 
 type FontSet = [Pattern]
@@ -97,6 +98,10 @@ properties2font (("font-variation-settings", toks):props)
     | (_, True, []) <- parseFontVars toks =
         setValue "variable" Strong True $ properties2font props
 
+properties2font (("unicode-range", toks):props)
+    | Just chars <- parseCharSet $ unpack $ serialize toks =
+        setValue "charset" Strong chars $ properties2font props
+
 properties2font (_:props) = properties2font props
 properties2font [] = []
 
-- 
2.30.2