module Graphics.Text.Font.Choose.Strings (StrSet, StrSet_, StrList, StrList_,
    withStrSet, withFilenameSet, thawStrSet, thawStrSet_,
    withStrList, thawStrList, thawStrList_) where

import Data.Set (Set)
import qualified Data.Set as Set
import Graphics.Text.Font.Choose.Result (throwNull, throwFalse)

import Foreign.Ptr (Ptr, nullPtr)
import Foreign.C.String (CString, withCString, peekCString)
import Control.Exception (bracket)
import Control.Monad (forM)

-- | Set of strings, as exposed by other FreeType APIs.
type StrSet = Set String

data StrSet'
type StrSet_ = Ptr StrSet'

withNewStrSet :: (StrSet_ -> IO a) -> IO a
withNewStrSet :: (StrSet_ -> IO a) -> IO a
withNewStrSet = IO StrSet_ -> (StrSet_ -> IO ()) -> (StrSet_ -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (StrSet_ -> StrSet_
forall a. Ptr a -> Ptr a
throwNull (StrSet_ -> StrSet_) -> IO StrSet_ -> IO StrSet_
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO StrSet_
fcStrSetCreate) StrSet_ -> IO ()
fcStrSetDestroy
foreign import ccall "FcStrSetCreate" fcStrSetCreate :: IO StrSet_
foreign import ccall "FcStrSetDestroy" fcStrSetDestroy :: StrSet_ -> IO ()

withStrSet :: StrSet -> (StrSet_ -> IO a) -> IO a
withStrSet :: StrSet -> (StrSet_ -> IO a) -> IO a
withStrSet strs :: StrSet
strs cb :: StrSet_ -> IO a
cb = (StrSet_ -> IO a) -> IO a
forall a. (StrSet_ -> IO a) -> IO a
withNewStrSet ((StrSet_ -> IO a) -> IO a) -> (StrSet_ -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \strs' :: StrSet_
strs' -> do
    [String] -> (String -> IO (IO ())) -> IO [IO ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (StrSet -> [String]
forall a. Set a -> [a]
Set.elems StrSet
strs) ((String -> IO (IO ())) -> IO [IO ()])
-> (String -> IO (IO ())) -> IO [IO ()]
forall a b. (a -> b) -> a -> b
$ \str :: String
str ->
        Bool -> IO ()
throwFalse (Bool -> IO ()) -> IO Bool -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
str ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ StrSet_ -> CString -> IO Bool
fcStrSetAdd StrSet_
strs')
    StrSet_ -> IO a
cb StrSet_
strs'
foreign import ccall "FcStrSetAdd" fcStrSetAdd :: StrSet_ -> CString -> IO Bool

withFilenameSet :: StrSet -> (StrSet_ -> IO a) -> IO a
withFilenameSet :: StrSet -> (StrSet_ -> IO a) -> IO a
withFilenameSet paths :: StrSet
paths cb :: StrSet_ -> IO a
cb = (StrSet_ -> IO a) -> IO a
forall a. (StrSet_ -> IO a) -> IO a
withNewStrSet ((StrSet_ -> IO a) -> IO a) -> (StrSet_ -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \paths' :: StrSet_
paths' -> do
    [String] -> (String -> IO (IO ())) -> IO [IO ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (StrSet -> [String]
forall a. Set a -> [a]
Set.elems StrSet
paths) ((String -> IO (IO ())) -> IO [IO ()])
-> (String -> IO (IO ())) -> IO [IO ()]
forall a b. (a -> b) -> a -> b
$ \path :: String
path ->
        Bool -> IO ()
throwFalse (Bool -> IO ()) -> IO Bool -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString String
path ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ StrSet_ -> CString -> IO Bool
fcStrSetAddFilename StrSet_
paths')
    StrSet_ -> IO a
cb StrSet_
paths'
foreign import ccall "FcStrSetAddFilename" fcStrSetAddFilename ::
    StrSet_ -> CString -> IO Bool

thawStrSet :: StrSet_ -> IO StrSet
thawStrSet :: StrSet_ -> IO StrSet
thawStrSet strs :: StrSet_
strs = [String] -> StrSet
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> StrSet) -> IO [String] -> IO StrSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrSet_ -> (StrList_ -> IO [String]) -> IO [String]
forall a. StrSet_ -> (StrList_ -> IO a) -> IO a
withStrList StrSet_
strs StrList_ -> IO [String]
thawStrList

thawStrSet_ :: IO StrSet_ -> IO StrSet
thawStrSet_ :: IO StrSet_ -> IO StrSet
thawStrSet_ cb :: IO StrSet_
cb = IO StrSet_
-> (StrSet_ -> IO ()) -> (StrSet_ -> IO StrSet) -> IO StrSet
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (StrSet_ -> StrSet_
forall a. Ptr a -> Ptr a
throwNull (StrSet_ -> StrSet_) -> IO StrSet_ -> IO StrSet_
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO StrSet_
cb) StrSet_ -> IO ()
fcStrSetDestroy StrSet_ -> IO StrSet
thawStrSet

------------

-- | Output string lists from FontConfig.
type StrList = [String]

data StrList'
type StrList_ = Ptr StrList'

withStrList :: StrSet_ -> (StrList_ -> IO a) -> IO a
withStrList :: StrSet_ -> (StrList_ -> IO a) -> IO a
withStrList strs :: StrSet_
strs = IO StrList_ -> (StrList_ -> IO ()) -> (StrList_ -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (StrList_ -> StrList_
forall a. Ptr a -> Ptr a
throwNull (StrList_ -> StrList_) -> IO StrList_ -> IO StrList_
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrSet_ -> IO StrList_
fcStrListCreate StrSet_
strs) StrList_ -> IO ()
fcStrListDone
foreign import ccall "FcStrListCreate" fcStrListCreate :: StrSet_ -> IO StrList_
foreign import ccall "FcStrListDone" fcStrListDone :: StrList_ -> IO ()

thawStrList :: StrList_ -> IO StrList
thawStrList :: StrList_ -> IO [String]
thawStrList strs' :: StrList_
strs' = do
    StrList_ -> IO ()
fcStrListFirst StrList_
strs'
    IO [String]
go
  where
    go :: IO [String]
go = do
        CString
item' <- StrList_ -> IO CString
fcStrListNext StrList_
strs'
        if CString
item' CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr then [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        else do
            String
item <- CString -> IO String
peekCString CString
item'
            [String]
items <- IO [String]
go
            [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String
item String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
items)
foreign import ccall "FcStrListFirst" fcStrListFirst :: StrList_ -> IO ()
foreign import ccall "FcStrListNext" fcStrListNext :: StrList_ -> IO CString

thawStrList_ :: IO StrList_ -> IO StrList
thawStrList_ :: IO StrList_ -> IO [String]
thawStrList_ cb :: IO StrList_
cb = IO StrList_
-> (StrList_ -> IO ()) -> (StrList_ -> IO [String]) -> IO [String]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (StrList_ -> StrList_
forall a. Ptr a -> Ptr a
throwNull (StrList_ -> StrList_) -> IO StrList_ -> IO StrList_
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO StrList_
cb) StrList_ -> IO ()
fcStrListDone StrList_ -> IO [String]
thawStrList