{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- 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.TextSpan
    ( 

-- * Exported types
    TextSpan(..)                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Poppler.Structs.TextSpan#g:method:copy"), [free]("GI.Poppler.Structs.TextSpan#g:method:free"), [isBoldFont]("GI.Poppler.Structs.TextSpan#g:method:isBoldFont"), [isFixedWidthFont]("GI.Poppler.Structs.TextSpan#g:method:isFixedWidthFont"), [isSerifFont]("GI.Poppler.Structs.TextSpan#g:method:isSerifFont").
-- 
-- ==== Getters
-- [getColor]("GI.Poppler.Structs.TextSpan#g:method:getColor"), [getFontName]("GI.Poppler.Structs.TextSpan#g:method:getFontName"), [getText]("GI.Poppler.Structs.TextSpan#g:method:getText").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveTextSpanMethod                   ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    TextSpanCopyMethodInfo                  ,
#endif
    textSpanCopy                            ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    TextSpanFreeMethodInfo                  ,
#endif
    textSpanFree                            ,


-- ** getColor #method:getColor#

#if defined(ENABLE_OVERLOADING)
    TextSpanGetColorMethodInfo              ,
#endif
    textSpanGetColor                        ,


-- ** getFontName #method:getFontName#

#if defined(ENABLE_OVERLOADING)
    TextSpanGetFontNameMethodInfo           ,
#endif
    textSpanGetFontName                     ,


-- ** getText #method:getText#

#if defined(ENABLE_OVERLOADING)
    TextSpanGetTextMethodInfo               ,
#endif
    textSpanGetText                         ,


-- ** isBoldFont #method:isBoldFont#

#if defined(ENABLE_OVERLOADING)
    TextSpanIsBoldFontMethodInfo            ,
#endif
    textSpanIsBoldFont                      ,


-- ** isFixedWidthFont #method:isFixedWidthFont#

#if defined(ENABLE_OVERLOADING)
    TextSpanIsFixedWidthFontMethodInfo      ,
#endif
    textSpanIsFixedWidthFont                ,


-- ** isSerifFont #method:isSerifFont#

#if defined(ENABLE_OVERLOADING)
    TextSpanIsSerifFontMethodInfo           ,
#endif
    textSpanIsSerifFont                     ,




    ) 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.GArray as B.GArray
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.Coerce as Coerce
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 qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.Poppler.Structs.Color as Poppler.Color

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

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

foreign import ccall "poppler_text_span_get_type" c_poppler_text_span_get_type :: 
    IO GType

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

instance B.Types.TypedObject TextSpan where
    glibType :: IO GType
glibType = IO GType
c_poppler_text_span_get_type

instance B.Types.GBoxed TextSpan

-- | Convert 'TextSpan' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe TextSpan) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_poppler_text_span_get_type
    gvalueSet_ :: Ptr GValue -> Maybe TextSpan -> IO ()
gvalueSet_ Ptr GValue
gv Maybe TextSpan
P.Nothing = Ptr GValue -> Ptr TextSpan -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr TextSpan
forall a. Ptr a
FP.nullPtr :: FP.Ptr TextSpan)
    gvalueSet_ Ptr GValue
gv (P.Just TextSpan
obj) = TextSpan -> (Ptr TextSpan -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr TextSpan
obj (Ptr GValue -> Ptr TextSpan -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe TextSpan)
gvalueGet_ Ptr GValue
gv = do
        Ptr TextSpan
ptr <- Ptr GValue -> IO (Ptr TextSpan)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr TextSpan)
        if Ptr TextSpan
ptr Ptr TextSpan -> Ptr TextSpan -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr TextSpan
forall a. Ptr a
FP.nullPtr
        then TextSpan -> Maybe TextSpan
forall a. a -> Maybe a
P.Just (TextSpan -> Maybe TextSpan) -> IO TextSpan -> IO (Maybe TextSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr TextSpan -> TextSpan) -> Ptr TextSpan -> IO TextSpan
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr TextSpan -> TextSpan
TextSpan Ptr TextSpan
ptr
        else Maybe TextSpan -> IO (Maybe TextSpan)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TextSpan
forall a. Maybe a
P.Nothing
        
    


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

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

foreign import ccall "poppler_text_span_copy" poppler_text_span_copy :: 
    Ptr TextSpan ->                         -- poppler_text_span : TInterface (Name {namespace = "Poppler", name = "TextSpan"})
    IO (Ptr TextSpan)

-- | Makes a copy of a text span.
-- 
-- /Since: 0.26/
textSpanCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextSpan
    -- ^ /@popplerTextSpan@/: a t'GI.Poppler.Structs.TextSpan.TextSpan'
    -> m TextSpan
    -- ^ __Returns:__ A new t'GI.Poppler.Structs.TextSpan.TextSpan'
textSpanCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextSpan -> m TextSpan
textSpanCopy TextSpan
popplerTextSpan = IO TextSpan -> m TextSpan
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextSpan -> m TextSpan) -> IO TextSpan -> m TextSpan
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextSpan
popplerTextSpan' <- TextSpan -> IO (Ptr TextSpan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextSpan
popplerTextSpan
    Ptr TextSpan
result <- Ptr TextSpan -> IO (Ptr TextSpan)
poppler_text_span_copy Ptr TextSpan
popplerTextSpan'
    Text -> Ptr TextSpan -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textSpanCopy" Ptr TextSpan
result
    TextSpan
result' <- ((ManagedPtr TextSpan -> TextSpan) -> Ptr TextSpan -> IO TextSpan
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TextSpan -> TextSpan
TextSpan) Ptr TextSpan
result
    TextSpan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextSpan
popplerTextSpan
    TextSpan -> IO TextSpan
forall (m :: * -> *) a. Monad m => a -> m a
return TextSpan
result'

#if defined(ENABLE_OVERLOADING)
data TextSpanCopyMethodInfo
instance (signature ~ (m TextSpan), MonadIO m) => O.OverloadedMethod TextSpanCopyMethodInfo TextSpan signature where
    overloadedMethod = textSpanCopy

instance O.OverloadedMethodInfo TextSpanCopyMethodInfo TextSpan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.TextSpan.textSpanCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-TextSpan.html#v:textSpanCopy"
        })


#endif

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

foreign import ccall "poppler_text_span_free" poppler_text_span_free :: 
    Ptr TextSpan ->                         -- poppler_text_span : TInterface (Name {namespace = "Poppler", name = "TextSpan"})
    IO ()

-- | Frees a text span.
-- 
-- /Since: 0.26/
textSpanFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextSpan
    -- ^ /@popplerTextSpan@/: A t'GI.Poppler.Structs.TextSpan.TextSpan'
    -> m ()
textSpanFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => TextSpan -> m ()
textSpanFree TextSpan
popplerTextSpan = 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 TextSpan
popplerTextSpan' <- TextSpan -> IO (Ptr TextSpan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextSpan
popplerTextSpan
    Ptr TextSpan -> IO ()
poppler_text_span_free Ptr TextSpan
popplerTextSpan'
    TextSpan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextSpan
popplerTextSpan
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextSpanFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod TextSpanFreeMethodInfo TextSpan signature where
    overloadedMethod = textSpanFree

instance O.OverloadedMethodInfo TextSpanFreeMethodInfo TextSpan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.TextSpan.textSpanFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-TextSpan.html#v:textSpanFree"
        })


#endif

-- method TextSpan::get_color
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_text_span"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "TextSpan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerTextSpan" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Color" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a return location for a #PopplerColor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_text_span_get_color" poppler_text_span_get_color :: 
    Ptr TextSpan ->                         -- poppler_text_span : TInterface (Name {namespace = "Poppler", name = "TextSpan"})
    Ptr Poppler.Color.Color ->              -- color : TInterface (Name {namespace = "Poppler", name = "Color"})
    IO ()

-- | Obtains the color in which the text is to be rendered.
-- 
-- /Since: 0.26/
textSpanGetColor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextSpan
    -- ^ /@popplerTextSpan@/: a t'GI.Poppler.Structs.TextSpan.TextSpan'
    -> m (Poppler.Color.Color)
textSpanGetColor :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextSpan -> m Color
textSpanGetColor TextSpan
popplerTextSpan = IO Color -> m Color
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextSpan
popplerTextSpan' <- TextSpan -> IO (Ptr TextSpan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextSpan
popplerTextSpan
    Ptr Color
color <- Int -> IO (Ptr Color)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
6 :: IO (Ptr Poppler.Color.Color)
    Ptr TextSpan -> Ptr Color -> IO ()
poppler_text_span_get_color Ptr TextSpan
popplerTextSpan' Ptr Color
color
    Color
color' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Poppler.Color.Color) Ptr Color
color
    TextSpan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextSpan
popplerTextSpan
    Color -> IO Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
color'

#if defined(ENABLE_OVERLOADING)
data TextSpanGetColorMethodInfo
instance (signature ~ (m (Poppler.Color.Color)), MonadIO m) => O.OverloadedMethod TextSpanGetColorMethodInfo TextSpan signature where
    overloadedMethod = textSpanGetColor

instance O.OverloadedMethodInfo TextSpanGetColorMethodInfo TextSpan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.TextSpan.textSpanGetColor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-TextSpan.html#v:textSpanGetColor"
        })


#endif

-- method TextSpan::get_font_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_text_span"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "TextSpan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerTextSpan" , 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_text_span_get_font_name" poppler_text_span_get_font_name :: 
    Ptr TextSpan ->                         -- poppler_text_span : TInterface (Name {namespace = "Poppler", name = "TextSpan"})
    IO CString

-- | Obtains the name of the font in which the span is to be rendered.
-- 
-- /Since: 0.26/
textSpanGetFontName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextSpan
    -- ^ /@popplerTextSpan@/: a t'GI.Poppler.Structs.TextSpan.TextSpan'
    -> m T.Text
    -- ^ __Returns:__ A string containing the font name, or
    --   'P.Nothing' if a font is not defined.
textSpanGetFontName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextSpan -> m Text
textSpanGetFontName TextSpan
popplerTextSpan = 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 TextSpan
popplerTextSpan' <- TextSpan -> IO (Ptr TextSpan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextSpan
popplerTextSpan
    CString
result <- Ptr TextSpan -> IO CString
poppler_text_span_get_font_name Ptr TextSpan
popplerTextSpan'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textSpanGetFontName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    TextSpan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextSpan
popplerTextSpan
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data TextSpanGetFontNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod TextSpanGetFontNameMethodInfo TextSpan signature where
    overloadedMethod = textSpanGetFontName

instance O.OverloadedMethodInfo TextSpanGetFontNameMethodInfo TextSpan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.TextSpan.textSpanGetFontName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-TextSpan.html#v:textSpanGetFontName"
        })


#endif

-- method TextSpan::get_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_text_span"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "TextSpan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerTextSpan" , 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_text_span_get_text" poppler_text_span_get_text :: 
    Ptr TextSpan ->                         -- poppler_text_span : TInterface (Name {namespace = "Poppler", name = "TextSpan"})
    IO CString

-- | Obtains the text contained in the span.
-- 
-- /Since: 0.26/
textSpanGetText ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextSpan
    -- ^ /@popplerTextSpan@/: a t'GI.Poppler.Structs.TextSpan.TextSpan'
    -> m T.Text
    -- ^ __Returns:__ A string.
textSpanGetText :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextSpan -> m Text
textSpanGetText TextSpan
popplerTextSpan = 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 TextSpan
popplerTextSpan' <- TextSpan -> IO (Ptr TextSpan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextSpan
popplerTextSpan
    CString
result <- Ptr TextSpan -> IO CString
poppler_text_span_get_text Ptr TextSpan
popplerTextSpan'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"textSpanGetText" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    TextSpan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextSpan
popplerTextSpan
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data TextSpanGetTextMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod TextSpanGetTextMethodInfo TextSpan signature where
    overloadedMethod = textSpanGetText

instance O.OverloadedMethodInfo TextSpanGetTextMethodInfo TextSpan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.TextSpan.textSpanGetText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-TextSpan.html#v:textSpanGetText"
        })


#endif

-- method TextSpan::is_bold_font
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_text_span"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "TextSpan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerTextSpan" , 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_text_span_is_bold_font" poppler_text_span_is_bold_font :: 
    Ptr TextSpan ->                         -- poppler_text_span : TInterface (Name {namespace = "Poppler", name = "TextSpan"})
    IO CInt

-- | Check whether a text span is meant to be rendered using a bold font.
-- 
-- /Since: 0.26/
textSpanIsBoldFont ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextSpan
    -- ^ /@popplerTextSpan@/: a t'GI.Poppler.Structs.TextSpan.TextSpan'
    -> m Bool
    -- ^ __Returns:__ Whether the span uses bold font.
textSpanIsBoldFont :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextSpan -> m Bool
textSpanIsBoldFont TextSpan
popplerTextSpan = 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 TextSpan
popplerTextSpan' <- TextSpan -> IO (Ptr TextSpan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextSpan
popplerTextSpan
    CInt
result <- Ptr TextSpan -> IO CInt
poppler_text_span_is_bold_font Ptr TextSpan
popplerTextSpan'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TextSpan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextSpan
popplerTextSpan
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TextSpanIsBoldFontMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod TextSpanIsBoldFontMethodInfo TextSpan signature where
    overloadedMethod = textSpanIsBoldFont

instance O.OverloadedMethodInfo TextSpanIsBoldFontMethodInfo TextSpan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.TextSpan.textSpanIsBoldFont",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-TextSpan.html#v:textSpanIsBoldFont"
        })


#endif

-- method TextSpan::is_fixed_width_font
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_text_span"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "TextSpan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerTextSpan" , 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_text_span_is_fixed_width_font" poppler_text_span_is_fixed_width_font :: 
    Ptr TextSpan ->                         -- poppler_text_span : TInterface (Name {namespace = "Poppler", name = "TextSpan"})
    IO CInt

-- | Check wether a text span is meant to be rendered using a fixed-width font.
-- 
-- /Since: 0.26/
textSpanIsFixedWidthFont ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextSpan
    -- ^ /@popplerTextSpan@/: a t'GI.Poppler.Structs.TextSpan.TextSpan'
    -> m Bool
    -- ^ __Returns:__ Whether the span uses a fixed-width font.
textSpanIsFixedWidthFont :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextSpan -> m Bool
textSpanIsFixedWidthFont TextSpan
popplerTextSpan = 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 TextSpan
popplerTextSpan' <- TextSpan -> IO (Ptr TextSpan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextSpan
popplerTextSpan
    CInt
result <- Ptr TextSpan -> IO CInt
poppler_text_span_is_fixed_width_font Ptr TextSpan
popplerTextSpan'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TextSpan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextSpan
popplerTextSpan
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TextSpanIsFixedWidthFontMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod TextSpanIsFixedWidthFontMethodInfo TextSpan signature where
    overloadedMethod = textSpanIsFixedWidthFont

instance O.OverloadedMethodInfo TextSpanIsFixedWidthFontMethodInfo TextSpan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.TextSpan.textSpanIsFixedWidthFont",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-TextSpan.html#v:textSpanIsFixedWidthFont"
        })


#endif

-- method TextSpan::is_serif_font
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_text_span"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "TextSpan" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerTextSpan" , 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_text_span_is_serif_font" poppler_text_span_is_serif_font :: 
    Ptr TextSpan ->                         -- poppler_text_span : TInterface (Name {namespace = "Poppler", name = "TextSpan"})
    IO CInt

-- | Check whether a text span is meant to be rendered using a serif font.
-- 
-- /Since: 0.26/
textSpanIsSerifFont ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextSpan
    -- ^ /@popplerTextSpan@/: a t'GI.Poppler.Structs.TextSpan.TextSpan'
    -> m Bool
    -- ^ __Returns:__ Whether the span uses a serif font.
textSpanIsSerifFont :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TextSpan -> m Bool
textSpanIsSerifFont TextSpan
popplerTextSpan = 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 TextSpan
popplerTextSpan' <- TextSpan -> IO (Ptr TextSpan)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextSpan
popplerTextSpan
    CInt
result <- Ptr TextSpan -> IO CInt
poppler_text_span_is_serif_font Ptr TextSpan
popplerTextSpan'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TextSpan -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextSpan
popplerTextSpan
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TextSpanIsSerifFontMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod TextSpanIsSerifFontMethodInfo TextSpan signature where
    overloadedMethod = textSpanIsSerifFont

instance O.OverloadedMethodInfo TextSpanIsSerifFontMethodInfo TextSpan where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Structs.TextSpan.textSpanIsSerifFont",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Structs-TextSpan.html#v:textSpanIsSerifFont"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTextSpanMethod (t :: Symbol) (o :: *) :: * where
    ResolveTextSpanMethod "copy" o = TextSpanCopyMethodInfo
    ResolveTextSpanMethod "free" o = TextSpanFreeMethodInfo
    ResolveTextSpanMethod "isBoldFont" o = TextSpanIsBoldFontMethodInfo
    ResolveTextSpanMethod "isFixedWidthFont" o = TextSpanIsFixedWidthFontMethodInfo
    ResolveTextSpanMethod "isSerifFont" o = TextSpanIsSerifFontMethodInfo
    ResolveTextSpanMethod "getColor" o = TextSpanGetColorMethodInfo
    ResolveTextSpanMethod "getFontName" o = TextSpanGetFontNameMethodInfo
    ResolveTextSpanMethod "getText" o = TextSpanGetTextMethodInfo
    ResolveTextSpanMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveTextSpanMethod t TextSpan, O.OverloadedMethod info TextSpan p, R.HasField t TextSpan p) => R.HasField t TextSpan p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveTextSpanMethod t TextSpan, O.OverloadedMethodInfo info TextSpan) => OL.IsLabel t (O.MethodProxy info TextSpan) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif