module Graphics.Text.Font.Choose.LangSet (LangSet, defaultLangs, langs,
    langSetCompare, langNormalize, langCharSet,
    LangSet_, withLangSet, thawLangSet) where

import Data.Set (Set)
import qualified Data.Set as Set
import Graphics.Text.Font.Choose.Strings (thawStrSet, thawStrSet_, StrSet_)
import Graphics.Text.Font.Choose.CharSet (thawCharSet, CharSet_, CharSet)
import Graphics.Text.Font.Choose.Result (throwNull, throwFalse)

import Foreign.Ptr (Ptr)
import Foreign.C.String (CString, withCString, peekCString)
import Foreign.Marshal.Alloc (free)
import Control.Exception (bracket)
import Control.Monad (forM)
import System.IO.Unsafe (unsafePerformIO)

-- | An `LangSet` is a set of language names (each of which include language and
-- an optional territory). They are used when selecting fonts to indicate which
-- languages the fonts need to support. Each font is marked, using language
-- orthography information built into fontconfig, with the set of supported languages.
type LangSet = Set String

-- | Returns a string set of the default languages according to the environment
-- variables on the system. This function looks for them in order of FC_LANG,
-- LC_ALL, LC_CTYPE and LANG then. If there are no valid values in those
-- environment variables, "en" will be set as fallback.
defaultLangs :: IO LangSet
defaultLangs :: IO LangSet
defaultLangs = StrSet_ -> IO LangSet
thawStrSet forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO StrSet_
fcGetDefaultLangs
foreign import ccall "FcGetDefaultLangs" fcGetDefaultLangs :: IO StrSet_

-- | Returns a string set of all known languages.
langs :: LangSet
langs :: LangSet
langs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ IO StrSet_ -> IO LangSet
thawStrSet_ forall a b. (a -> b) -> a -> b
$ IO StrSet_
fcGetLangs
foreign import ccall "FcGetLangs" fcGetLangs :: IO StrSet_

-- | Result of language comparisons.
data LangResult = SameLang | DifferentTerritory | DifferentLang
    deriving (Int -> LangResult
LangResult -> Int
LangResult -> [LangResult]
LangResult -> LangResult
LangResult -> LangResult -> [LangResult]
LangResult -> LangResult -> LangResult -> [LangResult]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LangResult -> LangResult -> LangResult -> [LangResult]
$cenumFromThenTo :: LangResult -> LangResult -> LangResult -> [LangResult]
enumFromTo :: LangResult -> LangResult -> [LangResult]
$cenumFromTo :: LangResult -> LangResult -> [LangResult]
enumFromThen :: LangResult -> LangResult -> [LangResult]
$cenumFromThen :: LangResult -> LangResult -> [LangResult]
enumFrom :: LangResult -> [LangResult]
$cenumFrom :: LangResult -> [LangResult]
fromEnum :: LangResult -> Int
$cfromEnum :: LangResult -> Int
toEnum :: Int -> LangResult
$ctoEnum :: Int -> LangResult
pred :: LangResult -> LangResult
$cpred :: LangResult -> LangResult
succ :: LangResult -> LangResult
$csucc :: LangResult -> LangResult
Enum, LangResult -> LangResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LangResult -> LangResult -> Bool
$c/= :: LangResult -> LangResult -> Bool
== :: LangResult -> LangResult -> Bool
$c== :: LangResult -> LangResult -> Bool
Eq, ReadPrec [LangResult]
ReadPrec LangResult
Int -> ReadS LangResult
ReadS [LangResult]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LangResult]
$creadListPrec :: ReadPrec [LangResult]
readPrec :: ReadPrec LangResult
$creadPrec :: ReadPrec LangResult
readList :: ReadS [LangResult]
$creadList :: ReadS [LangResult]
readsPrec :: Int -> ReadS LangResult
$creadsPrec :: Int -> ReadS LangResult
Read, Int -> LangResult -> ShowS
[LangResult] -> ShowS
LangResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LangResult] -> ShowS
$cshowList :: [LangResult] -> ShowS
show :: LangResult -> String
$cshow :: LangResult -> String
showsPrec :: Int -> LangResult -> ShowS
$cshowsPrec :: Int -> LangResult -> ShowS
Show)
-- | `langSetCompare` compares language coverage for ls_a and ls_b.
-- If they share any language and territory pair, returns `SameLang`.
-- If they share a language but differ in which territory that language is for,
-- this function returns `DifferentTerritory`.
-- If they share no languages in common, this function returns `DifferentLang`.
langSetCompare :: LangSet -> LangSet -> LangResult
langSetCompare :: LangSet -> LangSet -> LangResult
langSetCompare LangSet
a LangSet
b = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. LangSet -> (LangSet_ -> IO a) -> IO a
withLangSet LangSet
a forall a b. (a -> b) -> a -> b
$ \LangSet_
a' -> forall a. LangSet -> (LangSet_ -> IO a) -> IO a
withLangSet LangSet
b forall a b. (a -> b) -> a -> b
$ \LangSet_
b' ->
    (forall a. Enum a => Int -> a
toEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LangSet_ -> LangSet_ -> IO Int
fcLangSetCompare LangSet_
a' LangSet_
b')
foreign import ccall "FcLangSetCompare" fcLangSetCompare ::
    LangSet_ -> LangSet_ -> IO Int

-- | `langSetContains` returns FcTrue if ls_a contains every language in ls_b.
-- ls_a will 'contain' a language from ls_b if ls_a has exactly the language,
-- or either the language or ls_a has no territory.
langSetContains :: LangSet -> LangSet -> Bool
langSetContains :: LangSet -> LangSet -> Bool
langSetContains LangSet
a LangSet
b = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. LangSet -> (LangSet_ -> IO a) -> IO a
withLangSet LangSet
a forall a b. (a -> b) -> a -> b
$ \LangSet_
a' -> forall a. LangSet -> (LangSet_ -> IO a) -> IO a
withLangSet LangSet
b forall a b. (a -> b) -> a -> b
$
    LangSet_ -> LangSet_ -> IO Bool
fcLangSetContains LangSet_
a'
foreign import ccall "FcLangSetContains" fcLangSetContains ::
    LangSet_ -> LangSet_ -> IO Bool

-- | FcLangSetHasLang checks whether ls supports lang.
-- If ls has a matching language and territory pair, this function returns
-- `SameLang`. If ls has a matching language but differs in which territory
-- that language is for, this function returns `DifferentTerritory`. If ls has
-- no matching language, this function returns `DifferentLang`.
langSetHasLang :: LangSet -> String -> LangResult
langSetHasLang :: LangSet -> String -> LangResult
langSetHasLang LangSet
a String
b = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. LangSet -> (LangSet_ -> IO a) -> IO a
withLangSet LangSet
a forall a b. (a -> b) -> a -> b
$ \LangSet_
a' -> forall a. String -> (CString -> IO a) -> IO a
withCString String
b forall a b. (a -> b) -> a -> b
$ \CString
b' ->
    (forall a. Enum a => Int -> a
toEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LangSet_ -> CString -> IO Int
fcLangSetHasLang LangSet_
a' CString
b')
foreign import ccall "FcLangSetHasLang" fcLangSetHasLang :: LangSet_ -> CString -> IO Int

-- | Returns a string to make lang suitable on FontConfig.
langNormalize :: String -> String
langNormalize :: ShowS
langNormalize String
"" = String
""
langNormalize String
lang = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. String -> (CString -> IO a) -> IO a
withCString String
lang (CString -> IO String
peekCString_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString
fcLangNormalize)
foreign import ccall "FcLangNormalize" fcLangNormalize :: CString -> CString
peekCString_ :: CString -> IO String
peekCString_ CString
str' = do
    String
str <- CString -> IO String
peekCString forall a b. (a -> b) -> a -> b
$ forall a. Ptr a -> Ptr a
throwNull CString
str'
    forall a. Ptr a -> IO ()
free CString
str'
    forall (m :: * -> *) a. Monad m => a -> m a
return String
str

-- | Returns the FcCharMap for a language.
langCharSet :: String -> CharSet
langCharSet :: String -> CharSet
langCharSet String
lang = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
    forall a. String -> (CString -> IO a) -> IO a
withCString String
lang (CharSet_ -> IO CharSet
thawCharSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ptr a -> Ptr a
throwNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CharSet_
fcLangGetCharSet)
foreign import ccall "FcLangGetCharSet" fcLangGetCharSet :: CString -> CharSet_

------
--- Low-level
------

data LangSet'
type LangSet_ = Ptr LangSet'

withNewLangSet :: (LangSet_ -> IO a) -> IO a
withNewLangSet :: forall a. (LangSet_ -> IO a) -> IO a
withNewLangSet = 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 LangSet_
fcLangSetCreate) LangSet_ -> IO ()
fcLangSetDestroy
foreign import ccall "FcLangSetCreate" fcLangSetCreate :: IO LangSet_
foreign import ccall "FcLangSetDestroy" fcLangSetDestroy :: LangSet_ -> IO ()

withLangSet :: LangSet -> (LangSet_ -> IO a) -> IO a
withLangSet :: forall a. LangSet -> (LangSet_ -> IO a) -> IO a
withLangSet LangSet
langs LangSet_ -> IO a
cb = forall a. (LangSet_ -> IO a) -> IO a
withNewLangSet forall a b. (a -> b) -> a -> b
$ \LangSet_
langs' -> 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 LangSet
langs) forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. String -> (CString -> IO a) -> IO a
withCString forall a b. (a -> b) -> a -> b
$ \CString
lang' ->
        Bool -> IO ()
throwFalse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LangSet_ -> CString -> IO Bool
fcLangSetAdd LangSet_
langs' CString
lang'
    LangSet_ -> IO a
cb LangSet_
langs'
foreign import ccall "FcLangSetAdd" fcLangSetAdd :: LangSet_ -> CString -> IO Bool

thawLangSet :: LangSet_ -> IO LangSet
thawLangSet :: LangSet_ -> IO LangSet
thawLangSet = IO StrSet_ -> IO LangSet
thawStrSet_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. LangSet_ -> IO StrSet_
fcLangSetGetLangs
foreign import ccall "FcLangSetGetLangs" fcLangSetGetLangs :: LangSet_ -> IO StrSet_