From 4da6f787545bfef4460ec18e4093233d0015df48 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Thu, 25 Jan 2024 14:12:07 +1300 Subject: [PATCH] Datamodel FontConfig in Haskell. --- app/Main.hs | 2 - fontconfig-pure.cabal | 10 +- lib/Graphics/Text/Font/Choose/CharSet.hs | 57 ++++++++ lib/Graphics/Text/Font/Choose/FontSet.hs | 81 +++++++++++ lib/Graphics/Text/Font/Choose/LangSet.hs | 15 ++ lib/Graphics/Text/Font/Choose/ObjectSet.hs | 5 + lib/Graphics/Text/Font/Choose/Pattern.hs | 155 +++++++++++++++++++++ lib/Graphics/Text/Font/Choose/Range.hs | 21 +++ lib/Graphics/Text/Font/Choose/StrSet.hs | 12 ++ lib/Graphics/Text/Font/Choose/Value.hs | 97 +++++++++++++ 10 files changed, 451 insertions(+), 4 deletions(-) create mode 100644 lib/Graphics/Text/Font/Choose/CharSet.hs create mode 100644 lib/Graphics/Text/Font/Choose/FontSet.hs create mode 100644 lib/Graphics/Text/Font/Choose/LangSet.hs create mode 100644 lib/Graphics/Text/Font/Choose/ObjectSet.hs create mode 100644 lib/Graphics/Text/Font/Choose/Pattern.hs create mode 100644 lib/Graphics/Text/Font/Choose/Range.hs create mode 100644 lib/Graphics/Text/Font/Choose/StrSet.hs create mode 100644 lib/Graphics/Text/Font/Choose/Value.hs diff --git a/app/Main.hs b/app/Main.hs index 60d904e..c24cfd5 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,8 +1,6 @@ module Main where -import qualified MyLib (someFunc) main :: IO () main = do putStrLn "Hello, Haskell!" - MyLib.someFunc diff --git a/fontconfig-pure.cabal b/fontconfig-pure.cabal index 63b4cd5..57d4807 100644 --- a/fontconfig-pure.cabal +++ b/fontconfig-pure.cabal @@ -63,7 +63,10 @@ library import: warnings -- Modules exported by the library. - exposed-modules: MyLib + exposed-modules: Graphics.Text.Font.Choose.CharSet, Graphics.Text.Font.Choose.LangSet, + Graphics.Text.Font.Choose.ObjectSet, Graphics.Text.Font.Choose.Range, + Graphics.Text.Font.Choose.StrSet, Graphics.Text.Font.Choose.Value, + Graphics.Text.Font.Choose.Pattern, Graphics.Text.Font.Choose.FontSet -- Modules included in this library but not exported. -- other-modules: @@ -72,7 +75,10 @@ library -- other-extensions: -- Other library packages from which modules are imported. - build-depends: base >=4.12 && <5, containers >=0.1 && <1, css-syntax, freetype2 >=0.2 && <0.3, hashable >=1.3 && <2, linear >=1.0.1 && <2, scientific, stylist-traits >=0.1.1 && <1, text, inline-c + build-depends: base >=4.12 && <5, containers >=0.1 && <1, css-syntax, + freetype2 >=0.2 && <0.3, hashable >=1.3 && <2, linear >=1.0.1 && <2, + scientific, stylist-traits >=0.1.1 && <1, text, msgpack >= 1.0 && <2, + vector >= 0.13 && <1 -- Directories containing source files. hs-source-dirs: lib diff --git a/lib/Graphics/Text/Font/Choose/CharSet.hs b/lib/Graphics/Text/Font/Choose/CharSet.hs new file mode 100644 index 0000000..c6f94dd --- /dev/null +++ b/lib/Graphics/Text/Font/Choose/CharSet.hs @@ -0,0 +1,57 @@ +module Graphics.Text.Font.Choose.CharSet where + +import Data.IntSet (IntSet, union) +import qualified Data.IntSet as IntSet + +import Data.Char (isHexDigit) +import Numeric (readHex) + +import Data.MessagePack (MessagePack(..)) + +-- | An FcCharSet is a set of Unicode characters. +type CharSet = IntSet + +parseChar :: String -> Int +parseChar str | ((x, _):_) <- readHex str = toEnum x + | otherwise = 0 +replaceWild :: Char -> String -> String +replaceWild ch ('?':rest) = ch:replaceWild ch rest +replaceWild ch (c:cs) = c:replaceWild ch cs +replaceWild _ "" = "" +parseWild :: Char -> String -> Int +parseWild ch str = parseChar $ replaceWild ch str +-- | Utility for parsing "unicode-range" @font-face property. +parseCharSet :: String -> Maybe CharSet +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 $ union set $ IntSet.fromList [parseChar start..parseChar end] + | (codepoint@(_:_), rest) <- span isHexDigit cs, Just set <- parseCharSet' rest = + Just $ flip IntSet.insert set $ parseChar codepoint + | (codepoint@(_:_), rest) <- span (\c -> isHexDigit c || c == '?') cs, + Just set <- parseCharSet' rest = + Just $ IntSet.union set $ IntSet.fromList [ + parseWild '0' codepoint..parseWild 'f' codepoint] +parseCharSet _ = Nothing +parseCharSet' :: String -> Maybe CharSet +parseCharSet' (',':rest) = parseCharSet rest +parseCharSet' "" = Just IntSet.empty +parseCharSet' _ = Nothing + +-- NOTE: Serial already provides IntSet a CBOR codec, but its quite naive. +-- I suspect that CharSets are typically quite dense, +-- So a diff-compression pass should play well with + +diffCompress :: Int -> [Int] -> [Int] +diffCompress prev (x:xs) = x - prev:diffCompress x xs +diffCompress _ [] = [] +diffDecompress :: Int -> [Int] -> [Int] +diffDecompress prev (x:xs) = prev + x:diffDecompress x xs +diffDecompress _ [] = [] + +newtype CharSet' = CharSet' { unCharSet :: CharSet } +instance MessagePack CharSet' where + toObject = toObject . diffCompress 0 . IntSet.toAscList . unCharSet + fromObject msg = + CharSet' <$> IntSet.fromAscList <$> diffDecompress 0 <$> fromObject msg diff --git a/lib/Graphics/Text/Font/Choose/FontSet.hs b/lib/Graphics/Text/Font/Choose/FontSet.hs new file mode 100644 index 0000000..151fbc7 --- /dev/null +++ b/lib/Graphics/Text/Font/Choose/FontSet.hs @@ -0,0 +1,81 @@ +module Graphics.Text.Font.Choose.FontSet where + +import Graphics.Text.Font.Choose.Pattern + +type FontSet = [Pattern'] + +------ +--- CSS Bindings +------ + +-- | `StyleSheet` wrapper to parse @font-face rules. +data FontFaceParser a = FontFaceParser { cssFonts :: FontSet, cssInner :: a} + +{- parseFontFaceSrc (Function "local":Ident name:RightParen:Comma:rest) = + ("local:" ++ unpack name):parseFontFaceSrc rest +parseFontFaceSrc (Function "local":String name:RightParen:Comma:rest) = + ("local:" ++ unpack name):parseFontFaceSrc rest +parseFontFaceSrc (Function "local":Ident name:RightParen:[]) = ["local:" ++ unpack name] +parseFontFaceSrc (Function "local":String name:RightParen:[]) = ["local:" ++ unpack name] + +parseFontFaceSrc (Url link:toks) + | Comma:rest <- skipMeta toks = unpack link:parseFontFaceSrc rest + | [] <- skipMeta toks = [unpack link] + | otherwise = [""] -- Error indicator! + where + skipMeta (Function "format":Ident _:RightParen:rest) = skipMeta rest + skipMeta (Function "format":String _:RightParen:rest) = skipMeta rest + skipMeta (Function "tech":Ident _:RightParen:rest) = skipMeta rest + skipMeta (Function "tech":String _:RightParen:rest) = skipMeta rest + skipMeta toks = toks + +parseFontFaceSrc _ = [""] + +properties2font :: [(Text, [Token])] -> Pattern +properties2font (("font-family", [String font]):props) = + setValue "family" Strong (unpack font) $ properties2font props +properties2font (("font-family", [Ident font]):props) = + setValue "family" Strong (unpack font) $ properties2font props + +properties2font (("font-stretch", [tok]):props) | Just x <- parseFontStretch tok = + setValue "width" Strong x $ properties2font props +properties2font (("font-stretch", [start, end]):props) + | Just x <- parseFontStretch start, Just y <- parseFontStretch end = + setValue "width" Strong (x `iRange` y) $ properties2font props + +properties2font (("font-weight", [tok]):props) | Just x <- parseFontWeight tok = + setValue "width" Strong x $ properties2font props +properties2font (("font-weight", [start, end]):props) + | Just x <- parseFontStretch start, Just y <- parseFontStretch end = + setValue "weight" Strong (x `iRange` y) $ properties2font props + +properties2font (("font-feature-settings", toks):props) + | (features, True, []) <- parseFontFeatures toks = + setValue "fontfeatures" Strong (intercalate "," $ map fst features) $ + properties2font props + +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 + +-- Ignoring metadata & trusting in FreeType's broad support for fonts. +properties2font (("src", toks):props) + | fonts@(_:_) <- parseFontFaceSrc toks, "" `notElem` fonts = + setValue "web-src" Strong (intercalate "\t" fonts) $ properties2font props + +properties2font (_:props) = properties2font props +properties2font [] = [] + +instance StyleSheet a => StyleSheet (FontFaceParser a) where + setPriorities v (FontFaceParser x self) = FontFaceParser x $ setPriorities v self + addRule (FontFaceParser x self) rule = FontFaceParser x $ addRule self rule + + addAtRule (FontFaceParser fonts self) "font-face" toks = + let ((props, _), toks') = parseProperties toks + in (FontFaceParser (properties2font props:fonts) self, toks') + addAtRule (FontFaceParser x self) key toks = + let (a, b) = addAtRule self key toks in (FontFaceParser x a, b) -} diff --git a/lib/Graphics/Text/Font/Choose/LangSet.hs b/lib/Graphics/Text/Font/Choose/LangSet.hs new file mode 100644 index 0000000..905fce9 --- /dev/null +++ b/lib/Graphics/Text/Font/Choose/LangSet.hs @@ -0,0 +1,15 @@ +module Graphics.Text.Font.Choose.LangSet where + +import Data.Set (Set) +import qualified Data.Set as S + +import Data.MessagePack (MessagePack(..)) + +type LangSet = Set String +newtype LangSet' = LangSet' { unLangSet :: LangSet } + +instance MessagePack LangSet' where + toObject = toObject . S.toList . unLangSet + fromObject msg = LangSet' <$> S.fromList <$> fromObject msg + +-- TODO: Implement language bindings! But first: Datamodel everything! diff --git a/lib/Graphics/Text/Font/Choose/ObjectSet.hs b/lib/Graphics/Text/Font/Choose/ObjectSet.hs new file mode 100644 index 0000000..f379c08 --- /dev/null +++ b/lib/Graphics/Text/Font/Choose/ObjectSet.hs @@ -0,0 +1,5 @@ +module Graphics.Text.Font.Choose.ObjectSet where + +type ObjectSet = [String] + +-- NOTE: Already has all the typeclass instances I want, including MessagePack! diff --git a/lib/Graphics/Text/Font/Choose/Pattern.hs b/lib/Graphics/Text/Font/Choose/Pattern.hs new file mode 100644 index 0000000..261deda --- /dev/null +++ b/lib/Graphics/Text/Font/Choose/Pattern.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE DeriveGeneric #-} +module Graphics.Text.Font.Choose.Pattern where + +import Data.Map as M +import Data.MessagePack (MessagePack(..), Object(..)) +import Data.Hashable (Hashable(..)) +import GHC.Generics (Generic) + +import Graphics.Text.Font.Choose.Value + +type Pattern = Map String [(Binding, Value)] +data Pattern' = Pattern' { unPattern :: Pattern } +data Binding = Strong | Weak | Same deriving (Eq, Ord, Enum, Read, Show, Generic) + +instance Hashable Binding where + hash = fromEnum +instance MessagePack Binding where + fromObject (ObjectBool True) = Just Strong + fromObject (ObjectBool False) = Just Weak + fromObject ObjectNil = Just Same + fromObject _ = Nothing + toObject Strong = ObjectBool True + toObject Weak = ObjectBool False + toObject Same = ObjectNil + +------ +--- CSS +------ + +{-parseFontFamily :: [Token] -> ([String], Bool, [Token]) +parseFontFamily (String font:Comma:tail) = let (fonts, b, tail') = parseFontFamily tail + in (unpack font:fonts, b, tail') +parseFontFamily (Ident font:Comma:tail) = let (fonts, b, tail') = parseFontFamily tail + in (unpack font:fonts, b, tail') +parseFontFamily (String font:tail) = ([unpack font], True, tail) +parseFontFamily (Ident font:tail) = ([unpack font], True, tail) +parseFontFamily toks = ([], False, toks) -- Invalid syntax! + +parseFontFeatures :: [Token] -> ([(String, Int)], Bool, [Token]) +parseFontFeatures (String feat:toks) | feature@(_:_:_:_:[]) <- unpack feat = case toks of + Comma:tail -> let (feats, b, tail') = parseFontFeatures tail in ((feature, 1):feats, b, tail') + Ident "on":Comma:tail -> let (f, b, t) = parseFontFeatures tail in ((feature, 1):f, b, t) + Ident "on":tail -> ([(feature, 1)], True, tail) + Ident "off":Comma:tail -> let (f, b, t) = parseFontFeatures tail in ((feature, 1):f, b, t) + Ident "off":tail -> ([(feature, 1)], True, tail) + Number _ (NVInteger x):Comma:tail -> + let (feats, b, tail') = parseFontFeatures tail in ((feature, fromEnum x):feats, b, tail') + Number _ (NVInteger x):tail -> ([(feature, fromEnum x)], True, tail) +parseFontFeatures toks = ([], False, toks) + +parseFontVars :: [Token] -> ([(String, Double)], Bool, [Token]) +parseFontVars (String var':Number _ x:Comma:tail) | var@(_:_:_:_:[]) <- unpack var' = + let (vars, b, tail') = parseFontVars tail in ((var, nv2double x):vars, b, tail') +parseFontVars (String var':Number _ x:tail) | var@(_:_:_:_:[]) <- unpack var' = + ([(var, nv2double x)], True, tail) +parseFontVars toks = ([], False, toks) + +parseLength :: Double -> NumericValue -> Text -> Double +parseLength super length unit = convert (nv2double length) 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 "em" = x * super + c x "%" = x/100 `c` "em" + c _ _ = 0/0 -- NaN + +parseFontStretch :: Token -> Maybe Int -- Result in percentages +parseFontStretch (Percentage _ x) = Just $ fromEnum $ nv2double x +parseFontStretch (Ident "ultra-condensed") = Just 50 +parseFontStretch (Ident "extra-condensed") = Just 63 -- 62.5%, but round towards 100% +parseFontStretch (Ident "condensed") = Just 75 +parseFontStretch (Ident "semi-condensed") = Just 88 -- 87.5% actually... +parseFontStretch (Ident "normal") = Just 100 +parseFontStretch (Ident "initial") = Just 100 +parseFontStretch (Ident "semi-expanded") = Just 112 -- 112.5% actually... +parseFontStretch (Ident "expanded") = Just 125 +parseFontStretch (Ident "extra-expanded") = Just 150 +parseFontStretch (Ident "ultra-expanded") = Just 200 +parseFontStretch _ = Nothing + +-- Conversion between CSS scale & FontConfig scale is non-trivial, use lookuptable. +parseFontWeight :: Token -> Maybe Int +parseFontWeight (Ident k) | k `elem` ["initial", "normal"] = Just 80 +parseFontWeight (Ident "bold") = Just 200 +parseFontWeight (Number _ (NVInteger x)) = Just $ weightFromOpenType $ fromEnum x +parseFontWeight _ = Nothing + +nv2double (NVInteger x) = fromInteger x +nv2double (NVNumber x) = toRealFloat x + +sets a b c d = Just $ setValues a b c d +set a b c d = Just $ setValue a b c d +seti a b c d = Just $ setValue a b (c :: Int) d +unset' a b = Just $ unset a b + +getSize pat | ValueDouble x <- getValue "size" pat = x + | otherwise = 10 + +instance PropertyParser Pattern where + temp = [] + + longhand _ self "font-family" toks + | (fonts, True, []) <- parseFontFamily toks = sets "family" Strong fonts self + + -- font-size: initial should be configurable! + longhand super self "font-size" [Dimension _ x unit] + | let y = parseLength (getSize super) x unit, not $ isNaN y = + set "size" Strong y self + longhand super self "font-size" [Percentage x y] = + longhand super self "font-size" [Dimension x y "%"] + + longhand _ self "font-style" [Ident "initial"] = seti "slant" Strong 0 self + longhand _ self "font-style" [Ident "normal"] = seti "slant" Strong 0 self + longhand _ self "font-style" [Ident "italic"] = seti "slant" Strong 100 self + longhand _ self "font-style" [Ident "oblique"] = seti "slant" Strong 110 self + + -- Conversion between CSS scale & FontConfig scale is non-trivial, use lookuptable. + longhand _ self "font-weight" [tok] + | Just x <- parseFontWeight tok = seti "weight" Strong x self + longhand super self "font-weight" [Number _ (NVInteger x)] + | x > 920 = longhand super self "font-weight" [Number "" $ NVInteger 950] + | otherwise = longhand super self "font-weight" [Number "" $ NVInteger $ (x `div` 100) * 100] + longhand _ self "font-weight" [Ident "lighter"] + | ValueInt x <- getValue "weight" self, x > 200 = seti "weight" Strong 200 self + -- minus 100 adhears to the CSS standard awefully well in this new scale. + | ValueInt x <- getValue "weight" self = seti "weight" Strong (max (x - 100) 0) self + | otherwise = seti "weight" Strong 0 self + longhand _ self "font-weight" [Ident "bolder"] + | ValueInt x <- getValue "weight" self, x <= 65 = seti "weight" Strong 80 self + | ValueInt x <- getValue "weight" self, x <= 150 = seti "weight" Strong 200 self + | ValueInt x <- getValue "weight" self, x < 210 = seti "weight" Strong 210 self + | ValueInt _ <- getValue "weight" self = Just self -- As bold as it goes... + | otherwise = seti "weight" Strong 200 self + + longhand _ self "font-feature-settings" [Ident k] + | k `elem` ["initial", "normal"] = unset' "fontfeatures" self + longhand _ self "font-feature-settings" toks + | (features, True, []) <- parseFontFeatures toks = + set "fontfeatures" Strong (intercalate "," $ map fst features) self + + longhand _ self "font-variation-settings" [Ident k] + | k `elem` ["initial", "normal"] = unset' "variable" self + longhand _ self "font-variation-settings" toks + | (_, True, []) <- parseFontVars toks = set "variable" Strong True self + + longhand _ s "font-stretch" [tok] + | Just x <- parseFontStretch tok = seti "width" Strong x s + + longhand _ _ _ _ = Nothing -} diff --git a/lib/Graphics/Text/Font/Choose/Range.hs b/lib/Graphics/Text/Font/Choose/Range.hs new file mode 100644 index 0000000..2ab7e7b --- /dev/null +++ b/lib/Graphics/Text/Font/Choose/Range.hs @@ -0,0 +1,21 @@ +module Graphics.Text.Font.Choose.Range where + +import Data.MessagePack (MessagePack(..), Object(..)) +import qualified Data.Vector as V +import qualified Data.IntMap as IM + +-- | Matches a numeric range. +data Range = Range Double Double deriving (Eq, Show, Ord) +-- | Matches an integral range. +iRange :: Int -> Int -> Range +iRange i j = toEnum i `Range` toEnum j + +instance MessagePack Range where + toObject (Range start end) = ObjectMap $ V.fromList [ + (ObjectInt 0, ObjectDouble start), + (ObjectInt 1, ObjectDouble end) + ] + fromObject msg + | Just msg' <- fromObject msg = + Just (IM.findWithDefault 0 0 msg' `Range` IM.findWithDefault 0 1 msg') + | otherwise = Nothing diff --git a/lib/Graphics/Text/Font/Choose/StrSet.hs b/lib/Graphics/Text/Font/Choose/StrSet.hs new file mode 100644 index 0000000..0a9efd7 --- /dev/null +++ b/lib/Graphics/Text/Font/Choose/StrSet.hs @@ -0,0 +1,12 @@ +module Graphics.Text.Font.Choose.StrSet where + +import Data.Set (Set) +import qualified Data.Set as S + +import Data.MessagePack (MessagePack(..)) + +newtype StrSet = StrSet { unStrSet :: Set String } + +instance MessagePack StrSet where + toObject = toObject . S.toList . unStrSet + fromObject msg = StrSet <$> S.fromList <$> fromObject msg diff --git a/lib/Graphics/Text/Font/Choose/Value.hs b/lib/Graphics/Text/Font/Choose/Value.hs new file mode 100644 index 0000000..2a4e391 --- /dev/null +++ b/lib/Graphics/Text/Font/Choose/Value.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +module Graphics.Text.Font.Choose.Value where + +import Linear.Matrix (M22) +import Linear.V2 (V2(..)) +import Graphics.Text.Font.Choose.CharSet (CharSet, CharSet'(..)) +--import FreeType.Core.Base (FT_Face(..)) +import Graphics.Text.Font.Choose.LangSet (LangSet, LangSet'(..)) +import Graphics.Text.Font.Choose.Range (Range) + +import Data.MessagePack (MessagePack(..), Object(..)) +import qualified Data.Text as Txt + +-- | A dynamic type system for `Pattern`s. +data Value = ValueVoid + | ValueInt Int + | ValueDouble Double + | ValueString String + | ValueBool Bool + | ValueMatrix (M22 Double) + | ValueCharSet CharSet +-- | ValueFTFace FT_Face -- FIXME: Is it worth going through the trouble to bridge this? + | ValueLangSet LangSet + | ValueRange Range deriving (Eq, Show, Ord) + +instance MessagePack Value where + toObject ValueVoid = ObjectNil + toObject (ValueInt x) = ObjectInt x + toObject (ValueDouble x) = ObjectDouble x + toObject (ValueString x) = ObjectStr $ Txt.pack x + toObject (ValueBool x) = ObjectBool x + toObject (ValueMatrix (V2 (V2 xx yx) (V2 xy yy))) = toObject [xx, xy, yx, yy] + toObject (ValueCharSet x) = toObject $ CharSet' x + toObject (ValueLangSet x) = toObject $ LangSet' x + toObject (ValueRange x) = toObject x + + fromObject ObjectNil = Just ValueVoid + fromObject (ObjectBool x) = Just $ ValueBool x + fromObject (ObjectInt x) = Just $ ValueInt x + fromObject (ObjectFloat x) = Just $ ValueDouble $ realToFrac x + fromObject (ObjectDouble x) = Just $ ValueDouble x + fromObject (ObjectStr x) = Just $ ValueString $ Txt.unpack x + fromObject (ObjectBin _) = Nothing -- Would use for to transfer font faces via underlying bytes. + fromObject msg + | Just charset <- fromObject msg = Just $ ValueCharSet $ unCharSet charset + | Just langset <- fromObject msg = Just $ ValueLangSet $ unLangSet langset + | Just range <- fromObject msg = Just $ ValueRange range + | Just [xx, xy, yx, yy] <- fromObject msg :: Maybe [Double] = + -- [Double] decoding is overly generous, potentially conflicts with above. + Just $ ValueMatrix $ V2 (V2 xx yx) (V2 xy yy) + | otherwise = Nothing + +-- | Coerces compiletime types to runtime types. +class ToValue x where + toValue :: x -> Value + fromValue :: Value -> Maybe x + fromValue' :: Value -> x -- throws Result.Error + fromValue' self | Just ret <- fromValue self = ret + fromValue' _ = error "Type mismatch!" -- TODO: Throw something nicer! + +instance ToValue () where + toValue () = ValueVoid + fromValue ValueVoid = Just () + fromValue _ = Nothing +instance ToValue Int where + toValue = ValueInt + fromValue (ValueInt x) = Just x + fromValue _ = Nothing +instance ToValue Double where + toValue = ValueDouble + fromValue (ValueDouble x) = Just x + fromValue _ = Nothing +instance ToValue String where + toValue = ValueString + fromValue (ValueString x) = Just x + fromValue _ = Nothing +instance ToValue Bool where + toValue = ValueBool + fromValue (ValueBool x) = Just x + fromValue _ = Nothing +instance ToValue (M22 Double) where + toValue = ValueMatrix + fromValue (ValueMatrix x) = Just x + fromValue _ = Nothing +instance ToValue CharSet' where + toValue = ValueCharSet . unCharSet + fromValue (ValueCharSet x) = Just $ CharSet' x + fromValue _ = Nothing +--instance ToValue FT_Face where +-- toValue = ValueFTFace +-- fromValue (ValueFTFace x) = Just x +-- fromValue _ = Nothing +instance ToValue LangSet' where + toValue = ValueLangSet . unLangSet + fromValue (ValueLangSet x) = Just $ LangSet' x + fromValue _ = Nothing + -- 2.30.2