{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Pango.Structs.AttrList.AttrList' structure represents a list of attributes
-- that apply to a section of text. The attributes are, in general,
-- allowed to overlap in an arbitrary fashion, however, if the
-- attributes are manipulated only through 'GI.Pango.Structs.AttrList.attrListChange',
-- the overlap between properties will meet stricter criteria.
-- 
-- Since the t'GI.Pango.Structs.AttrList.AttrList' structure is stored as a linear list,
-- it is not suitable for storing attributes for large amounts
-- of text. In general, you should not use a single t'GI.Pango.Structs.AttrList.AttrList'
-- for more than one paragraph of text.

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

module GI.Pango.Structs.AttrList
    ( 

-- * Exported types
    AttrList(..)                            ,
    noAttrList                              ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAttrListMethod                   ,
#endif


-- ** change #method:change#

#if defined(ENABLE_OVERLOADING)
    AttrListChangeMethodInfo                ,
#endif
    attrListChange                          ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    AttrListCopyMethodInfo                  ,
#endif
    attrListCopy                            ,


-- ** filter #method:filter#

#if defined(ENABLE_OVERLOADING)
    AttrListFilterMethodInfo                ,
#endif
    attrListFilter                          ,


-- ** insert #method:insert#

#if defined(ENABLE_OVERLOADING)
    AttrListInsertMethodInfo                ,
#endif
    attrListInsert                          ,


-- ** insertBefore #method:insertBefore#

#if defined(ENABLE_OVERLOADING)
    AttrListInsertBeforeMethodInfo          ,
#endif
    attrListInsertBefore                    ,


-- ** new #method:new#

    attrListNew                             ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    AttrListRefMethodInfo                   ,
#endif
    attrListRef                             ,


-- ** splice #method:splice#

#if defined(ENABLE_OVERLOADING)
    AttrListSpliceMethodInfo                ,
#endif
    attrListSplice                          ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    AttrListUnrefMethodInfo                 ,
#endif
    attrListUnref                           ,




    ) 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 qualified GI.Pango.Callbacks as Pango.Callbacks
import {-# SOURCE #-} qualified GI.Pango.Structs.Attribute as Pango.Attribute

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

instance BoxedObject AttrList where
    boxedType :: AttrList -> IO GType
boxedType _ = IO GType
c_pango_attr_list_get_type

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

-- | A convenience alias for `Nothing` :: `Maybe` `AttrList`.
noAttrList :: Maybe AttrList
noAttrList :: Maybe AttrList
noAttrList = Maybe AttrList
forall a. Maybe a
Nothing


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

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

foreign import ccall "pango_attr_list_new" pango_attr_list_new :: 
    IO (Ptr AttrList)

-- | Create a new empty attribute list with a reference count of one.
attrListNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m AttrList
    -- ^ __Returns:__ the newly allocated t'GI.Pango.Structs.AttrList.AttrList',
    --               which should be freed with 'GI.Pango.Structs.AttrList.attrListUnref'.
attrListNew :: m AttrList
attrListNew  = IO AttrList -> m AttrList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AttrList -> m AttrList) -> IO AttrList -> m AttrList
forall a b. (a -> b) -> a -> b
$ do
    Ptr AttrList
result <- IO (Ptr AttrList)
pango_attr_list_new
    Text -> Ptr AttrList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "attrListNew" Ptr AttrList
result
    AttrList
result' <- ((ManagedPtr AttrList -> AttrList) -> Ptr AttrList -> IO AttrList
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AttrList -> AttrList
AttrList) Ptr AttrList
result
    AttrList -> IO AttrList
forall (m :: * -> *) a. Monad m => a -> m a
return AttrList
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method AttrList::change
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoAttrList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attr"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Attribute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the attribute to insert. Ownership of this\n       value is assumed by the list."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_attr_list_change" pango_attr_list_change :: 
    Ptr AttrList ->                         -- list : TInterface (Name {namespace = "Pango", name = "AttrList"})
    Ptr Pango.Attribute.Attribute ->        -- attr : TInterface (Name {namespace = "Pango", name = "Attribute"})
    IO ()

-- | Insert the given attribute into the t'GI.Pango.Structs.AttrList.AttrList'. It will
-- replace any attributes of the same type on that segment
-- and be merged with any adjoining attributes that are identical.
-- 
-- This function is slower than 'GI.Pango.Structs.AttrList.attrListInsert' for
-- creating a attribute list in order (potentially much slower
-- for large lists). However, 'GI.Pango.Structs.AttrList.attrListInsert' is not
-- suitable for continually changing a set of attributes
-- since it never removes or combines existing attributes.
attrListChange ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AttrList
    -- ^ /@list@/: a t'GI.Pango.Structs.AttrList.AttrList'
    -> Pango.Attribute.Attribute
    -- ^ /@attr@/: the attribute to insert. Ownership of this
    --        value is assumed by the list.
    -> m ()
attrListChange :: AttrList -> Attribute -> m ()
attrListChange list :: AttrList
list attr :: Attribute
attr = 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 AttrList
list' <- AttrList -> IO (Ptr AttrList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttrList
list
    Ptr Attribute
attr' <- Attribute -> IO (Ptr Attribute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Attribute
attr
    Ptr AttrList -> Ptr Attribute -> IO ()
pango_attr_list_change Ptr AttrList
list' Ptr Attribute
attr'
    AttrList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AttrList
list
    Attribute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Attribute
attr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AttrListChangeMethodInfo
instance (signature ~ (Pango.Attribute.Attribute -> m ()), MonadIO m) => O.MethodInfo AttrListChangeMethodInfo AttrList signature where
    overloadedMethod = attrListChange

#endif

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

foreign import ccall "pango_attr_list_copy" pango_attr_list_copy :: 
    Ptr AttrList ->                         -- list : TInterface (Name {namespace = "Pango", name = "AttrList"})
    IO (Ptr AttrList)

-- | Copy /@list@/ and return an identical new list.
attrListCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AttrList
    -- ^ /@list@/: a t'GI.Pango.Structs.AttrList.AttrList', may be 'P.Nothing'
    -> m (Maybe AttrList)
    -- ^ __Returns:__ the newly allocated t'GI.Pango.Structs.AttrList.AttrList', with a
    --               reference count of one, which should
    --               be freed with 'GI.Pango.Structs.AttrList.attrListUnref'.
    --               Returns 'P.Nothing' if /@list@/ was 'P.Nothing'.
attrListCopy :: AttrList -> m (Maybe AttrList)
attrListCopy list :: AttrList
list = IO (Maybe AttrList) -> m (Maybe AttrList)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe AttrList) -> m (Maybe AttrList))
-> IO (Maybe AttrList) -> m (Maybe AttrList)
forall a b. (a -> b) -> a -> b
$ do
    Ptr AttrList
list' <- AttrList -> IO (Ptr AttrList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttrList
list
    Ptr AttrList
result <- Ptr AttrList -> IO (Ptr AttrList)
pango_attr_list_copy Ptr AttrList
list'
    Maybe AttrList
maybeResult <- Ptr AttrList
-> (Ptr AttrList -> IO AttrList) -> IO (Maybe AttrList)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr AttrList
result ((Ptr AttrList -> IO AttrList) -> IO (Maybe AttrList))
-> (Ptr AttrList -> IO AttrList) -> IO (Maybe AttrList)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr AttrList
result' -> do
        AttrList
result'' <- ((ManagedPtr AttrList -> AttrList) -> Ptr AttrList -> IO AttrList
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AttrList -> AttrList
AttrList) Ptr AttrList
result'
        AttrList -> IO AttrList
forall (m :: * -> *) a. Monad m => a -> m a
return AttrList
result''
    AttrList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AttrList
list
    Maybe AttrList -> IO (Maybe AttrList)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AttrList
maybeResult

#if defined(ENABLE_OVERLOADING)
data AttrListCopyMethodInfo
instance (signature ~ (m (Maybe AttrList)), MonadIO m) => O.MethodInfo AttrListCopyMethodInfo AttrList signature where
    overloadedMethod = attrListCopy

#endif

-- method AttrList::filter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoAttrList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "AttrFilterFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "callback function; returns %TRUE\n       if an attribute should be filtered out."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Data to be passed to @func"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "AttrList" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_attr_list_filter" pango_attr_list_filter :: 
    Ptr AttrList ->                         -- list : TInterface (Name {namespace = "Pango", name = "AttrList"})
    FunPtr Pango.Callbacks.C_AttrFilterFunc -> -- func : TInterface (Name {namespace = "Pango", name = "AttrFilterFunc"})
    Ptr () ->                               -- data : TBasicType TPtr
    IO (Ptr AttrList)

-- | Given a t'GI.Pango.Structs.AttrList.AttrList' and callback function, removes any elements
-- of /@list@/ for which /@func@/ returns 'P.True' and inserts them into
-- a new list.
-- 
-- /Since: 1.2/
attrListFilter ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AttrList
    -- ^ /@list@/: a t'GI.Pango.Structs.AttrList.AttrList'
    -> Pango.Callbacks.AttrFilterFunc
    -- ^ /@func@/: callback function; returns 'P.True'
    --        if an attribute should be filtered out.
    -> m (Maybe AttrList)
    -- ^ __Returns:__ the new t'GI.Pango.Structs.AttrList.AttrList' or
    --  'P.Nothing' if no attributes of the given types were found.
attrListFilter :: AttrList -> AttrFilterFunc -> m (Maybe AttrList)
attrListFilter list :: AttrList
list func :: AttrFilterFunc
func = IO (Maybe AttrList) -> m (Maybe AttrList)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe AttrList) -> m (Maybe AttrList))
-> IO (Maybe AttrList) -> m (Maybe AttrList)
forall a b. (a -> b) -> a -> b
$ do
    Ptr AttrList
list' <- AttrList -> IO (Ptr AttrList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttrList
list
    FunPtr C_AttrFilterFunc
func' <- C_AttrFilterFunc -> IO (FunPtr C_AttrFilterFunc)
Pango.Callbacks.mk_AttrFilterFunc (Maybe (Ptr (FunPtr C_AttrFilterFunc))
-> AttrFilterFunc_WithClosures -> C_AttrFilterFunc
Pango.Callbacks.wrap_AttrFilterFunc Maybe (Ptr (FunPtr C_AttrFilterFunc))
forall a. Maybe a
Nothing (AttrFilterFunc -> AttrFilterFunc_WithClosures
Pango.Callbacks.drop_closures_AttrFilterFunc AttrFilterFunc
func))
    let data_ :: Ptr a
data_ = Ptr a
forall a. Ptr a
nullPtr
    Ptr AttrList
result <- Ptr AttrList
-> FunPtr C_AttrFilterFunc -> Ptr () -> IO (Ptr AttrList)
pango_attr_list_filter Ptr AttrList
list' FunPtr C_AttrFilterFunc
func' Ptr ()
forall a. Ptr a
data_
    Maybe AttrList
maybeResult <- Ptr AttrList
-> (Ptr AttrList -> IO AttrList) -> IO (Maybe AttrList)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr AttrList
result ((Ptr AttrList -> IO AttrList) -> IO (Maybe AttrList))
-> (Ptr AttrList -> IO AttrList) -> IO (Maybe AttrList)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr AttrList
result' -> do
        AttrList
result'' <- ((ManagedPtr AttrList -> AttrList) -> Ptr AttrList -> IO AttrList
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AttrList -> AttrList
AttrList) Ptr AttrList
result'
        AttrList -> IO AttrList
forall (m :: * -> *) a. Monad m => a -> m a
return AttrList
result''
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_AttrFilterFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_AttrFilterFunc
func'
    AttrList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AttrList
list
    Maybe AttrList -> IO (Maybe AttrList)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AttrList
maybeResult

#if defined(ENABLE_OVERLOADING)
data AttrListFilterMethodInfo
instance (signature ~ (Pango.Callbacks.AttrFilterFunc -> m (Maybe AttrList)), MonadIO m) => O.MethodInfo AttrListFilterMethodInfo AttrList signature where
    overloadedMethod = attrListFilter

#endif

-- method AttrList::insert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoAttrList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attr"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Attribute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the attribute to insert. Ownership of this\n       value is assumed by the list."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_attr_list_insert" pango_attr_list_insert :: 
    Ptr AttrList ->                         -- list : TInterface (Name {namespace = "Pango", name = "AttrList"})
    Ptr Pango.Attribute.Attribute ->        -- attr : TInterface (Name {namespace = "Pango", name = "Attribute"})
    IO ()

-- | Insert the given attribute into the t'GI.Pango.Structs.AttrList.AttrList'. It will
-- be inserted after all other attributes with a matching
-- /@startIndex@/.
attrListInsert ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AttrList
    -- ^ /@list@/: a t'GI.Pango.Structs.AttrList.AttrList'
    -> Pango.Attribute.Attribute
    -- ^ /@attr@/: the attribute to insert. Ownership of this
    --        value is assumed by the list.
    -> m ()
attrListInsert :: AttrList -> Attribute -> m ()
attrListInsert list :: AttrList
list attr :: Attribute
attr = 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 AttrList
list' <- AttrList -> IO (Ptr AttrList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttrList
list
    Ptr Attribute
attr' <- Attribute -> IO (Ptr Attribute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Attribute
attr
    Ptr AttrList -> Ptr Attribute -> IO ()
pango_attr_list_insert Ptr AttrList
list' Ptr Attribute
attr'
    AttrList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AttrList
list
    Attribute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Attribute
attr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AttrListInsertMethodInfo
instance (signature ~ (Pango.Attribute.Attribute -> m ()), MonadIO m) => O.MethodInfo AttrListInsertMethodInfo AttrList signature where
    overloadedMethod = attrListInsert

#endif

-- method AttrList::insert_before
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoAttrList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attr"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "Attribute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the attribute to insert. Ownership of this\n       value is assumed by the list."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_attr_list_insert_before" pango_attr_list_insert_before :: 
    Ptr AttrList ->                         -- list : TInterface (Name {namespace = "Pango", name = "AttrList"})
    Ptr Pango.Attribute.Attribute ->        -- attr : TInterface (Name {namespace = "Pango", name = "Attribute"})
    IO ()

-- | Insert the given attribute into the t'GI.Pango.Structs.AttrList.AttrList'. It will
-- be inserted before all other attributes with a matching
-- /@startIndex@/.
attrListInsertBefore ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AttrList
    -- ^ /@list@/: a t'GI.Pango.Structs.AttrList.AttrList'
    -> Pango.Attribute.Attribute
    -- ^ /@attr@/: the attribute to insert. Ownership of this
    --        value is assumed by the list.
    -> m ()
attrListInsertBefore :: AttrList -> Attribute -> m ()
attrListInsertBefore list :: AttrList
list attr :: Attribute
attr = 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 AttrList
list' <- AttrList -> IO (Ptr AttrList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttrList
list
    Ptr Attribute
attr' <- Attribute -> IO (Ptr Attribute)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Attribute
attr
    Ptr AttrList -> Ptr Attribute -> IO ()
pango_attr_list_insert_before Ptr AttrList
list' Ptr Attribute
attr'
    AttrList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AttrList
list
    Attribute -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Attribute
attr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AttrListInsertBeforeMethodInfo
instance (signature ~ (Pango.Attribute.Attribute -> m ()), MonadIO m) => O.MethodInfo AttrListInsertBeforeMethodInfo AttrList signature where
    overloadedMethod = attrListInsertBefore

#endif

-- method AttrList::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoAttrList, may be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "AttrList" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_attr_list_ref" pango_attr_list_ref :: 
    Ptr AttrList ->                         -- list : TInterface (Name {namespace = "Pango", name = "AttrList"})
    IO (Ptr AttrList)

-- | Increase the reference count of the given attribute list by one.
-- 
-- /Since: 1.10/
attrListRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AttrList
    -- ^ /@list@/: a t'GI.Pango.Structs.AttrList.AttrList', may be 'P.Nothing'
    -> m AttrList
    -- ^ __Returns:__ The attribute list passed in
attrListRef :: AttrList -> m AttrList
attrListRef list :: AttrList
list = IO AttrList -> m AttrList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AttrList -> m AttrList) -> IO AttrList -> m AttrList
forall a b. (a -> b) -> a -> b
$ do
    Ptr AttrList
list' <- AttrList -> IO (Ptr AttrList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttrList
list
    Ptr AttrList
result <- Ptr AttrList -> IO (Ptr AttrList)
pango_attr_list_ref Ptr AttrList
list'
    Text -> Ptr AttrList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "attrListRef" Ptr AttrList
result
    AttrList
result' <- ((ManagedPtr AttrList -> AttrList) -> Ptr AttrList -> IO AttrList
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AttrList -> AttrList
AttrList) Ptr AttrList
result
    AttrList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AttrList
list
    AttrList -> IO AttrList
forall (m :: * -> *) a. Monad m => a -> m a
return AttrList
result'

#if defined(ENABLE_OVERLOADING)
data AttrListRefMethodInfo
instance (signature ~ (m AttrList), MonadIO m) => O.MethodInfo AttrListRefMethodInfo AttrList signature where
    overloadedMethod = attrListRef

#endif

-- method AttrList::splice
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoAttrList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another #PangoAttrList"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pos"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the position in @list at which to insert @other"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the length of the spliced segment. (Note that this\n      must be specified since the attributes in @other\n      may only be present at some subsection of this range)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_attr_list_splice" pango_attr_list_splice :: 
    Ptr AttrList ->                         -- list : TInterface (Name {namespace = "Pango", name = "AttrList"})
    Ptr AttrList ->                         -- other : TInterface (Name {namespace = "Pango", name = "AttrList"})
    Int32 ->                                -- pos : TBasicType TInt
    Int32 ->                                -- len : TBasicType TInt
    IO ()

-- | This function opens up a hole in /@list@/, fills it in with attributes from
-- the left, and then merges /@other@/ on top of the hole.
-- 
-- This operation is equivalent to stretching every attribute
-- that applies at position /@pos@/ in /@list@/ by an amount /@len@/,
-- and then calling 'GI.Pango.Structs.AttrList.attrListChange' with a copy
-- of each attribute in /@other@/ in sequence (offset in position by /@pos@/).
-- 
-- This operation proves useful for, for instance, inserting
-- a pre-edit string in the middle of an edit buffer.
attrListSplice ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AttrList
    -- ^ /@list@/: a t'GI.Pango.Structs.AttrList.AttrList'
    -> AttrList
    -- ^ /@other@/: another t'GI.Pango.Structs.AttrList.AttrList'
    -> Int32
    -- ^ /@pos@/: the position in /@list@/ at which to insert /@other@/
    -> Int32
    -- ^ /@len@/: the length of the spliced segment. (Note that this
    --       must be specified since the attributes in /@other@/
    --       may only be present at some subsection of this range)
    -> m ()
attrListSplice :: AttrList -> AttrList -> Int32 -> Int32 -> m ()
attrListSplice list :: AttrList
list other :: AttrList
other pos :: Int32
pos len :: Int32
len = 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 AttrList
list' <- AttrList -> IO (Ptr AttrList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttrList
list
    Ptr AttrList
other' <- AttrList -> IO (Ptr AttrList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttrList
other
    Ptr AttrList -> Ptr AttrList -> Int32 -> Int32 -> IO ()
pango_attr_list_splice Ptr AttrList
list' Ptr AttrList
other' Int32
pos Int32
len
    AttrList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AttrList
list
    AttrList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AttrList
other
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AttrListSpliceMethodInfo
instance (signature ~ (AttrList -> Int32 -> Int32 -> m ()), MonadIO m) => O.MethodInfo AttrListSpliceMethodInfo AttrList signature where
    overloadedMethod = attrListSplice

#endif

-- method AttrList::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoAttrList, may be %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "pango_attr_list_unref" pango_attr_list_unref :: 
    Ptr AttrList ->                         -- list : TInterface (Name {namespace = "Pango", name = "AttrList"})
    IO ()

-- | Decrease the reference count of the given attribute list by one.
-- If the result is zero, free the attribute list and the attributes
-- it contains.
attrListUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    AttrList
    -- ^ /@list@/: a t'GI.Pango.Structs.AttrList.AttrList', may be 'P.Nothing'
    -> m ()
attrListUnref :: AttrList -> m ()
attrListUnref list :: AttrList
list = 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 AttrList
list' <- AttrList -> IO (Ptr AttrList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr AttrList
list
    Ptr AttrList -> IO ()
pango_attr_list_unref Ptr AttrList
list'
    AttrList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr AttrList
list
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AttrListUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo AttrListUnrefMethodInfo AttrList signature where
    overloadedMethod = attrListUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveAttrListMethod (t :: Symbol) (o :: *) :: * where
    ResolveAttrListMethod "change" o = AttrListChangeMethodInfo
    ResolveAttrListMethod "copy" o = AttrListCopyMethodInfo
    ResolveAttrListMethod "filter" o = AttrListFilterMethodInfo
    ResolveAttrListMethod "insert" o = AttrListInsertMethodInfo
    ResolveAttrListMethod "insertBefore" o = AttrListInsertBeforeMethodInfo
    ResolveAttrListMethod "ref" o = AttrListRefMethodInfo
    ResolveAttrListMethod "splice" o = AttrListSpliceMethodInfo
    ResolveAttrListMethod "unref" o = AttrListUnrefMethodInfo
    ResolveAttrListMethod l o = O.MethodResolutionFailed l o

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

#endif