4 files changed, 25 insertions(+), 18 deletions(-)

M cbits/transcode.c
M lib/Graphics/Text/Font/Choose/CharSet.hs
M lib/Graphics/Text/Font/Choose/LangSet.hs
M lib/Graphics/Text/Font/Choose/Value.hs

@@ 75,7 75,12 @@ bool encodeStrSet(cmp_ctx_t *bytes, FcStrSet *data) {
 FcCharSet *decodeCharSet(cmp_ctx_t *bytes) {
     if (bytes == NULL) return NULL;
 
-    uint32_t size;
+    int8_t type = 'c'; uint32_t size = 0;
+    // Special unambiguous empty encoding!
+    if (cmp_read_ext_marker(bytes, &type, &size) && type == 'c' && size == 0) {
+        return FcCharSetCreate();
+    }
+
     if (!cmp_read_array(bytes, &size)) return NULL;
 
     FcCharSet *ret = FcCharSetCreate();


@@ 98,6 103,9 @@ bool encodeCharSet(cmp_ctx_t *bytes, const FcCharSet *data) {
     if (bytes == NULL || data == NULL) return false;
 
     FcChar32 size = FcCharSetCount(data);
+    if (size == 0) { // Unambiguous empty encoding!
+        return cmp_write_ext_marker(bytes, 'c', 0);
+    }
     FcChar32 count = 0; // For validation
     if (!cmp_write_array(bytes, size)) return false;
 


@@ 241,9 249,11 @@ bool decodeValue(cmp_ctx_t *bytes, FcValue *out) {
         out->type = FcTypeBool;
         out->u.b = b ? FcTrue : FcFalse; // Didn't auto-convert.
     } else if ((out->u.m = decodeMatrix(bytes)) != NULL) out->type = FcTypeMatrix;
+    // For ease of encoding lists are treated as lang sets.
+    // Hence LangSets take priority during decode!
+    else if ((out->u.l = decodeLangSet(bytes)) != NULL) out->type = FcTypeLangSet;
     else if ((out->u.c = decodeCharSet(bytes)) != NULL) out->type = FcTypeCharSet;
     // Not supporting FcTypeFcFace
-    else if ((out->u.l = decodeLangSet(bytes)) != NULL) out->type = FcTypeLangSet;
     else if ((out->u.r = decodeRange(bytes)) != NULL) out->type = FcTypeRange;
     else return false;
     return true;

@@ 7,7 7,7 @@ import qualified Data.IntSet as IntSet
 import Data.Char (isHexDigit, ord, chr)
 import Numeric (readHex)
 
-import Data.MessagePack (MessagePack(..))
+import Data.MessagePack (MessagePack(..), Object(..))
 import Test.QuickCheck (Arbitrary(..))
 
 -- | An FcCharSet is a set of Unicode characters.


@@ 54,11 54,9 @@ diffDecompress _ [] = []
 
 newtype CharSet' = CharSet' { unCharSet :: CharSet } deriving (Eq, Read, Show)
 instance MessagePack CharSet' where
-    toObject x = toObject $ diffCompress 0 $ IntSet.toAscList $ unCharSet x
+    toObject = toObject . diffCompress 0 . IntSet.toAscList . unCharSet
+    fromObject (ObjectExt 0x63 _) = Just $ CharSet' IntSet.empty
     fromObject msg =
         CharSet' <$> IntSet.fromAscList <$> diffDecompress 0 <$> fromObject msg
 instance Arbitrary CharSet' where
-    arbitrary = do
-        x <- arbitrary -- Ensure its non-empty, known failure!
-        xs <- arbitrary
-        return $ CharSet' $ IntSet.insert x xs
+    arbitrary = CharSet' <$> arbitrary

@@ 24,10 24,7 @@ instance MessagePack LangSet' where
     toObject = toObject . S.toList . unLangSet
     fromObject msg = LangSet' <$> S.fromList <$> fromObject msg
 instance Arbitrary LangSet' where
-    arbitrary = do
-        x <- arbitrary -- Ensure non-empty, known failure
-        xs <- arbitrary
-        return $ LangSet' $ S.insert x xs
+    arbitrary = LangSet' <$> arbitrary
 
 data LangComparison = SameLang | SameTerritory | DifferentLang
 i2cmp :: Int -> LangComparison

@@ 1,10 1,11 @@
 {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Graphics.Text.Font.Choose.Value(Value(..), ToValue(..)) where
 
 import Linear.Matrix (M22)
 import Linear.V2 (V2(..))
-import qualified Data.Vector as V
 import Graphics.Text.Font.Choose.CharSet (CharSet, CharSet'(..))
+import qualified Data.IntSet as S
 --import FreeType.Core.Base (FT_Face(..))
 import Graphics.Text.Font.Choose.LangSet (LangSet, LangSet'(..))
 import Graphics.Text.Font.Choose.Range (Range)


@@ 35,7 36,8 @@ instance MessagePack Value where
     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 (ValueCharSet x) | S.null x = ObjectExt 0x63 "" -- Resolve ambiguity!
+        | otherwise = toObject $ CharSet' x
     toObject (ValueLangSet x) = toObject $ LangSet' x
     toObject (ValueRange x) = toObject x
 


@@ 46,10 48,10 @@ instance MessagePack Value where
     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 (ObjectArray x) | V.null x = Nothing -- Ambiguous!
     fromObject msg
-        | Just charset <- fromObject msg = Just $ ValueCharSet $ unCharSet charset
+        -- LangSet takes precedance for encoding empty arrays!
         | Just langset <- fromObject msg = Just $ ValueLangSet $ unLangSet langset
+        | Just charset <- fromObject msg = Just $ ValueCharSet $ unCharSet charset
         | 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.


@@ 65,8 67,8 @@ instance Arbitrary Value where
         do
             (a, b, c, d) <- arbitrary
             return $ ValueMatrix $ V2 (V2 a b) (V2 c d),
-        ValueCharSet <$> unCharSet <$> arbitrary,
-        ValueLangSet <$> unLangSet <$> arbitrary,
+        ValueCharSet <$> arbitrary,
+        ValueLangSet <$> arbitrary,
         ValueRange <$> arbitrary
       ]