{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Poppler.Structs.TextAttributes.TextAttributes' is used to describe text attributes of a range of text
-- 
-- /Since: 0.18/

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

module GI.Poppler.Structs.TextAttributes
    ( 

-- * Exported types
    TextAttributes(..)                      ,
    newZeroTextAttributes                   ,
    noTextAttributes                        ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveTextAttributesMethod             ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    TextAttributesCopyMethodInfo            ,
#endif
    textAttributesCopy                      ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    TextAttributesFreeMethodInfo            ,
#endif
    textAttributesFree                      ,


-- ** new #method:new#

    textAttributesNew                       ,




 -- * Properties
-- ** color #attr:color#
-- | a t'GI.Poppler.Structs.Color.Color', the foreground color

    getTextAttributesColor                  ,
#if defined(ENABLE_OVERLOADING)
    textAttributes_color                    ,
#endif


-- ** endIndex #attr:endIndex#
-- | end position this text attributes apply

    getTextAttributesEndIndex               ,
    setTextAttributesEndIndex               ,
#if defined(ENABLE_OVERLOADING)
    textAttributes_endIndex                 ,
#endif


-- ** fontName #attr:fontName#
-- | font name

    clearTextAttributesFontName             ,
    getTextAttributesFontName               ,
    setTextAttributesFontName               ,
#if defined(ENABLE_OVERLOADING)
    textAttributes_fontName                 ,
#endif


-- ** fontSize #attr:fontSize#
-- | font size

    getTextAttributesFontSize               ,
    setTextAttributesFontSize               ,
#if defined(ENABLE_OVERLOADING)
    textAttributes_fontSize                 ,
#endif


-- ** isUnderlined #attr:isUnderlined#
-- | if text is underlined

    getTextAttributesIsUnderlined           ,
    setTextAttributesIsUnderlined           ,
#if defined(ENABLE_OVERLOADING)
    textAttributes_isUnderlined             ,
#endif


-- ** startIndex #attr:startIndex#
-- | start position this text attributes apply

    getTextAttributesStartIndex             ,
    setTextAttributesStartIndex             ,
#if defined(ENABLE_OVERLOADING)
    textAttributes_startIndex               ,
#endif




    ) 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.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 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.Structs.Color as Poppler.Color

-- | Memory-managed wrapper type.
newtype TextAttributes = TextAttributes (ManagedPtr TextAttributes)
    deriving (TextAttributes -> TextAttributes -> Bool
(TextAttributes -> TextAttributes -> Bool)
-> (TextAttributes -> TextAttributes -> Bool) -> Eq TextAttributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextAttributes -> TextAttributes -> Bool
$c/= :: TextAttributes -> TextAttributes -> Bool
== :: TextAttributes -> TextAttributes -> Bool
$c== :: TextAttributes -> TextAttributes -> Bool
Eq)
foreign import ccall "poppler_text_attributes_get_type" c_poppler_text_attributes_get_type :: 
    IO GType

instance BoxedObject TextAttributes where
    boxedType :: TextAttributes -> IO GType
boxedType _ = IO GType
c_poppler_text_attributes_get_type

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

-- | Construct a `TextAttributes` struct initialized to zero.
newZeroTextAttributes :: MonadIO m => m TextAttributes
newZeroTextAttributes :: m TextAttributes
newZeroTextAttributes = IO TextAttributes -> m TextAttributes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextAttributes -> m TextAttributes)
-> IO TextAttributes -> m TextAttributes
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr TextAttributes)
forall a. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes 40 IO (Ptr TextAttributes)
-> (Ptr TextAttributes -> IO TextAttributes) -> IO TextAttributes
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr TextAttributes -> TextAttributes)
-> Ptr TextAttributes -> IO TextAttributes
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TextAttributes -> TextAttributes
TextAttributes

instance tag ~ 'AttrSet => Constructible TextAttributes tag where
    new :: (ManagedPtr TextAttributes -> TextAttributes)
-> [AttrOp TextAttributes tag] -> m TextAttributes
new _ attrs :: [AttrOp TextAttributes tag]
attrs = do
        TextAttributes
o <- m TextAttributes
forall (m :: * -> *). MonadIO m => m TextAttributes
newZeroTextAttributes
        TextAttributes -> [AttrOp TextAttributes 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set TextAttributes
o [AttrOp TextAttributes tag]
[AttrOp TextAttributes 'AttrSet]
attrs
        TextAttributes -> m TextAttributes
forall (m :: * -> *) a. Monad m => a -> m a
return TextAttributes
o


-- | A convenience alias for `Nothing` :: `Maybe` `TextAttributes`.
noTextAttributes :: Maybe TextAttributes
noTextAttributes :: Maybe TextAttributes
noTextAttributes = Maybe TextAttributes
forall a. Maybe a
Nothing

-- | Get the value of the “@font_name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' textAttributes #fontName
-- @
getTextAttributesFontName :: MonadIO m => TextAttributes -> m (Maybe T.Text)
getTextAttributesFontName :: TextAttributes -> m (Maybe Text)
getTextAttributesFontName s :: TextAttributes
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ TextAttributes
-> (Ptr TextAttributes -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TextAttributes
s ((Ptr TextAttributes -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr TextAttributes -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr TextAttributes
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr TextAttributes
ptr Ptr TextAttributes -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \val' :: CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@font_name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' textAttributes [ #fontName 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextAttributesFontName :: MonadIO m => TextAttributes -> CString -> m ()
setTextAttributesFontName :: TextAttributes -> CString -> m ()
setTextAttributesFontName s :: TextAttributes
s val :: CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TextAttributes -> (Ptr TextAttributes -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TextAttributes
s ((Ptr TextAttributes -> IO ()) -> IO ())
-> (Ptr TextAttributes -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr TextAttributes
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TextAttributes
ptr Ptr TextAttributes -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) (CString
val :: CString)

-- | Set the value of the “@font_name@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #fontName
-- @
clearTextAttributesFontName :: MonadIO m => TextAttributes -> m ()
clearTextAttributesFontName :: TextAttributes -> m ()
clearTextAttributesFontName s :: TextAttributes
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TextAttributes -> (Ptr TextAttributes -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TextAttributes
s ((Ptr TextAttributes -> IO ()) -> IO ())
-> (Ptr TextAttributes -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr TextAttributes
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TextAttributes
ptr Ptr TextAttributes -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data TextAttributesFontNameFieldInfo
instance AttrInfo TextAttributesFontNameFieldInfo where
    type AttrBaseTypeConstraint TextAttributesFontNameFieldInfo = (~) TextAttributes
    type AttrAllowedOps TextAttributesFontNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TextAttributesFontNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint TextAttributesFontNameFieldInfo = (~)CString
    type AttrTransferType TextAttributesFontNameFieldInfo = CString
    type AttrGetType TextAttributesFontNameFieldInfo = Maybe T.Text
    type AttrLabel TextAttributesFontNameFieldInfo = "font_name"
    type AttrOrigin TextAttributesFontNameFieldInfo = TextAttributes
    attrGet = getTextAttributesFontName
    attrSet = setTextAttributesFontName
    attrConstruct = undefined
    attrClear = clearTextAttributesFontName
    attrTransfer _ v = do
        return v

textAttributes_fontName :: AttrLabelProxy "fontName"
textAttributes_fontName = AttrLabelProxy

#endif


-- | Get the value of the “@font_size@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' textAttributes #fontSize
-- @
getTextAttributesFontSize :: MonadIO m => TextAttributes -> m Double
getTextAttributesFontSize :: TextAttributes -> m Double
getTextAttributesFontSize s :: TextAttributes
s = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ TextAttributes -> (Ptr TextAttributes -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TextAttributes
s ((Ptr TextAttributes -> IO Double) -> IO Double)
-> (Ptr TextAttributes -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr TextAttributes
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr TextAttributes
ptr Ptr TextAttributes -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
val'

-- | Set the value of the “@font_size@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' textAttributes [ #fontSize 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextAttributesFontSize :: MonadIO m => TextAttributes -> Double -> m ()
setTextAttributesFontSize :: TextAttributes -> Double -> m ()
setTextAttributesFontSize s :: TextAttributes
s val :: Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TextAttributes -> (Ptr TextAttributes -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TextAttributes
s ((Ptr TextAttributes -> IO ()) -> IO ())
-> (Ptr TextAttributes -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr TextAttributes
ptr -> do
    let val' :: CDouble
val' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
val
    Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TextAttributes
ptr Ptr TextAttributes -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data TextAttributesFontSizeFieldInfo
instance AttrInfo TextAttributesFontSizeFieldInfo where
    type AttrBaseTypeConstraint TextAttributesFontSizeFieldInfo = (~) TextAttributes
    type AttrAllowedOps TextAttributesFontSizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TextAttributesFontSizeFieldInfo = (~) Double
    type AttrTransferTypeConstraint TextAttributesFontSizeFieldInfo = (~)Double
    type AttrTransferType TextAttributesFontSizeFieldInfo = Double
    type AttrGetType TextAttributesFontSizeFieldInfo = Double
    type AttrLabel TextAttributesFontSizeFieldInfo = "font_size"
    type AttrOrigin TextAttributesFontSizeFieldInfo = TextAttributes
    attrGet = getTextAttributesFontSize
    attrSet = setTextAttributesFontSize
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

textAttributes_fontSize :: AttrLabelProxy "fontSize"
textAttributes_fontSize = AttrLabelProxy

#endif


-- | Get the value of the “@is_underlined@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' textAttributes #isUnderlined
-- @
getTextAttributesIsUnderlined :: MonadIO m => TextAttributes -> m Bool
getTextAttributesIsUnderlined :: TextAttributes -> m Bool
getTextAttributesIsUnderlined s :: TextAttributes
s = 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
$ TextAttributes -> (Ptr TextAttributes -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TextAttributes
s ((Ptr TextAttributes -> IO Bool) -> IO Bool)
-> (Ptr TextAttributes -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr TextAttributes
ptr -> do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr TextAttributes
ptr Ptr TextAttributes -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) :: IO CInt
    let val' :: Bool
val' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
val
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
val'

-- | Set the value of the “@is_underlined@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' textAttributes [ #isUnderlined 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextAttributesIsUnderlined :: MonadIO m => TextAttributes -> Bool -> m ()
setTextAttributesIsUnderlined :: TextAttributes -> Bool -> m ()
setTextAttributesIsUnderlined s :: TextAttributes
s val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TextAttributes -> (Ptr TextAttributes -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TextAttributes
s ((Ptr TextAttributes -> IO ()) -> IO ())
-> (Ptr TextAttributes -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr TextAttributes
ptr -> do
    let val' :: CInt
val' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
val
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TextAttributes
ptr Ptr TextAttributes -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) (CInt
val' :: CInt)

#if defined(ENABLE_OVERLOADING)
data TextAttributesIsUnderlinedFieldInfo
instance AttrInfo TextAttributesIsUnderlinedFieldInfo where
    type AttrBaseTypeConstraint TextAttributesIsUnderlinedFieldInfo = (~) TextAttributes
    type AttrAllowedOps TextAttributesIsUnderlinedFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TextAttributesIsUnderlinedFieldInfo = (~) Bool
    type AttrTransferTypeConstraint TextAttributesIsUnderlinedFieldInfo = (~)Bool
    type AttrTransferType TextAttributesIsUnderlinedFieldInfo = Bool
    type AttrGetType TextAttributesIsUnderlinedFieldInfo = Bool
    type AttrLabel TextAttributesIsUnderlinedFieldInfo = "is_underlined"
    type AttrOrigin TextAttributesIsUnderlinedFieldInfo = TextAttributes
    attrGet = getTextAttributesIsUnderlined
    attrSet = setTextAttributesIsUnderlined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

textAttributes_isUnderlined :: AttrLabelProxy "isUnderlined"
textAttributes_isUnderlined = AttrLabelProxy

#endif


-- | Get the value of the “@color@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' textAttributes #color
-- @
getTextAttributesColor :: MonadIO m => TextAttributes -> m Poppler.Color.Color
getTextAttributesColor :: TextAttributes -> m Color
getTextAttributesColor s :: TextAttributes
s = 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
$ TextAttributes -> (Ptr TextAttributes -> IO Color) -> IO Color
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TextAttributes
s ((Ptr TextAttributes -> IO Color) -> IO Color)
-> (Ptr TextAttributes -> IO Color) -> IO Color
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr TextAttributes
ptr -> do
    let val :: Ptr Color
val = Ptr TextAttributes
ptr Ptr TextAttributes -> Int -> Ptr Color
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: (Ptr Poppler.Color.Color)
    Color
val' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Color -> Color
Poppler.Color.Color) Ptr Color
val
    Color -> IO Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
val'

#if defined(ENABLE_OVERLOADING)
data TextAttributesColorFieldInfo
instance AttrInfo TextAttributesColorFieldInfo where
    type AttrBaseTypeConstraint TextAttributesColorFieldInfo = (~) TextAttributes
    type AttrAllowedOps TextAttributesColorFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint TextAttributesColorFieldInfo = (~) (Ptr Poppler.Color.Color)
    type AttrTransferTypeConstraint TextAttributesColorFieldInfo = (~)(Ptr Poppler.Color.Color)
    type AttrTransferType TextAttributesColorFieldInfo = (Ptr Poppler.Color.Color)
    type AttrGetType TextAttributesColorFieldInfo = Poppler.Color.Color
    type AttrLabel TextAttributesColorFieldInfo = "color"
    type AttrOrigin TextAttributesColorFieldInfo = TextAttributes
    attrGet = getTextAttributesColor
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined

textAttributes_color :: AttrLabelProxy "color"
textAttributes_color = AttrLabelProxy

#endif


-- | Get the value of the “@start_index@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' textAttributes #startIndex
-- @
getTextAttributesStartIndex :: MonadIO m => TextAttributes -> m Int32
getTextAttributesStartIndex :: TextAttributes -> m Int32
getTextAttributesStartIndex s :: TextAttributes
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ TextAttributes -> (Ptr TextAttributes -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TextAttributes
s ((Ptr TextAttributes -> IO Int32) -> IO Int32)
-> (Ptr TextAttributes -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr TextAttributes
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr TextAttributes
ptr Ptr TextAttributes -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@start_index@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' textAttributes [ #startIndex 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextAttributesStartIndex :: MonadIO m => TextAttributes -> Int32 -> m ()
setTextAttributesStartIndex :: TextAttributes -> Int32 -> m ()
setTextAttributesStartIndex s :: TextAttributes
s val :: Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TextAttributes -> (Ptr TextAttributes -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TextAttributes
s ((Ptr TextAttributes -> IO ()) -> IO ())
-> (Ptr TextAttributes -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr TextAttributes
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TextAttributes
ptr Ptr TextAttributes -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 28) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data TextAttributesStartIndexFieldInfo
instance AttrInfo TextAttributesStartIndexFieldInfo where
    type AttrBaseTypeConstraint TextAttributesStartIndexFieldInfo = (~) TextAttributes
    type AttrAllowedOps TextAttributesStartIndexFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TextAttributesStartIndexFieldInfo = (~) Int32
    type AttrTransferTypeConstraint TextAttributesStartIndexFieldInfo = (~)Int32
    type AttrTransferType TextAttributesStartIndexFieldInfo = Int32
    type AttrGetType TextAttributesStartIndexFieldInfo = Int32
    type AttrLabel TextAttributesStartIndexFieldInfo = "start_index"
    type AttrOrigin TextAttributesStartIndexFieldInfo = TextAttributes
    attrGet = getTextAttributesStartIndex
    attrSet = setTextAttributesStartIndex
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

textAttributes_startIndex :: AttrLabelProxy "startIndex"
textAttributes_startIndex = AttrLabelProxy

#endif


-- | Get the value of the “@end_index@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' textAttributes #endIndex
-- @
getTextAttributesEndIndex :: MonadIO m => TextAttributes -> m Int32
getTextAttributesEndIndex :: TextAttributes -> m Int32
getTextAttributesEndIndex s :: TextAttributes
s = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ TextAttributes -> (Ptr TextAttributes -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TextAttributes
s ((Ptr TextAttributes -> IO Int32) -> IO Int32)
-> (Ptr TextAttributes -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr TextAttributes
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr TextAttributes
ptr Ptr TextAttributes -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@end_index@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' textAttributes [ #endIndex 'Data.GI.Base.Attributes.:=' value ]
-- @
setTextAttributesEndIndex :: MonadIO m => TextAttributes -> Int32 -> m ()
setTextAttributesEndIndex :: TextAttributes -> Int32 -> m ()
setTextAttributesEndIndex s :: TextAttributes
s val :: Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TextAttributes -> (Ptr TextAttributes -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TextAttributes
s ((Ptr TextAttributes -> IO ()) -> IO ())
-> (Ptr TextAttributes -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr TextAttributes
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TextAttributes
ptr Ptr TextAttributes -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data TextAttributesEndIndexFieldInfo
instance AttrInfo TextAttributesEndIndexFieldInfo where
    type AttrBaseTypeConstraint TextAttributesEndIndexFieldInfo = (~) TextAttributes
    type AttrAllowedOps TextAttributesEndIndexFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TextAttributesEndIndexFieldInfo = (~) Int32
    type AttrTransferTypeConstraint TextAttributesEndIndexFieldInfo = (~)Int32
    type AttrTransferType TextAttributesEndIndexFieldInfo = Int32
    type AttrGetType TextAttributesEndIndexFieldInfo = Int32
    type AttrLabel TextAttributesEndIndexFieldInfo = "end_index"
    type AttrOrigin TextAttributesEndIndexFieldInfo = TextAttributes
    attrGet = getTextAttributesEndIndex
    attrSet = setTextAttributesEndIndex
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

textAttributes_endIndex :: AttrLabelProxy "endIndex"
textAttributes_endIndex = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TextAttributes
type instance O.AttributeList TextAttributes = TextAttributesAttributeList
type TextAttributesAttributeList = ('[ '("fontName", TextAttributesFontNameFieldInfo), '("fontSize", TextAttributesFontSizeFieldInfo), '("isUnderlined", TextAttributesIsUnderlinedFieldInfo), '("color", TextAttributesColorFieldInfo), '("startIndex", TextAttributesStartIndexFieldInfo), '("endIndex", TextAttributesEndIndexFieldInfo)] :: [(Symbol, *)])
#endif

-- method TextAttributes::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Poppler" , name = "TextAttributes" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_text_attributes_new" poppler_text_attributes_new :: 
    IO (Ptr TextAttributes)

-- | Creates a new t'GI.Poppler.Structs.TextAttributes.TextAttributes'
-- 
-- /Since: 0.18/
textAttributesNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m TextAttributes
    -- ^ __Returns:__ a new t'GI.Poppler.Structs.TextAttributes.TextAttributes', use 'GI.Poppler.Structs.TextAttributes.textAttributesFree' to free it
textAttributesNew :: m TextAttributes
textAttributesNew  = IO TextAttributes -> m TextAttributes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextAttributes -> m TextAttributes)
-> IO TextAttributes -> m TextAttributes
forall a b. (a -> b) -> a -> b
$ do
    Ptr TextAttributes
result <- IO (Ptr TextAttributes)
poppler_text_attributes_new
    Text -> Ptr TextAttributes -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "textAttributesNew" Ptr TextAttributes
result
    TextAttributes
result' <- ((ManagedPtr TextAttributes -> TextAttributes)
-> Ptr TextAttributes -> IO TextAttributes
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TextAttributes -> TextAttributes
TextAttributes) Ptr TextAttributes
result
    TextAttributes -> IO TextAttributes
forall (m :: * -> *) a. Monad m => a -> m a
return TextAttributes
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "poppler_text_attributes_copy" poppler_text_attributes_copy :: 
    Ptr TextAttributes ->                   -- text_attrs : TInterface (Name {namespace = "Poppler", name = "TextAttributes"})
    IO (Ptr TextAttributes)

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

#if defined(ENABLE_OVERLOADING)
data TextAttributesCopyMethodInfo
instance (signature ~ (m TextAttributes), MonadIO m) => O.MethodInfo TextAttributesCopyMethodInfo TextAttributes signature where
    overloadedMethod = textAttributesCopy

#endif

-- method TextAttributes::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "text_attrs"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "TextAttributes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerTextAttributes"
--                 , 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_attributes_free" poppler_text_attributes_free :: 
    Ptr TextAttributes ->                   -- text_attrs : TInterface (Name {namespace = "Poppler", name = "TextAttributes"})
    IO ()

-- | Frees the given t'GI.Poppler.Structs.TextAttributes.TextAttributes'
-- 
-- /Since: 0.18/
textAttributesFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextAttributes
    -- ^ /@textAttrs@/: a t'GI.Poppler.Structs.TextAttributes.TextAttributes'
    -> m ()
textAttributesFree :: TextAttributes -> m ()
textAttributesFree textAttrs :: TextAttributes
textAttrs = 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 TextAttributes
textAttrs' <- TextAttributes -> IO (Ptr TextAttributes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TextAttributes
textAttrs
    Ptr TextAttributes -> IO ()
poppler_text_attributes_free Ptr TextAttributes
textAttrs'
    TextAttributes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TextAttributes
textAttrs
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TextAttributesFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo TextAttributesFreeMethodInfo TextAttributes signature where
    overloadedMethod = textAttributesFree

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTextAttributesMethod (t :: Symbol) (o :: *) :: * where
    ResolveTextAttributesMethod "copy" o = TextAttributesCopyMethodInfo
    ResolveTextAttributesMethod "free" o = TextAttributesFreeMethodInfo
    ResolveTextAttributesMethod l o = O.MethodResolutionFailed l o

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

#endif