21 files changed, 738 insertions(+), 0 deletions(-)

A CHANGELOG.md
A Graphics/Text/Font/Choose/CharSet.hs
A Graphics/Text/Font/Choose/Config.hs
A Graphics/Text/Font/Choose/Constant.hs
A Graphics/Text/Font/Choose/FontSet.hs
A Graphics/Text/Font/Choose/FreeType.hs
A Graphics/Text/Font/Choose/Init.hs
A Graphics/Text/Font/Choose/LangResult.hs
A Graphics/Text/Font/Choose/LangSet.hs
A Graphics/Text/Font/Choose/ObjectSet.hs
A Graphics/Text/Font/Choose/ObjectType.hs
A Graphics/Text/Font/Choose/Pattern.hs
A Graphics/Text/Font/Choose/Range.hs
A Graphics/Text/Font/Choose/Result.hs
A Graphics/Text/Font/Choose/SetName.hs
A Graphics/Text/Font/Choose/Strings.hs
A Graphics/Text/Font/Choose/Value.hs
A LICENSE
A Main.hs
A Setup.hs
A fontconfig-pure.cabal

@@ 1,5 @@
+# Revision history for fontconfig-pure
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

@@ 1,50 @@
+module Graphics.Text.Font.Choose.CharSet where
+
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+import Data.Word (Word32)
+import Foreign.Ptr
+import Control.Exception (bracket)
+import Control.Monad (forM)
+import Foreign.Marshal.Alloc (alloca, allocaBytes)
+import GHC.Base (unsafeChr)
+import Data.Char (ord)
+
+type CharSet = Set Char
+
+------
+--- Low-level
+------
+
+data CharSet'
+type CharSet_ = Ptr CharSet'
+
+withNewCharSet :: (CharSet_ -> IO a) -> IO a
+withNewCharSet cb = bracket fcCharSetCreate fcCharSetDestroy cb
+foreign import ccall "FcCharSetCreate" fcCharSetCreate :: IO CharSet_
+foreign import ccall "FcCharSetDestroy" fcCharSetDestroy :: CharSet_ -> IO ()
+
+withCharSet :: CharSet -> (CharSet_ -> IO a) -> IO a
+withCharSet chars cb = withNewCharSet $ \chars' -> do
+    forM (Set.elems chars) $ fcCharSetAddChar chars' . fromIntegral . ord
+    cb chars'
+foreign import ccall "FcCharSetAddChar" fcCharSetAddChar :: CharSet_ -> Word32 -> IO Bool
+
+thawCharSet :: CharSet_ -> IO CharSet
+thawCharSet chars' = allocaBytes fcCHARSET_MAP_SIZE $ \iter' -> alloca $ \next' -> do
+    first <- fcCharSetFirstPage chars' iter' next'
+    let go = do {
+        ch <- fcCharSetNextPage chars' iter' next';
+        if ch == maxBound then return []
+        else do
+            chs <- go
+            return (ch:chs)
+      }
+    rest <- go
+    return $ Set.fromList $ map (unsafeChr . fromIntegral) (first:rest)
+foreign import ccall "FcCharSetFirstPage" fcCharSetFirstPage ::
+    CharSet_ -> Ptr Word32 -> Ptr Word32 -> IO Word32
+foreign import ccall "FcCharSetNextPage" fcCharSetNextPage ::
+    CharSet_ -> Ptr Word32 -> Ptr Word32 -> IO Word32
+foreign import ccall "my_FcCHARSET_MAP_SIZE" fcCHARSET_MAP_SIZE :: Int

@@ 1,3 @@
+module Graphics.Text.Font.Choose.Constant where
+
+data Constant = Constant { name :: String, object :: String, value :: Int }

@@ 1,76 @@
+-- NOTE: Untested!
+module Graphics.Text.Font.Choose.FontSet where
+
+import Graphics.Text.Font.Choose.Pattern
+import Graphics.Text.Font.Choose.Config
+import Graphics.Text.Font.Choose.ObjectSet
+
+import Foreign.Ptr (Ptr, castPtr)
+import Foreign.Storable (pokeElemOff, sizeOf, peek)
+import Foreign.Marshal.Alloc (allocaBytes)
+import Foreign.Marshal.Array (advancePtr)
+import Control.Monad (forM)
+import Control.Exception (bracket)
+
+type FontSet = [Pattern]
+
+fontSetList :: Config -> [FontSet] -> Pattern -> ObjectSet
+fontSetList config fontss pattern objs = withConfig config $ \config' ->
+    withFontSets fontss $ \fontss' -> withPattern $ \pattern' ->
+        withObjectSet objs $ \objs' -> do
+            ret <- fcFontSetList config' fontss' n pattern' objs'
+            thawFontSet ret
+foreign import ccall "FcFontSetList" fcFontSetList ::
+    Config_ -> Ptr FontSet_ -> Int -> Pattern_ -> ObjectSet_ -> IO FontSet_
+
+fontSetMatch :: Config -> [FontSet] -> Pattern -> Maybe Pattern
+fontSetMatch config fontss pattern = withConfig config $ \config' ->
+    withFontSets fontss $ \fontss' -> withPattern $ \pattern' ->  alloca $ \res' -> do
+        ret <- fcFontSetMatch config' fontss' n pattern' res'
+        res <- peek res'
+        -- FIXME Is this correct success code?
+        if res == 0 then Just <$> thawPattern ret else return Nothing
+
+fontSetSort :: Config -> [FontSet] -> Pattern -> Bool -> CharSet -> Maybe FontSet
+fontSetSort config fontss pattern trim csp cb = withConfig config $ \config' ->
+        withFontSets fontss $ \fontss' withPattern $ \pattern' ->
+            withCharSet csp $ \csp' -> alloca $ \res' -> do
+                ret' <- fcFontSetSort config' fontss' n pattern' trim csp' res'
+                res <- peek res'
+                ret <- if res == 0 then Just <$> thawFontSet ret' else return Nothing
+                fcFontSetDestroy ret'
+                return ret
+
+------
+--- Low-level
+------
+type FontSet' = Int
+type FontSet_ = Ptr FontSet'
+
+withNewFontSet :: (FontSet_ -> IO a) -> IO a
+withNewFontSet = bracket fcFontSetCreate fcFontSetDestroy
+foreign import ccall "FcFontSetCreate" fcFontSetCreate :: IO FontSet_
+foreign import ccall "FcFontSetDestroy" fcFontSetDestroy :: FontSet_ -> IO ()
+
+withFontSet :: FontSet -> (FontSet_ -> IO a) -> IO a
+withFontSet fonts cb = withNewFontSet $ \fonts' ->
+    forM fonts $ \font -> (fcFontSetAdd fonts' =<< patternAsPointer font)
+    cb fonts'
+
+withFontSets :: [FontSet] -> (Ptr FontSet_ -> IO a) -> IO a
+withFontSets fontss cb = let n = length fontss in
+    allocaBytes (sizeOf (undefined :: FontSet_) * n) $ \fontss' ->
+        withFontSets' fontss 0 fontss' -> cb fontss'
+withFontSets' :: [FontSet] -> Int -> Ptr FontSet_ -> IO a -> IO a
+withFontSets' [] _ _ cb = cb
+withFontSets' (fonts:fontss) i fontss' cb = withFontSet fonts $ \fonts' -> do
+    pokeElemOff fontss' i fonts'
+    withFontSets fontss (succ i) fontss' cb
+
+thawFontSet :: FontSet_ -> IO FontSet
+thawFontSet fonts' = do
+    n <- peek fonts'
+    array <- peek $ castPtr $ advancePtr fonts' 2
+    if n == 0 || array == nullPtr
+    then return []
+    else forM [0..pred n] $ \i -> thawPattern (advancePtr array i)

@@ 1,60 @@
+-- NOTE: Not tested
+module Graphics.Text.Font.Choose.FreeType where
+
+import Graphics.Text.Font.Choose.CharSet (CharSet, CharSet_, thawCharSet)
+import Graphics.Text.Font.Choose.Pattern (Pattern, Pattern_, thawPattern)
+import Graphics.Text.Font.Choose.FontSet (FontSet, FontSet_, withFontSet, thawFontSet)
+import FreeType.Core.Base (FT_Face(..))
+import Data.Word (Word32, Word)
+
+import Foreign.Ptr (nullPtr)
+import Foreign.Storable (peek)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.C.String (CString, withCString)
+import System.IO.Unsafe (unsafePerformIO)
+
+c2w :: Char -> Word32
+c2w = fromIntegral
+
+ftCharIndex :: FT_Face -> Char -> Word
+ftCharIndex face = fcFreeTypeCharIndex face . c2w
+foreign import ccall "FcFreeTypeCharIndex" fcFreeTypeCharIndex :: FT_Face -> Word32 -> Word
+
+ftCharSet :: FT_Face -> CharSet
+ftCharSet face = unsafePerformIO $ thawCharSet $ fcFreeTypeCharSet face nullPtr
+foreign import ccall "FcFreeTypeCharSet" fcFreeTypeCharSet
+    :: FT_Face -> Ptr () -> FcCharSet_ -- 2nd arg's deprecated!
+
+ftCharSetAndSpacing :: FT_Face -> (CharSet, Int)
+ftCharSetAndSpacing face = unsafePerformIO $ alloca $ \spacing' -> do
+    chars' <- fcFreeTypeCharSetAndSpacing face nullPtr spacing'
+    chars <- thawCharSet chars'
+    spacing <- peek spacing'
+    return (chars, spacing)
+foreign import ccall "FcFreeTypeCharSetAndSpacing" fcFreeTypeCharSetAndSpacing ::
+    FT_Face -> Ptr () -> Ptr Int -> IO CharSet_ -- 2nd arg's deprecated!
+
+ftQuery :: FilePath -> Int -> IO (Pattern, Int)
+ftQuery filename id = withCString filename $ \filename' -> alloca $ \count' -> do
+    pattern' <- fcFreeTypeQuery filename' id nullPtr count'
+    pattern <- thawPattern pattern'
+    count <- peek count'
+    return (pattern, count)
+foreign import call "FcFreeTypeQuery" fcFreeTypeQuery ::
+    CString -> Int -> Ptr () -> Ptr Int -> IO Pattern_ -- 3rd arg's deprecated!
+
+ftQueryAll :: FilePath -> Int -> IO (FontSet, Int)
+ftQueryAll filename id = withCString filename $ \filename' -> alloca \count' ->
+    withFontSet [] $ \fonts' -> do
+        fcFreeTypeQueryAll filename' id nullPtr count' fonts'
+        fonts <- thawFontSet fonts'
+        count <- peek count'
+        return (fonts, count)
+foreign import ccall "FcFreeTypeQueryAll" fcFreeTypeQueryAll ::
+    CString -> Int -> Ptr () -> Ptr Count -> FontSet_ -> IO Word -- 2nd arg's deprecated!
+
+ftQueryFace :: FT_Face -> FilePath -> Int -> Pattern
+ftQueryFace face filename id = withCString filename $ \filename' ->
+    thawPattern $ fcFreeTypeQueryFace face filename' id nullPtr
+foreign import ccall "FcFreeTypeQueryFace" fcFreeTypeQueryFace ::
+    FT_Face -> CString -> Int -> Ptr () -> Pattern_ -- Final arg's deprecated!

@@ 1,14 @@
+module Graphics.Text.Font.Choose.Init ({-Config, initLoadConfig, initLoadConfigAndFonts, -}
+    init, fini, reinit, bringUptoDate, version) where
+
+import Prelude hiding (init)
+
+{-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 ()
+foreign import ccall "FcInitReinitialize" reinit :: IO Bool
+foreign import ccall "FcInitBringUptoDate" bringUptoDate :: IO Bool
+
+foreign import ccall "FcGetVersion" version :: Int

@@ 1,51 @@
+module Graphics.Text.Font.Choose.LangSet where
+
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Graphics.Text.Font.Choose.Strings (thawStrSet, StrSet_)
+import Graphics.Text.Font.Choose.CharSet (thawCharSet, CharSet_, CharSet)
+
+import Foreign.Ptr (Ptr)
+import Foreign.C.String (CString, withCString, peekCString)
+import Control.Exception (bracket)
+import Control.Monad (forM)
+import System.IO.Unsafe (unsafePerformIO)
+
+type LangSet = Set String
+
+defaultLangs :: IO LangSet
+defaultLangs = thawStrSet =<< fcGetDefaultLangs
+foreign import ccall "FcGetDefaultLangs" fcGetDefaultLangs :: IO StrSet_
+
+langs :: LangSet
+langs = unsafePerformIO (thawStrSet =<< fcGetLangs)
+foreign import ccall "FcGetLangs" fcGetLangs :: IO StrSet_
+
+langNormalize :: String -> String
+langNormalize = unsafePerformIO $ flip withCString (peekCString . fcLangNormalize)
+foreign import ccall "FcLangNormalize" fcLangNormalize :: CString -> CString
+
+langCharSet :: String -> CharSet
+langCharSet = unsafePerformIO $ flip withCString (thawCharSet . fcLangGetCharSet)
+foreign import ccall "FcLangGetCharSet" fcLangGetCharSet :: CString -> CharSet_
+
+------
+--- Low-level
+------
+
+data LangSet'
+type LangSet_ = Ptr LangSet'
+
+withNewLangSet :: (LangSet_ -> IO a) -> IO a
+withNewLangSet = bracket fcLangSetCreate fcLangSetDestroy
+foreign import ccall "FcLangSetCreate" fcLangSetCreate :: IO LangSet_
+foreign import ccall "FcLangSetDestroy" fcLangSetDestroy :: LangSet_ -> IO ()
+
+withLangSet :: LangSet -> (LangSet_ -> IO a) -> IO a
+withLangSet langs cb = withNewLangSet $ \langs' -> do
+    forM (Set.elems langs) $ flip withCString $ fcLangSetAdd langs'
+    cb langs'
+
+thawLangSet :: LangSet_ -> IO LangSet
+thawLangSet langs' = thawStrSet =<< fcLangSetGetLangs langs'
+foreign import ccall "FcLangSetGetLangs" fcLangSetGetLangs :: LangSet_ -> IO StrSet_

@@ 1,27 @@
+module Graphics.Text.Font.Choose.ObjectSet where
+
+import Foreign.Ptr (Ptr)
+import Foreign.C.String (CString, withCString)
+
+import Control.Monad (forM)
+import Control.Exception (bracket)
+
+type ObjectSet = [String]
+
+------
+--- LowLevel
+------
+data ObjectSet'
+type ObjectSet_ = Ptr ObjectSet'
+
+withObjectSet :: ObjectSet -> (ObjectSet_ -> IO a) -> IO a
+withObjectSet objs cb = withNewObjectSet $ \objs' -> do
+    forM objs $ \obj -> withCString obj $ fcObjectSetAdd objs'
+    cb objs'
+foreign import ccall "FcObjectSetAdd" fcObjectSetAdd ::
+    ObjectSet_ -> CString -> IO Bool
+
+withNewObjectSet :: (ObjectSet_ -> IO a) -> IO a
+withNewObjectSet cb = bracket fcObjectSetCreate fcObjectSetDestroy cb
+foreign import ccall "FcObjectSetCreate" fcObjectSetCreate :: IO ObjectSet_
+foreign import ccall "FcObjectSetDestroy" fcObjectSetDestroy :: ObjectSet_ -> IO ()

@@ 1,5 @@
+module Graphics.Text.Font.Choose.ObjectType
+
+import Graphics.Text.Font.Choose.Value (Value)
+
+data ObjectType = ObjectType String Value

@@ 1,124 @@
+-- NOTE: Untested!
+module Graphics.Text.Font.Choose.Pattern (Pattern(..), Strength(..), equalSubset,
+    Pattern_, withPattern) where
+
+import Prelude hiding (filter)
+
+import Graphics.Text.Font.Choose.Value (Value, withValue, thawValue, Value_)
+import Graphics.Text.Font.Choose.ObjectSet (ObjectSet, ObjectSet_, withObjectSet)
+import Data.Hashable (Hashable)
+
+import Foreign.Ptr (Ptr)
+import Foreign.C.String (CString, withCString, peekCString)
+import Debug.Trace (trace) -- For reporting internal errors!
+
+type Pattern = [(String, [(Binding, Value)])] deriving (Eq, Ord, Hashable, Show)
+data Binding = Strong | Weak | Same deriving (Eq, Ord, Enum, Show)
+
+instance Hashable Binding where
+    hash Strong = 0
+    hash Weak = 1
+    hash Same = 2
+
+normalizePattern pat =
+    [(key, [val | (key', val) <- pat, key' == key]) | key <- nub $ map fst pat]
+
+equalSubset :: Pattern -> Pattern -> ObjectSet -> Bool
+equalSubset a b objs = unsafePerformIO $ withPattern a $ \a' -> withPattern b $ \b' ->
+    withObjectSet objs $ fcPatternEqualSubset a' b'
+foreign import ccall "FcPatternEqualSubset" fcPatternEqualSubset ::
+    Pattern_ -> Pattern_ -> ObjectSet_ -> IO Bool
+
+filter :: Pattern -> ObjectSet -> Pattern
+filter pat objs =
+    unsafePerformIO $ withPattern pat $ \pat' -> withObjectSet objs $ \objs' -> do
+        ret <- fcPatternFilter pat' objs'
+        thawPattern ret
+foreign import ccall "FcPatternFilter" fcPatternFilter ::
+    Pattern_ -> ObjectSet_ -> IO Pattern_
+
+substitute :: Pattern -> Pattern
+substitute pat = unsafePerformIO $ withPattern pat $ \pat' -> do
+    ret <- fcDefaultSubstitute pat'
+    thawPattern pat'
+foreign import ccall "FcPatternSubstitute" fcPatternSubstitute :: Pattern_ -> IO ()
+
+nameParse :: String -> Pattern
+nameParse name = unsafePerformIO $ withCString name $ \name' -> do
+    ret <- fcNameParse name'
+    thawPattern ret
+foreign import ccall "FcNameParse" fcNameParse :: CString -> IO Pattern_
+
+nameUnparse :: Pattern -> String
+nameUnparse pat = unsafePerformIO $ withPattern pat $ \pat' -> do
+    ret <- fcNameUnparse pat'
+    peekCString ret
+
+format :: Pattern -> String -> String
+format pat fmt =
+    unsafePerformIO $ withPattern pat $ \pat' -> withCString fmt $ \fmt' -> do
+        ret <- fcPatternFormat pat' fmt'
+        peekCString ret
+foreign import ccall "FcPatternFormat" fcPatternFormat ::
+    Pattern_ -> CString -> IO CString
+
+------
+--- Low-level
+------
+
+data Pattern'
+type Pattern_ = Ptr Pattern'
+
+withPattern :: Pattern -> (Pattern_ -> IO a) -> IO a
+withPattern pat cb = withNewPattern $ \pat' -> do
+    forM pat $ \(obj, vals) -> withCString obj $ \obj' -> do
+        forM vals $ \(strength, val) -> withValue val $
+            fcPatternAdd_ pat' obj' (strength == Strong) True
+    cb pat'
+-- Does Haskell FFI support unboxed structs? Do I really need to write a C wrapper?
+foreign import ccall "my_FCPatternAdd" fcPatternAdd_ ::
+    Pattern_ -> CString -> Bool -> Bool -> Value_ -> IO Bool
+
+patternAsPointer :: Pattern -> IO Pattern_
+patternAsPointer = withPattern fcPatternCopy
+foreign import ccall "FcPatternCopy" fcPatternCopy :: Pattern_ -> IO Pattern_
+
+data PatternIter'
+type PatternIter_ = Ptr PatternIter
+thawPattern :: Pattern_ -> IO Pattern
+thawPattern pat' = alloca $ \iter' -> do
+    fcPatternIterStart pat' iter'
+    ret <- go iter'
+    return $ normalizePattern ret
+  where
+    go iter' = do
+        ok <- fcPatternIterNext pat' iter'
+        if ok then do
+            x <- thawPattern' pat' iter'
+            xs <- go iter'
+            return (x : xs)
+        else return []
+foreign import ccall "FcPatternIterStart" fcPatternIterStart ::
+    Pattern_ -> PatternIter_ -> IO ()
+foreign import ccall "FcPatternIterNext" fcPatternIterNext ::
+    Pattern_ -> PatternIter_ -> IO Bool
+
+thawPattern' :: Pattern_ -> PatternIter_ -> IO (String, [(Binding, Value)])
+thawPattern' pat' iter' = do
+    obj <- peekCString $ fcPatternIterGetObject pat' iter'
+    count <- fcPatternIterValueCount pat' iter'
+    values <- forM [0..pred count] $ \i -> alloca $ \val' -> alloca $ \binding' -> do
+        res <- fcPatternIterGetValue pat' iter' i val' binding'
+        if res then do
+            binding <- peek binding'
+            val <- thawValue val'
+            return $ Just (toEnum binding, val)
+        else trace
+                ("FontConfig: Error retrieving value for " ++ obj ++
+                    " code: " ++ show res) $
+            return Nothing
+    return (obj, catMaybes values)
+
+withNewPattern cb = bracket fcPatternCreate fcPatternDestroy cb
+foreign import ccall "FcPatternCreate" fcPatternCreate :: IO Pattern_
+foreign import ccall "FcPatternDestroy" fcPatternDestroy :: Pattern_ -> IO ()

@@ 1,30 @@
+module Graphics.Text.Font.Choose.Range where
+
+import Foreign.Ptr (Ptr)
+import Control.Exception (bracket)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Storable (peek)
+
+data Range = Range Double Double
+iRange i j = toEnum i `Range` toEnum j
+
+------
+--- Low-level
+------
+data Range'
+type Range_ = Ptr Range'
+
+withRange :: Range -> (Range_ -> IO a) -> IO a
+withRange (Range i j) = bracket (fcRangeCreateDouble i j) fcRangeDestroy
+foreign import ccall "FcRangeCreateDouble" fcRangeCreateDouble ::
+    Double -> Double -> IO Range_
+foreign import ccall "FcRangeDestroy" fcRangeDestroy :: Range_ -> IO ()
+
+thawRange :: Range_ -> IO Range
+thawRange range' = alloca $ \i' -> alloca $ \j' -> do
+    fcRangeGetDouble range' i' j'
+    i <- peek i'
+    j <- peek j'
+    return $ Range i j
+foreign import ccall "FcRangeGetDouble" fcRangeGetDouble ::
+    Range_ -> Ptr Double -> Ptr Double -> IO Bool

@@ 1,9 @@
+module Graphics.Text.Font.Choose.Result (Result(..), resultFromPointer) where
+
+import Foreign.Storable (peek)
+
+data Result = Match | NoMatch | TypeMismatch | ResultNoId | OutOfMemory
+    deriving (Eq, Show, Read, Enum)
+
+resultFromPointer :: Ptr Int -> IO Result
+resultFromPointer res = toEnum <$> peek res

@@ 1,63 @@
+module Graphics.Text.Font.Choose.Strings (StrSet, StrSet_, StrList, StrList_,
+    withStrSet, withFilenameSet, thawStrSet, withStrList, thawStrList) where
+
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+import Foreign.Ptr (Ptr, nullPtr)
+import Foreign.C.String (CString, withCString, peekCString)
+import Control.Exception (bracket)
+import Control.Monad (forM)
+
+type StrSet = Set String
+
+data StrSet'
+type StrSet_ = Ptr StrSet'
+
+withNewStrSet :: (StrSet_ -> IO a) -> IO a
+withNewStrSet = bracket fcStrSetCreate fcStrSetDestroy
+foreign import ccall "FcStrSetCreate" fcStrSetCreate :: IO StrSet_
+foreign import ccall "FcStrSetDestroy" fcStrSetDestroy :: StrSet_ -> IO ()
+
+withStrSet :: StrSet -> (StrSet_ -> IO a) -> IO a
+withStrSet strs cb = withNewStrSet $ \strs' -> do
+    forM (Set.elems strs) $ flip withCString $ fcStrSetAdd strs'
+    cb strs'
+foreign import ccall "FcStrSetAdd" fcStrSetAdd :: StrSet_ -> CString -> IO Bool
+
+withFilenameSet :: StrSet -> (StrSet_ -> IO a) -> IO a
+withFilenameSet paths cb = withNewStrSet $ \paths' -> do
+    forM (Set.elems paths) $ flip withCString $ fcStrSetAddFilename paths'
+    cb paths'
+foreign import ccall "FcStrSetAddFilename" fcStrSetAddFilename ::
+    StrSet_ -> CString -> IO Bool
+
+thawStrSet :: StrSet_ -> IO StrSet
+thawStrSet strs = Set.fromList <$> withStrList strs thawStrList
+
+------------
+
+type StrList = [String]
+
+data StrList'
+type StrList_ = Ptr StrList'
+
+withStrList :: StrSet_ -> (StrList_ -> IO a) -> IO a
+withStrList strs = bracket (fcStrListCreate strs) fcStrListDone
+foreign import ccall "FcStrListCreate" fcStrListCreate :: StrSet_ -> IO StrList_
+foreign import ccall "FcStrListDone" fcStrListDone :: StrList_ -> IO ()
+
+thawStrList :: StrList_ -> IO StrList
+thawStrList strs' = do
+    fcStrListFirst strs'
+    go
+  where
+    go = do
+        item' <- fcStrListNext strs'
+        if item' == nullPtr then return []
+        else do
+            item <- peekCString item'
+            items <- go
+            return (item : items)
+foreign import ccall "FcStrListFirst" fcStrListFirst :: StrList_ -> IO ()
+foreign import ccall "FcStrListNext" fcStrListNext :: StrList_ -> IO CString

@@ 1,103 @@
+-- NOTE: Untested!
+module Data.Text.Font.Choose where
+
+import Linear.Matrix (M22)
+import Graphics.Text.Font.Choose.CharSet (CharSet)
+import FreeType.Core.Base (FT_Face(..))
+import Graphics.Text.Font.Choose.LangSet (LangSet)
+import Graphics.Text.Font.Choose.Range (Range)
+
+import Foreign.Ptr (Ptr)
+
+data Value = ValueVoid
+    | ValueInt Int
+    | ValueDouble Double
+    | ValueString String
+    | ValueMatrix (M22 Double)
+    | ValueCharSet CharSet
+    | ValueFTFace FT_Face
+    | ValueLangSet LangSet
+    | ValueRange Range deriving (Eq, Show, Ord, Generic)
+
+instance GHashable Value
+
+------
+--- Low-level
+------
+
+type Value_ = Ptr Int
+
+value'Size = sizeof (undefined :: Int) * 2
+pokeUnion ptr x = castPtr (ptr `plusPtr` sizeof (undefined :: Int)) `poke` x
+
+withValue :: Value -> (Value_ -> IO a) -> IO a
+withValue ValueVoid cb = allocaBytes value'Size $ \val' -> do
+    poke val' 0
+    cb val'
+withValue (ValueInt x) cb = allocaBytes value'Size $ \val' -> do
+    poke val' 1
+    pokeElemOff val' 1 x
+    cb val'
+withValue (ValueDouble x) cb = allocaBytes value'Size $ \val' -> do
+    poke val' 2
+    pokeUnion val' x
+    cb val'
+withValue (ValueString str) cb =
+    withCString str $ \str' allocaBytes value'Size $ \val' -> do
+        poke val' 3
+        pokeUnion val' str'
+        cb val'
+withValue (ValueMatrix mat) cb =
+    withMatrix mat $ \mat' -> allocaBytes value'Size $ \val' -> do
+        poke val' 4
+        pokeUnion val' mat'
+        cb val'
+withValue (ValueCharSet charsets) cb =
+    withCharSets charsets $ \charsets' -> allocaBytes value'Size $ \val' -> do
+        poke val' 5
+        pokeUnion val' charsets'
+        cb val'
+withValue (ValueFTFace x) cb = allocaBytes value'Size $ \val' -> do
+    poke val' 6
+    pokeUnion val' x
+    cb val'
+withValue (ValueLangSet langset) cb =
+    withLangSet langset $ \langset' -> allocaBytes value'Size $ \val' -> do
+        poke val' 7
+        pokeUnion val' langset'
+        cb val'
+withValue (ValueRange range) cb =
+    withRange range $ \range' -> allocaBytes value'Size $ \val' -> do
+        poke val' 8
+        pokeUnion val' range'
+        cb val'
+
+mat22Size = sizeof (undefined :: Double) * 4
+withMatrix (V2 (V2 xx yx) (V2 xy yy)) cb = allocaBytes mat22Size $ \mat' -> do
+    pokeElemOff mat' 0 xx
+    pokeElemOff mat' 1 xy
+    pokeElemOff mat' 2 yx
+    pokeElemOff mat' 3 yy
+    cb mat'
+
+thawValue :: Value_ -> IO (Maybe Value)
+thawValue ptr = do
+    kind <- peek ptr
+    let val' = castPtr (ptr `plusPtr` sizeof (undefined :: Int))
+    case kind of
+        0 -> return ValueVoid
+        1 -> Just <$> ValueInt <$> peek val'
+        2 -> Just <$> ValueDouble <$> peek val'
+        3 -> Just <$> ValueString <$> peekCString val'
+        4 -> do
+            mat' <- peek val'
+            xx <- peekElemOff mat' 0
+            xy <- peekElemOff mat' 1
+            yx <- peekElemOff mat' 2
+            yy <- peekElemOff mat' 3
+            return $ Just $ ValueMatrix $ V2 (V2 xx yx) (V2 xy yy)
+        5 -> Just <$> ValueCharSet <$> thawCharSet val'
+        6 -> return $ Just $ ValueFTFace $ val'
+        7 -> Just <$> ValueLangSet <$> thawLangSet val'
+        8 -> Just <$> ValueRange <$> thawRange val'
+        _ -> return Nothing

@@ 1,20 @@
+Copyright (c) 2022 Adrian Cochrane
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ 1,4 @@
+module Main where
+
+main :: IO ()
+main = putStrLn "Hello, Haskell!"

@@ 1,2 @@
+import Distribution.Simple
+main = defaultMain

@@ 1,92 @@
+-- Initial fontconfig-pure.cabal generated by cabal init.  For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+-- The name of the package.
+name:                fontconfig-pure
+
+-- The package version.  See the Haskell package versioning policy (PVP)
+-- for standards guiding when and how versions should be incremented.
+-- https://wiki.haskell.org/Package_versioning_policy
+-- PVP summary:      +-+------- breaking API changes
+--                   | | +----- non-breaking API additions
+--                   | | | +--- code changes with no API change
+version:             0.1.0.0
+
+-- A short (one-line) description of the package.
+synopsis:            Pure-functional language bindings to FontConfig
+
+-- A longer description of the package.
+-- description:
+
+-- URL for the project homepage or repository.
+homepage:            https://www.freedesktop.org/wiki/Software/fontconfig/
+
+-- The license under which the package is released.
+license:             MIT
+
+-- The file containing the license text.
+license-file:        LICENSE
+
+-- The package author(s).
+author:              Adrian Cochrane
+
+-- An email address to which users can send suggestions, bug reports, and
+-- patches.
+maintainer:          adrian@openwork.nz
+
+-- A copyright notice.
+-- copyright:
+
+category:            Text
+
+build-type:          Simple
+
+-- Extra files to be distributed with the package, such as examples or a
+-- README.
+extra-source-files:  CHANGELOG.md
+
+-- Constraint on the version of Cabal needed to build this package.
+cabal-version:       >=1.10
+
+
+library
+  -- Modules exported by the library.
+  exposed-modules:      Graphics.Text.Font.Choose.Init,
+                Graphics.Text.Font.Choose.ObjectSet, Graphics.Text.Font.Choose.CharSet,
+                Graphics.Text.Font.Choose.Strings, Graphics.Text.Font.Choose.Range
+
+  -- Modules included in this library but not exported.
+  -- other-modules:
+
+  -- LANGUAGE extensions used by modules in this package.
+  -- other-extensions:
+
+  -- Other library packages from which modules are imported.
+  build-depends:       base >=4.12 && <4.13, containers
+
+  -- Directories containing source files.
+  -- hs-source-dirs:
+
+  -- Base language which the package is written in.
+  default-language:    Haskell2010
+
+
+executable fontconfig-pure
+  -- .hs or .lhs file containing the Main module.
+  main-is:             Main.hs
+
+  -- Modules included in this executable, other than Main.
+  -- other-modules:
+
+  -- LANGUAGE extensions used by modules in this package.
+  -- other-extensions:
+
+  -- Other library packages from which modules are imported.
+  build-depends:       base >=4.12 && <4.13
+
+  -- Directories containing source files.
+  -- hs-source-dirs:
+
+  -- Base language which the package is written in.
+  default-language:    Haskell2010
+