{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Poppler.Structs.FontsIter
    ( 

-- * Exported types
    FontsIter(..)                           ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveFontsIterMethod                  ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    FontsIterCopyMethodInfo                 ,
#endif
    fontsIterCopy                           ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    FontsIterFreeMethodInfo                 ,
#endif
    fontsIterFree                           ,


-- ** getEncoding #method:getEncoding#

#if defined(ENABLE_OVERLOADING)
    FontsIterGetEncodingMethodInfo          ,
#endif
    fontsIterGetEncoding                    ,


-- ** getFileName #method:getFileName#

#if defined(ENABLE_OVERLOADING)
    FontsIterGetFileNameMethodInfo          ,
#endif
    fontsIterGetFileName                    ,


-- ** getFontType #method:getFontType#

#if defined(ENABLE_OVERLOADING)
    FontsIterGetFontTypeMethodInfo          ,
#endif
    fontsIterGetFontType                    ,


-- ** getFullName #method:getFullName#

#if defined(ENABLE_OVERLOADING)
    FontsIterGetFullNameMethodInfo          ,
#endif
    fontsIterGetFullName                    ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    FontsIterGetNameMethodInfo              ,
#endif
    fontsIterGetName                        ,


-- ** getSubstituteName #method:getSubstituteName#

#if defined(ENABLE_OVERLOADING)
    FontsIterGetSubstituteNameMethodInfo    ,
#endif
    fontsIterGetSubstituteName              ,


-- ** isEmbedded #method:isEmbedded#

#if defined(ENABLE_OVERLOADING)
    FontsIterIsEmbeddedMethodInfo           ,
#endif
    fontsIterIsEmbedded                     ,


-- ** isSubset #method:isSubset#

#if defined(ENABLE_OVERLOADING)
    FontsIterIsSubsetMethodInfo             ,
#endif
    fontsIterIsSubset                       ,


-- ** next #method:next#

#if defined(ENABLE_OVERLOADING)
    FontsIterNextMethodInfo                 ,
#endif
    fontsIterNext                           ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums

-- | Memory-managed wrapper type.
newtype FontsIter = FontsIter (SP.ManagedPtr FontsIter)
    deriving (FontsIter -> FontsIter -> Bool
(FontsIter -> FontsIter -> Bool)
-> (FontsIter -> FontsIter -> Bool) -> Eq FontsIter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontsIter -> FontsIter -> Bool
$c/= :: FontsIter -> FontsIter -> Bool
== :: FontsIter -> FontsIter -> Bool
$c== :: FontsIter -> FontsIter -> Bool
Eq)

instance SP.ManagedPtrNewtype FontsIter where
    toManagedPtr :: FontsIter -> ManagedPtr FontsIter
toManagedPtr (FontsIter ManagedPtr FontsIter
p) = ManagedPtr FontsIter
p

foreign import ccall "poppler_fonts_iter_get_type" c_poppler_fonts_iter_get_type :: 
    IO GType

type instance O.ParentTypes FontsIter = '[]
instance O.HasParentTypes FontsIter

instance B.Types.TypedObject FontsIter where
    glibType :: IO GType
glibType = IO GType
c_poppler_fonts_iter_get_type

instance B.Types.GBoxed FontsIter

-- | Convert 'FontsIter' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue FontsIter where
    toGValue :: FontsIter -> IO GValue
toGValue FontsIter
o = do
        GType
gtype <- IO GType
c_poppler_fonts_iter_get_type
        FontsIter -> (Ptr FontsIter -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr FontsIter
o (GType
-> (GValue -> Ptr FontsIter -> IO ()) -> Ptr FontsIter -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr FontsIter -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO FontsIter
fromGValue GValue
gv = do
        Ptr FontsIter
ptr <- GValue -> IO (Ptr FontsIter)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr FontsIter)
        (ManagedPtr FontsIter -> FontsIter)
-> Ptr FontsIter -> IO FontsIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr FontsIter -> FontsIter
FontsIter Ptr FontsIter
ptr
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FontsIter
type instance O.AttributeList FontsIter = FontsIterAttributeList
type FontsIterAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method FontsIter::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FontsIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFontsIter to copy"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "FontsIter" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_fonts_iter_copy" poppler_fonts_iter_copy :: 
    Ptr FontsIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "FontsIter"})
    IO (Ptr FontsIter)

-- | Creates a copy of /@iter@/
fontsIterCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontsIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.FontsIter.FontsIter' to copy
    -> m FontsIter
    -- ^ __Returns:__ a new allocated copy of /@iter@/
fontsIterCopy :: FontsIter -> m FontsIter
fontsIterCopy FontsIter
iter = IO FontsIter -> m FontsIter
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontsIter -> m FontsIter) -> IO FontsIter -> m FontsIter
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontsIter
iter' <- FontsIter -> IO (Ptr FontsIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontsIter
iter
    Ptr FontsIter
result <- Ptr FontsIter -> IO (Ptr FontsIter)
poppler_fonts_iter_copy Ptr FontsIter
iter'
    Text -> Ptr FontsIter -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontsIterCopy" Ptr FontsIter
result
    FontsIter
result' <- ((ManagedPtr FontsIter -> FontsIter)
-> Ptr FontsIter -> IO FontsIter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FontsIter -> FontsIter
FontsIter) Ptr FontsIter
result
    FontsIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontsIter
iter
    FontsIter -> IO FontsIter
forall (m :: * -> *) a. Monad m => a -> m a
return FontsIter
result'

#if defined(ENABLE_OVERLOADING)
data FontsIterCopyMethodInfo
instance (signature ~ (m FontsIter), MonadIO m) => O.MethodInfo FontsIterCopyMethodInfo FontsIter signature where
    overloadedMethod = fontsIterCopy

#endif

-- method FontsIter::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FontsIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFontsIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_fonts_iter_free" poppler_fonts_iter_free :: 
    Ptr FontsIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "FontsIter"})
    IO ()

-- | Frees the given t'GI.Poppler.Structs.FontsIter.FontsIter'
fontsIterFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontsIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.FontsIter.FontsIter'
    -> m ()
fontsIterFree :: FontsIter -> m ()
fontsIterFree FontsIter
iter = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontsIter
iter' <- FontsIter -> IO (Ptr FontsIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontsIter
iter
    Ptr FontsIter -> IO ()
poppler_fonts_iter_free Ptr FontsIter
iter'
    FontsIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontsIter
iter
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FontsIterFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo FontsIterFreeMethodInfo FontsIter signature where
    overloadedMethod = fontsIterFree

#endif

-- method FontsIter::get_encoding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FontsIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFontsIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_fonts_iter_get_encoding" poppler_fonts_iter_get_encoding :: 
    Ptr FontsIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "FontsIter"})
    IO CString

-- | Returns the encoding of the font associated with /@iter@/
-- 
-- /Since: 0.20/
fontsIterGetEncoding ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontsIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.FontsIter.FontsIter'
    -> m T.Text
    -- ^ __Returns:__ the font encoding
fontsIterGetEncoding :: FontsIter -> m Text
fontsIterGetEncoding FontsIter
iter = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontsIter
iter' <- FontsIter -> IO (Ptr FontsIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontsIter
iter
    CString
result <- Ptr FontsIter -> IO CString
poppler_fonts_iter_get_encoding Ptr FontsIter
iter'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontsIterGetEncoding" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    FontsIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontsIter
iter
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FontsIterGetEncodingMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo FontsIterGetEncodingMethodInfo FontsIter signature where
    overloadedMethod = fontsIterGetEncoding

#endif

-- method FontsIter::get_file_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FontsIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFontsIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_fonts_iter_get_file_name" poppler_fonts_iter_get_file_name :: 
    Ptr FontsIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "FontsIter"})
    IO CString

-- | The filename of the font associated with /@iter@/ or 'P.Nothing' if
-- the font is embedded
fontsIterGetFileName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontsIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.FontsIter.FontsIter'
    -> m T.Text
    -- ^ __Returns:__ the filename of the font or 'P.Nothing' if font is embedded
fontsIterGetFileName :: FontsIter -> m Text
fontsIterGetFileName FontsIter
iter = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontsIter
iter' <- FontsIter -> IO (Ptr FontsIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontsIter
iter
    CString
result <- Ptr FontsIter -> IO CString
poppler_fonts_iter_get_file_name Ptr FontsIter
iter'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontsIterGetFileName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    FontsIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontsIter
iter
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FontsIterGetFileNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo FontsIterGetFileNameMethodInfo FontsIter signature where
    overloadedMethod = fontsIterGetFileName

#endif

-- method FontsIter::get_font_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FontsIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFontsIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "FontType" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_fonts_iter_get_font_type" poppler_fonts_iter_get_font_type :: 
    Ptr FontsIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "FontsIter"})
    IO CUInt

-- | Returns the type of the font associated with /@iter@/
fontsIterGetFontType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontsIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.FontsIter.FontsIter'
    -> m Poppler.Enums.FontType
    -- ^ __Returns:__ the font type
fontsIterGetFontType :: FontsIter -> m FontType
fontsIterGetFontType FontsIter
iter = IO FontType -> m FontType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FontType -> m FontType) -> IO FontType -> m FontType
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontsIter
iter' <- FontsIter -> IO (Ptr FontsIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontsIter
iter
    CUInt
result <- Ptr FontsIter -> IO CUInt
poppler_fonts_iter_get_font_type Ptr FontsIter
iter'
    let result' :: FontType
result' = (Int -> FontType
forall a. Enum a => Int -> a
toEnum (Int -> FontType) -> (CUInt -> Int) -> CUInt -> FontType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    FontsIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontsIter
iter
    FontType -> IO FontType
forall (m :: * -> *) a. Monad m => a -> m a
return FontType
result'

#if defined(ENABLE_OVERLOADING)
data FontsIterGetFontTypeMethodInfo
instance (signature ~ (m Poppler.Enums.FontType), MonadIO m) => O.MethodInfo FontsIterGetFontTypeMethodInfo FontsIter signature where
    overloadedMethod = fontsIterGetFontType

#endif

-- method FontsIter::get_full_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FontsIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFontsIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_fonts_iter_get_full_name" poppler_fonts_iter_get_full_name :: 
    Ptr FontsIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "FontsIter"})
    IO CString

-- | Returns the full name of the font associated with /@iter@/
fontsIterGetFullName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontsIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.FontsIter.FontsIter'
    -> m T.Text
    -- ^ __Returns:__ the font full name
fontsIterGetFullName :: FontsIter -> m Text
fontsIterGetFullName FontsIter
iter = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontsIter
iter' <- FontsIter -> IO (Ptr FontsIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontsIter
iter
    CString
result <- Ptr FontsIter -> IO CString
poppler_fonts_iter_get_full_name Ptr FontsIter
iter'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontsIterGetFullName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    FontsIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontsIter
iter
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FontsIterGetFullNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo FontsIterGetFullNameMethodInfo FontsIter signature where
    overloadedMethod = fontsIterGetFullName

#endif

-- method FontsIter::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FontsIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFontsIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_fonts_iter_get_name" poppler_fonts_iter_get_name :: 
    Ptr FontsIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "FontsIter"})
    IO CString

-- | Returns the name of the font associated with /@iter@/
fontsIterGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontsIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.FontsIter.FontsIter'
    -> m T.Text
    -- ^ __Returns:__ the font name
fontsIterGetName :: FontsIter -> m Text
fontsIterGetName FontsIter
iter = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontsIter
iter' <- FontsIter -> IO (Ptr FontsIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontsIter
iter
    CString
result <- Ptr FontsIter -> IO CString
poppler_fonts_iter_get_name Ptr FontsIter
iter'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontsIterGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    FontsIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontsIter
iter
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FontsIterGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo FontsIterGetNameMethodInfo FontsIter signature where
    overloadedMethod = fontsIterGetName

#endif

-- method FontsIter::get_substitute_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FontsIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFontsIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_fonts_iter_get_substitute_name" poppler_fonts_iter_get_substitute_name :: 
    Ptr FontsIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "FontsIter"})
    IO CString

-- | The name of the substitute font of the font associated with /@iter@/ or 'P.Nothing' if
-- the font is embedded
-- 
-- /Since: 0.20/
fontsIterGetSubstituteName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontsIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.FontsIter.FontsIter'
    -> m T.Text
    -- ^ __Returns:__ the name of the substitute font or 'P.Nothing' if font is embedded
fontsIterGetSubstituteName :: FontsIter -> m Text
fontsIterGetSubstituteName FontsIter
iter = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontsIter
iter' <- FontsIter -> IO (Ptr FontsIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontsIter
iter
    CString
result <- Ptr FontsIter -> IO CString
poppler_fonts_iter_get_substitute_name Ptr FontsIter
iter'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fontsIterGetSubstituteName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    FontsIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontsIter
iter
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FontsIterGetSubstituteNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo FontsIterGetSubstituteNameMethodInfo FontsIter signature where
    overloadedMethod = fontsIterGetSubstituteName

#endif

-- method FontsIter::is_embedded
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FontsIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFontsIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_fonts_iter_is_embedded" poppler_fonts_iter_is_embedded :: 
    Ptr FontsIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "FontsIter"})
    IO CInt

-- | Returns whether the font associated with /@iter@/ is embedded in the document
fontsIterIsEmbedded ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontsIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.FontsIter.FontsIter'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if font is embedded, 'P.False' otherwise
fontsIterIsEmbedded :: FontsIter -> m Bool
fontsIterIsEmbedded FontsIter
iter = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontsIter
iter' <- FontsIter -> IO (Ptr FontsIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontsIter
iter
    CInt
result <- Ptr FontsIter -> IO CInt
poppler_fonts_iter_is_embedded Ptr FontsIter
iter'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    FontsIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontsIter
iter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FontsIterIsEmbeddedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo FontsIterIsEmbeddedMethodInfo FontsIter signature where
    overloadedMethod = fontsIterIsEmbedded

#endif

-- method FontsIter::is_subset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FontsIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFontsIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_fonts_iter_is_subset" poppler_fonts_iter_is_subset :: 
    Ptr FontsIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "FontsIter"})
    IO CInt

-- | Returns whether the font associated with /@iter@/ is a subset of another font
fontsIterIsSubset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontsIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.FontsIter.FontsIter'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if font is a subset, 'P.False' otherwise
fontsIterIsSubset :: FontsIter -> m Bool
fontsIterIsSubset FontsIter
iter = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontsIter
iter' <- FontsIter -> IO (Ptr FontsIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontsIter
iter
    CInt
result <- Ptr FontsIter -> IO CInt
poppler_fonts_iter_is_subset Ptr FontsIter
iter'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    FontsIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontsIter
iter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FontsIterIsSubsetMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo FontsIterIsSubsetMethodInfo FontsIter signature where
    overloadedMethod = fontsIterIsSubset

#endif

-- method FontsIter::next
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "iter"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FontsIter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFontsIter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_fonts_iter_next" poppler_fonts_iter_next :: 
    Ptr FontsIter ->                        -- iter : TInterface (Name {namespace = "Poppler", name = "FontsIter"})
    IO CInt

-- | Sets /@iter@/ to point to the next font
fontsIterNext ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FontsIter
    -- ^ /@iter@/: a t'GI.Poppler.Structs.FontsIter.FontsIter'
    -> m Bool
    -- ^ __Returns:__ 'P.True', if /@iter@/ was set to the next font
fontsIterNext :: FontsIter -> m Bool
fontsIterNext FontsIter
iter = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr FontsIter
iter' <- FontsIter -> IO (Ptr FontsIter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr FontsIter
iter
    CInt
result <- Ptr FontsIter -> IO CInt
poppler_fonts_iter_next Ptr FontsIter
iter'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    FontsIter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr FontsIter
iter
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FontsIterNextMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo FontsIterNextMethodInfo FontsIter signature where
    overloadedMethod = fontsIterNext

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveFontsIterMethod (t :: Symbol) (o :: *) :: * where
    ResolveFontsIterMethod "copy" o = FontsIterCopyMethodInfo
    ResolveFontsIterMethod "free" o = FontsIterFreeMethodInfo
    ResolveFontsIterMethod "isEmbedded" o = FontsIterIsEmbeddedMethodInfo
    ResolveFontsIterMethod "isSubset" o = FontsIterIsSubsetMethodInfo
    ResolveFontsIterMethod "next" o = FontsIterNextMethodInfo
    ResolveFontsIterMethod "getEncoding" o = FontsIterGetEncodingMethodInfo
    ResolveFontsIterMethod "getFileName" o = FontsIterGetFileNameMethodInfo
    ResolveFontsIterMethod "getFontType" o = FontsIterGetFontTypeMethodInfo
    ResolveFontsIterMethod "getFullName" o = FontsIterGetFullNameMethodInfo
    ResolveFontsIterMethod "getName" o = FontsIterGetNameMethodInfo
    ResolveFontsIterMethod "getSubstituteName" o = FontsIterGetSubstituteNameMethodInfo
    ResolveFontsIterMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveFontsIterMethod t FontsIter, O.MethodInfo info FontsIter p) => OL.IsLabel t (FontsIter -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif