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 :: forall a. (StrSet_ -> IO a) -> IO a
withNewStrSet = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Ptr a -> Ptr a
throwNull 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 :: forall a. StrSet -> (StrSet_ -> IO a) -> IO a
withStrSet StrSet
strs StrSet_ -> IO a
cb = forall a. (StrSet_ -> IO a) -> IO a
withNewStrSet forall a b. (a -> b) -> a -> b
$ \StrSet_
strs' -> do
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. Set a -> [a]
Set.elems StrSet
strs) forall a b. (a -> b) -> a -> b
$ \String
str ->
        Bool -> IO ()
throwFalse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. String -> (CString -> IO a) -> IO a
withCString String
str 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 :: forall a. StrSet -> (StrSet_ -> IO a) -> IO a
withFilenameSet StrSet
paths StrSet_ -> IO a
cb = forall a. (StrSet_ -> IO a) -> IO a
withNewStrSet forall a b. (a -> b) -> a -> b
$ \StrSet_
paths' -> do
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. Set a -> [a]
Set.elems StrSet
paths) forall a b. (a -> b) -> a -> b
$ \String
path ->
        Bool -> IO ()
throwFalse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. String -> (CString -> IO a) -> IO a
withCString String
path 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 StrSet_
strs = forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. StrSet_ -> (StrList_ -> IO a) -> IO a
withStrList StrSet_
strs StrList_ -> IO StrList
thawStrList

thawStrSet_ :: IO StrSet_ -> IO StrSet
thawStrSet_ :: IO StrSet_ -> IO StrSet
thawStrSet_ IO StrSet_
cb = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Ptr a -> Ptr a
throwNull 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 :: forall a. StrSet_ -> (StrList_ -> IO a) -> IO a
withStrList StrSet_
strs = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Ptr a -> Ptr a
throwNull 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 StrList
thawStrList StrList_
strs' = do
    StrList_ -> IO ()
fcStrListFirst StrList_
strs'
    IO StrList
go
  where
    go :: IO StrList
go = do
        CString
item' <- StrList_ -> IO CString
fcStrListNext StrList_
strs'
        if CString
item' forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then forall (m :: * -> *) a. Monad m => a -> m a
return []
        else do
            String
item <- CString -> IO String
peekCString CString
item'
            StrList
items <- IO StrList
go
            forall (m :: * -> *) a. Monad m => a -> m a
return (String
item forall a. a -> [a] -> [a]
: StrList
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 StrList
thawStrList_ IO StrList_
cb = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. Ptr a -> Ptr a
throwNull forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO StrList_
cb) StrList_ -> IO ()
fcStrListDone StrList_ -> IO StrList
thawStrList