4 files changed, 37 insertions(+), 19 deletions(-)

M lib/Graphics/Text/Font/Choose/CharSet.hs
M lib/Graphics/Text/Font/Choose/FontSet.hs
M lib/Graphics/Text/Font/Choose/LangSet.hs
M lib/Graphics/Text/Font/Choose/Pattern.hs

@@ 3,7 3,7 @@ module Graphics.Text.Font.Choose.CharSet(
     ) where
 
 import Data.IntSet (IntSet, union)
-import qualified Data.IntSet as IntSet
+import Data.IntSet as IntSet
 
 import Data.Char (isHexDigit, ord, chr)
 import Numeric (readHex)


@@ 60,7 60,7 @@ instance MessagePack CharSet' where
     fromObject msg =
         CharSet' <$> IntSet.fromAscList <$> diffDecompress 0 <$> fromObject msg
 instance Arbitrary CharSet' where
-    arbitrary = CharSet' <$> IntSet.fromList <$> map (succ . abs) <$> arbitrary
+    arbitrary = CharSet' <$> IntSet.fromList <$> Prelude.map (succ . abs) <$> arbitrary
 
 validCharSet' :: CharSet' -> Bool
 validCharSet' (CharSet' self) =

@@ 6,7 6,7 @@ module Graphics.Text.Font.Choose.FontSet(
 import Graphics.Text.Font.Choose.Pattern hiding (map)
 import Graphics.Text.Font.Choose.Config
 import Graphics.Text.Font.Choose.ObjectSet
-import Graphics.Text.Font.Choose.CharSet
+import Graphics.Text.Font.Choose.CharSet as CS hiding (map)
 import Graphics.Text.Font.Choose.Internal.FFI
 
 import Foreign.C.String (CString)


@@ 29,22 29,27 @@ validFontSet :: FontSet -> Bool
 validFontSet = all validPattern
 
 fontSetList :: Config -> [FontSet] -> Pattern -> ObjectSet -> FontSet
-fontSetList a b c d =
+fontSetList a b c d | all validFontSet b =
     fromMessage0 $ arg d $ arg c $ arg b $ withForeignPtr' fcFontSetList a
+  | otherwise = []
 
 foreign import capi "fontconfig-wrap.h" fcFontSetList ::
         Ptr Config' -> CString -> Int -> CString -> Int -> CString -> Int ->
         Ptr Int -> CString
 
 fontSetMatch :: Config -> [FontSet] -> Pattern -> Maybe FontSet
-fontSetMatch a b c = fromMessage $ arg c $ arg b $ withForeignPtr' fcFontSetMatch a
+fontSetMatch a b c | all validFontSet b && validPattern c =
+        fromMessage $ arg c $ arg b $ withForeignPtr' fcFontSetMatch a
+    | otherwise = Nothing
 
 foreign import capi "fontconfig-wrap.h" fcFontSetMatch ::
         Ptr Config' -> CString -> Int -> CString -> Int -> Ptr Int -> CString
 
 fontSetSort :: Config -> [FontSet] -> Pattern -> Bool -> (Maybe FontSet, CharSet')
-fontSetSort a b c d = fromMessage0 $ flip withForeignPtr' a $ \a' ->
-        arg b $ \b' x -> arg c $ \c' y -> fcFontSetSort a' b' x c' y d
+fontSetSort a b c d | all validFontSet b && validPattern c =
+        fromMessage0 $ flip withForeignPtr' a $ \a' ->
+            arg b $ \b' x -> arg c $ \c' y -> fcFontSetSort a' b' x c' y d
+    | otherwise = (Nothing, CharSet' CS.empty)
 
 foreign import capi "fontconfig-wrap.h" fcFontSetSort ::
         Ptr Config' -> CString -> Int -> CString -> Int -> Bool -> Ptr Int -> CString

@@ 9,7 9,7 @@ import qualified Data.Set as S
 import Data.MessagePack (MessagePack(..))
 import Test.QuickCheck (Arbitrary(..), elements, listOf)
 import Graphics.Text.Font.Choose.StrSet (StrSet(..))
-import Graphics.Text.Font.Choose.CharSet (CharSet')
+import Graphics.Text.Font.Choose.CharSet as CS (CharSet'(..), empty)
 
 import Foreign.C.String (CString)
 import Foreign.Ptr (Ptr)


@@ 21,9 21,11 @@ type LangSet = Set String
 newtype LangSet' = LangSet' { unLangSet :: LangSet } deriving (Eq, Show, Read)
 
 validLangSet :: LangSet -> Bool
-validLangSet x = all (`elem` unStrSet langs) x && not (null x)
+validLangSet x = all validLang x && not (null x)
 validLangSet' :: LangSet' -> Bool
 validLangSet' = validLangSet . unLangSet
+validLang :: String -> Bool
+validLang = (`elem` unStrSet langs)
 
 instance MessagePack LangSet' where
     toObject = toObject . S.toList . unLangSet


@@ 39,12 41,16 @@ i2cmp 2 = SameTerritory
 i2cmp _ = throw ErrOOM
 
 cmp :: LangSet' -> LangSet' -> LangComparison
-cmp a b = i2cmp $ withMessage fcLangSetCompare [a, b]
+cmp a b | valid a && valid b = i2cmp $ withMessage fcLangSetCompare [a, b]
+    | otherwise = DifferentLang
+  where valid = validLangSet'
 
 foreign import capi "fontconfig-wrap.h" fcLangSetCompare :: CString -> Int -> Int
 
 has :: LangSet' -> String -> LangComparison
-has a b = i2cmp $ flip withCString' b $ withMessage fcLangSetHasLang a
+has a b | validLangSet' a && validLang b =
+        i2cmp $ flip withCString' b $ withMessage fcLangSetHasLang a
+    | otherwise = DifferentLang
 
 foreign import capi "fontconfig-wrap.h" fcLangSetHasLang :: CString -> Int -> CString -> Int
 


@@ 64,6 70,7 @@ normalize = peekCString' . withCString' fcLangNormalize
 foreign import capi "fontconfig-wrap.h" fcLangNormalize :: CString -> CString
 
 langCharSet :: String -> CharSet'
-langCharSet = fromMessage0 . withCString' fcLangGetCharSet
+langCharSet a | validLang a = fromMessage0 $ withCString' fcLangGetCharSet a
+    | otherwise = CharSet' CS.empty
 
 foreign import capi "fontconfig-wrap.h" fcLangGetCharSet :: CString -> Ptr Int -> CString

@@ 85,15 85,18 @@ getValues :: ToValue v => Text -> Pattern -> [v]
 getValues key self = Mb.mapMaybe (fromValue . snd) $ fromMaybe [] $ M.lookup key self
 
 equalSubset :: Pattern -> Pattern -> ObjectSet -> Bool
-equalSubset a b os = case withMessage fcPatternEqualSubset [toObject a, toObject b, toObject os] of
-    0 -> False
-    1 -> True
-    _ -> throw ErrOOM
+equalSubset a b os | validPattern a && validPattern b =
+    case withMessage fcPatternEqualSubset [toObject a, toObject b, toObject os] of
+        0 -> False
+        1 -> True
+        _ -> throw ErrOOM
+  | otherwise = False
 
 foreign import capi "fontconfig-wrap.h" fcPatternEqualSubset :: CString -> Int -> Int
 
 defaultSubstitute :: Pattern -> Pattern
-defaultSubstitute = fromMessage0 . withMessage fcDefaultSubstitute
+defaultSubstitute a | validPattern a = fromMessage0 $ withMessage fcDefaultSubstitute a
+    | otherwise = a
 
 foreign import capi "fontconfig-wrap.h" fcDefaultSubstitute :: CString -> Int -> Ptr Int -> CString
 


@@ 103,12 106,15 @@ nameParse = fromMessage0 . withCString' fcNameParse
 foreign import capi "fontconfig-wrap.h" fcNameParse :: CString -> Ptr Int -> CString
 
 nameUnparse :: Pattern -> String
-nameUnparse = peekCString' . withMessage fcNameUnparse
+nameUnparse a | validPattern a = peekCString' $ withMessage fcNameUnparse a
+    | otherwise = ""
 
 foreign import capi "fontconfig-wrap.h" fcNameUnparse :: CString -> Int -> CString
 
 nameFormat :: Pattern -> String -> String
-nameFormat a b = peekCString' $ flip withCString' b $ withMessage fcNameFormat a
+nameFormat a b
+    | validPattern a = peekCString' $ flip withCString' b $ withMessage fcNameFormat a
+    | otherwise = ""
 
 foreign import capi "fontconfig-wrap.h" fcNameFormat :: CString -> Int -> CString -> CString