From 64bcb432397d1fdfdf9f136ec3c5cdc4990bf920 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Tue, 15 Nov 2022 10:10:58 +1300
Subject: [PATCH] Refine first-draft language bindings!

---
 Graphics/Text/Font/Choose/Constant.hs   |  3 ---
 Graphics/Text/Font/Choose/Init.hs       |  6 ++++--
 Graphics/Text/Font/Choose/LangResult.hs |  0
 Graphics/Text/Font/Choose/LangSet.hs    |  7 +++++++
 Graphics/Text/Font/Choose/ObjectType.hs |  5 -----
 Graphics/Text/Font/Choose/Result.hs     | 27 +++++++++++++++++++++++++
 6 files changed, 38 insertions(+), 10 deletions(-)
 delete mode 100644 Graphics/Text/Font/Choose/Constant.hs
 delete mode 100644 Graphics/Text/Font/Choose/LangResult.hs
 delete mode 100644 Graphics/Text/Font/Choose/ObjectType.hs

diff --git a/Graphics/Text/Font/Choose/Constant.hs b/Graphics/Text/Font/Choose/Constant.hs
deleted file mode 100644
index b076045..0000000
--- a/Graphics/Text/Font/Choose/Constant.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-module Graphics.Text.Font.Choose.Constant where
-
-data Constant = Constant { name :: String, object :: String, value :: Int }
diff --git a/Graphics/Text/Font/Choose/Init.hs b/Graphics/Text/Font/Choose/Init.hs
index 860283b..fac0d8e 100644
--- a/Graphics/Text/Font/Choose/Init.hs
+++ b/Graphics/Text/Font/Choose/Init.hs
@@ -3,8 +3,10 @@ module Graphics.Text.Font.Choose.Init ({-Config, initLoadConfig, initLoadConfigA
 
 import Prelude hiding (init)
 
-{-foreign import ccall "FcInitLoadConfig" initLoadConfig :: IO Config
-foreign import ccall "FcInitLoadConfigAndFonts" initLoadConfigAndFonts :: IO Config-}
+import Graphics.Text.Font.Choose.Config
+
+foreign import ccall "FcInitLoadConfig" initLoadConfig :: IO Config
+foreign import ccall "FcInitLoadConfigAndFonts" initLoadConfigAndFonts :: IO Config
 
 foreign import ccall "FcInit" init :: IO Bool
 foreign import ccall "FcFini" fini :: IO ()
diff --git a/Graphics/Text/Font/Choose/LangResult.hs b/Graphics/Text/Font/Choose/LangResult.hs
deleted file mode 100644
index e69de29..0000000
diff --git a/Graphics/Text/Font/Choose/LangSet.hs b/Graphics/Text/Font/Choose/LangSet.hs
index d3faf27..f510200 100644
--- a/Graphics/Text/Font/Choose/LangSet.hs
+++ b/Graphics/Text/Font/Choose/LangSet.hs
@@ -21,6 +21,13 @@ langs :: LangSet
 langs = unsafePerformIO (thawStrSet =<< fcGetLangs)
 foreign import ccall "FcGetLangs" fcGetLangs :: IO StrSet_
 
+data LangResult = SameLang | DifferentTerritory | DifferentLang deriving Enum
+langSetCompare :: LangSet -> LangSet -> LangResult
+langSetCompare a b = unsafePerformIO $ withLangSet a $ \a' -> withLangSet b $ \b' ->
+    (toEnum <$> fcLangSetCompare a' b')
+foreign import ccall "FcLangSetCompare" fcLangSetCompare ::
+    LangSet_ -> LangSet_ -> IO Int
+
 langNormalize :: String -> String
 langNormalize = unsafePerformIO $ flip withCString (peekCString . fcLangNormalize)
 foreign import ccall "FcLangNormalize" fcLangNormalize :: CString -> CString
diff --git a/Graphics/Text/Font/Choose/ObjectType.hs b/Graphics/Text/Font/Choose/ObjectType.hs
deleted file mode 100644
index f78c4b3..0000000
--- a/Graphics/Text/Font/Choose/ObjectType.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-module Graphics.Text.Font.Choose.ObjectType
-
-import Graphics.Text.Font.Choose.Value (Value)
-
-data ObjectType = ObjectType String Value
diff --git a/Graphics/Text/Font/Choose/Result.hs b/Graphics/Text/Font/Choose/Result.hs
index a451e5c..ed785ef 100644
--- a/Graphics/Text/Font/Choose/Result.hs
+++ b/Graphics/Text/Font/Choose/Result.hs
@@ -1,9 +1,36 @@
 module Graphics.Text.Font.Choose.Result (Result(..), resultFromPointer) where
 
 import Foreign.Storable (peek)
+import Foreign.Ptr (Ptr, ptrNull)
+import Control.Exception (throwIO, throw, Exception)
 
 data Result = Match | NoMatch | TypeMismatch | ResultNoId | OutOfMemory
     deriving (Eq, Show, Read, Enum)
 
 resultFromPointer :: Ptr Int -> IO Result
 resultFromPointer res = toEnum <$> peek res
+
+data Error = ErrTypeMismatch | ErrResultNoId | ErrOutOfMemory deriving (Eq, Show, Read)
+instance Exception Error
+
+throwResult :: Result -> IO a -> IO (Maybe a)
+throwResult Match x = Just <$> x
+throwResult NoMatch _ = return Nothing
+throwResult TypeMismatch = throwIO ErrTypeMismatch
+throwResult ResultNoId = throwIO ErrResultNoId
+throwResult OutOfMemory = throwIO ErrOutOfMemory
+
+throwInt :: Int -> IO a -> IO (Maybe a)
+throwInt = throwResult . toEnum
+throwPtr :: Ptr Int -> IO a -> IO (Maybe a)
+throwPtr a b = resultFromPointer a >>= flip throwResult b
+
+throwFalse :: Bool -> IO ()
+throwFalse True = return ()
+throwFalse False = throwIO ErrOutOfMemory
+throwFalse' :: IO Bool -> IO ()
+throwFalse' = (>>= throwFalse)
+
+throwNull :: Ptr a -> Ptr a
+throwNull ptr | ptr == ptrNull = throw ErrOutOfMemory
+    | otherwise = ptr
-- 
2.30.2