{-# 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.Item.Item' structure stores information about a segment of text.

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

module GI.Pango.Structs.Item
    ( 

-- * Exported types
    Item(..)                                ,
    newZeroItem                             ,
    noItem                                  ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveItemMethod                       ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    ItemCopyMethodInfo                      ,
#endif
    itemCopy                                ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    ItemFreeMethodInfo                      ,
#endif
    itemFree                                ,


-- ** new #method:new#

    itemNew                                 ,


-- ** split #method:split#

#if defined(ENABLE_OVERLOADING)
    ItemSplitMethodInfo                     ,
#endif
    itemSplit                               ,




 -- * Properties
-- ** analysis #attr:analysis#
-- | analysis results for the item.

    getItemAnalysis                         ,
#if defined(ENABLE_OVERLOADING)
    item_analysis                           ,
#endif


-- ** length #attr:length#
-- | length of this item in bytes.

    getItemLength                           ,
#if defined(ENABLE_OVERLOADING)
    item_length                             ,
#endif
    setItemLength                           ,


-- ** numChars #attr:numChars#
-- | number of Unicode characters in the item.

    getItemNumChars                         ,
#if defined(ENABLE_OVERLOADING)
    item_numChars                           ,
#endif
    setItemNumChars                         ,


-- ** offset #attr:offset#
-- | byte offset of the start of this item in text.

    getItemOffset                           ,
#if defined(ENABLE_OVERLOADING)
    item_offset                             ,
#endif
    setItemOffset                           ,




    ) 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.Pango.Structs.Analysis as Pango.Analysis

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

instance BoxedObject Item where
    boxedType :: Item -> IO GType
boxedType _ = IO GType
c_pango_item_get_type

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

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

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


-- | A convenience alias for `Nothing` :: `Maybe` `Item`.
noItem :: Maybe Item
noItem :: Maybe Item
noItem = Maybe Item
forall a. Maybe a
Nothing

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

-- | Set the value of the “@offset@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' item [ #offset 'Data.GI.Base.Attributes.:=' value ]
-- @
setItemOffset :: MonadIO m => Item -> Int32 -> m ()
setItemOffset :: Item -> Int32 -> m ()
setItemOffset s :: Item
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
$ Item -> (Ptr Item -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Item
s ((Ptr Item -> IO ()) -> IO ()) -> (Ptr Item -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Item
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Item
ptr Ptr Item -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data ItemOffsetFieldInfo
instance AttrInfo ItemOffsetFieldInfo where
    type AttrBaseTypeConstraint ItemOffsetFieldInfo = (~) Item
    type AttrAllowedOps ItemOffsetFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ItemOffsetFieldInfo = (~) Int32
    type AttrTransferTypeConstraint ItemOffsetFieldInfo = (~)Int32
    type AttrTransferType ItemOffsetFieldInfo = Int32
    type AttrGetType ItemOffsetFieldInfo = Int32
    type AttrLabel ItemOffsetFieldInfo = "offset"
    type AttrOrigin ItemOffsetFieldInfo = Item
    attrGet = getItemOffset
    attrSet = setItemOffset
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

item_offset :: AttrLabelProxy "offset"
item_offset = AttrLabelProxy

#endif


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

-- | Set the value of the “@length@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' item [ #length 'Data.GI.Base.Attributes.:=' value ]
-- @
setItemLength :: MonadIO m => Item -> Int32 -> m ()
setItemLength :: Item -> Int32 -> m ()
setItemLength s :: Item
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
$ Item -> (Ptr Item -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Item
s ((Ptr Item -> IO ()) -> IO ()) -> (Ptr Item -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Item
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Item
ptr Ptr Item -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data ItemLengthFieldInfo
instance AttrInfo ItemLengthFieldInfo where
    type AttrBaseTypeConstraint ItemLengthFieldInfo = (~) Item
    type AttrAllowedOps ItemLengthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ItemLengthFieldInfo = (~) Int32
    type AttrTransferTypeConstraint ItemLengthFieldInfo = (~)Int32
    type AttrTransferType ItemLengthFieldInfo = Int32
    type AttrGetType ItemLengthFieldInfo = Int32
    type AttrLabel ItemLengthFieldInfo = "length"
    type AttrOrigin ItemLengthFieldInfo = Item
    attrGet = getItemLength
    attrSet = setItemLength
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

item_length :: AttrLabelProxy "length"
item_length = AttrLabelProxy

#endif


-- | Get the value of the “@num_chars@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' item #numChars
-- @
getItemNumChars :: MonadIO m => Item -> m Int32
getItemNumChars :: Item -> m Int32
getItemNumChars s :: Item
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
$ Item -> (Ptr Item -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Item
s ((Ptr Item -> IO Int32) -> IO Int32)
-> (Ptr Item -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Item
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr Item
ptr Ptr Item -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) :: IO Int32
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
val

-- | Set the value of the “@num_chars@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' item [ #numChars 'Data.GI.Base.Attributes.:=' value ]
-- @
setItemNumChars :: MonadIO m => Item -> Int32 -> m ()
setItemNumChars :: Item -> Int32 -> m ()
setItemNumChars s :: Item
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
$ Item -> (Ptr Item -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Item
s ((Ptr Item -> IO ()) -> IO ()) -> (Ptr Item -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Item
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Item
ptr Ptr Item -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data ItemNumCharsFieldInfo
instance AttrInfo ItemNumCharsFieldInfo where
    type AttrBaseTypeConstraint ItemNumCharsFieldInfo = (~) Item
    type AttrAllowedOps ItemNumCharsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ItemNumCharsFieldInfo = (~) Int32
    type AttrTransferTypeConstraint ItemNumCharsFieldInfo = (~)Int32
    type AttrTransferType ItemNumCharsFieldInfo = Int32
    type AttrGetType ItemNumCharsFieldInfo = Int32
    type AttrLabel ItemNumCharsFieldInfo = "num_chars"
    type AttrOrigin ItemNumCharsFieldInfo = Item
    attrGet = getItemNumChars
    attrSet = setItemNumChars
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

item_numChars :: AttrLabelProxy "numChars"
item_numChars = AttrLabelProxy

#endif


-- | Get the value of the “@analysis@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' item #analysis
-- @
getItemAnalysis :: MonadIO m => Item -> m Pango.Analysis.Analysis
getItemAnalysis :: Item -> m Analysis
getItemAnalysis s :: Item
s = IO Analysis -> m Analysis
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Analysis -> m Analysis) -> IO Analysis -> m Analysis
forall a b. (a -> b) -> a -> b
$ Item -> (Ptr Item -> IO Analysis) -> IO Analysis
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr Item
s ((Ptr Item -> IO Analysis) -> IO Analysis)
-> (Ptr Item -> IO Analysis) -> IO Analysis
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Item
ptr -> do
    let val :: Ptr Analysis
val = Ptr Item
ptr Ptr Item -> Int -> Ptr Analysis
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: (Ptr Pango.Analysis.Analysis)
    Analysis
val' <- ((ManagedPtr Analysis -> Analysis) -> Ptr Analysis -> IO Analysis
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Analysis -> Analysis
Pango.Analysis.Analysis) Ptr Analysis
val
    Analysis -> IO Analysis
forall (m :: * -> *) a. Monad m => a -> m a
return Analysis
val'

#if defined(ENABLE_OVERLOADING)
data ItemAnalysisFieldInfo
instance AttrInfo ItemAnalysisFieldInfo where
    type AttrBaseTypeConstraint ItemAnalysisFieldInfo = (~) Item
    type AttrAllowedOps ItemAnalysisFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ItemAnalysisFieldInfo = (~) (Ptr Pango.Analysis.Analysis)
    type AttrTransferTypeConstraint ItemAnalysisFieldInfo = (~)(Ptr Pango.Analysis.Analysis)
    type AttrTransferType ItemAnalysisFieldInfo = (Ptr Pango.Analysis.Analysis)
    type AttrGetType ItemAnalysisFieldInfo = Pango.Analysis.Analysis
    type AttrLabel ItemAnalysisFieldInfo = "analysis"
    type AttrOrigin ItemAnalysisFieldInfo = Item
    attrGet = getItemAnalysis
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined

item_analysis :: AttrLabelProxy "analysis"
item_analysis = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Item
type instance O.AttributeList Item = ItemAttributeList
type ItemAttributeList = ('[ '("offset", ItemOffsetFieldInfo), '("length", ItemLengthFieldInfo), '("numChars", ItemNumCharsFieldInfo), '("analysis", ItemAnalysisFieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "pango_item_new" pango_item_new :: 
    IO (Ptr Item)

-- | Creates a new t'GI.Pango.Structs.Item.Item' structure initialized to default values.
itemNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Item
    -- ^ __Returns:__ the newly allocated t'GI.Pango.Structs.Item.Item', which should
    --               be freed with 'GI.Pango.Structs.Item.itemFree'.
itemNew :: m Item
itemNew  = IO Item -> m Item
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Item -> m Item) -> IO Item -> m Item
forall a b. (a -> b) -> a -> b
$ do
    Ptr Item
result <- IO (Ptr Item)
pango_item_new
    Text -> Ptr Item -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "itemNew" Ptr Item
result
    Item
result' <- ((ManagedPtr Item -> Item) -> Ptr Item -> IO Item
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Item -> Item
Item) Ptr Item
result
    Item -> IO Item
forall (m :: * -> *) a. Monad m => a -> m a
return Item
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "pango_item_copy" pango_item_copy :: 
    Ptr Item ->                             -- item : TInterface (Name {namespace = "Pango", name = "Item"})
    IO (Ptr Item)

-- | Copy an existing t'GI.Pango.Structs.Item.Item' structure.
itemCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Item
    -- ^ /@item@/: a t'GI.Pango.Structs.Item.Item', may be 'P.Nothing'
    -> m (Maybe Item)
    -- ^ __Returns:__ the newly allocated t'GI.Pango.Structs.Item.Item', which
    --               should be freed with 'GI.Pango.Structs.Item.itemFree', or 'P.Nothing' if
    --               /@item@/ was 'P.Nothing'.
itemCopy :: Item -> m (Maybe Item)
itemCopy item :: Item
item = IO (Maybe Item) -> m (Maybe Item)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Item) -> m (Maybe Item))
-> IO (Maybe Item) -> m (Maybe Item)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Item
item' <- Item -> IO (Ptr Item)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Item
item
    Ptr Item
result <- Ptr Item -> IO (Ptr Item)
pango_item_copy Ptr Item
item'
    Maybe Item
maybeResult <- Ptr Item -> (Ptr Item -> IO Item) -> IO (Maybe Item)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Item
result ((Ptr Item -> IO Item) -> IO (Maybe Item))
-> (Ptr Item -> IO Item) -> IO (Maybe Item)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Item
result' -> do
        Item
result'' <- ((ManagedPtr Item -> Item) -> Ptr Item -> IO Item
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Item -> Item
Item) Ptr Item
result'
        Item -> IO Item
forall (m :: * -> *) a. Monad m => a -> m a
return Item
result''
    Item -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Item
item
    Maybe Item -> IO (Maybe Item)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Item
maybeResult

#if defined(ENABLE_OVERLOADING)
data ItemCopyMethodInfo
instance (signature ~ (m (Maybe Item)), MonadIO m) => O.MethodInfo ItemCopyMethodInfo Item signature where
    overloadedMethod = itemCopy

#endif

-- method Item::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "item"
--           , argType = TInterface Name { namespace = "Pango" , name = "Item" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoItem, 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_item_free" pango_item_free :: 
    Ptr Item ->                             -- item : TInterface (Name {namespace = "Pango", name = "Item"})
    IO ()

-- | Free a t'GI.Pango.Structs.Item.Item' and all associated memory.
itemFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Item
    -- ^ /@item@/: a t'GI.Pango.Structs.Item.Item', may be 'P.Nothing'
    -> m ()
itemFree :: Item -> m ()
itemFree item :: Item
item = 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 Item
item' <- Item -> IO (Ptr Item)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Item
item
    Ptr Item -> IO ()
pango_item_free Ptr Item
item'
    Item -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Item
item
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ItemFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo ItemFreeMethodInfo Item signature where
    overloadedMethod = itemFree

#endif

-- method Item::split
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "orig"
--           , argType = TInterface Name { namespace = "Pango" , name = "Item" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoItem" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "split_index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "byte index of position to split item, relative to the start of the item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "split_offset"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "number of chars between start of @orig and @split_index"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Item" })
-- throws : False
-- Skip return : False

foreign import ccall "pango_item_split" pango_item_split :: 
    Ptr Item ->                             -- orig : TInterface (Name {namespace = "Pango", name = "Item"})
    Int32 ->                                -- split_index : TBasicType TInt
    Int32 ->                                -- split_offset : TBasicType TInt
    IO (Ptr Item)

-- | Modifies /@orig@/ to cover only the text after /@splitIndex@/, and
-- returns a new item that covers the text before /@splitIndex@/ that
-- used to be in /@orig@/. You can think of /@splitIndex@/ as the length of
-- the returned item. /@splitIndex@/ may not be 0, and it may not be
-- greater than or equal to the length of /@orig@/ (that is, there must
-- be at least one byte assigned to each item, you can\'t create a
-- zero-length item). /@splitOffset@/ is the length of the first item in
-- chars, and must be provided because the text used to generate the
-- item isn\'t available, so 'GI.Pango.Structs.Item.itemSplit' can\'t count the char
-- length of the split items itself.
itemSplit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Item
    -- ^ /@orig@/: a t'GI.Pango.Structs.Item.Item'
    -> Int32
    -- ^ /@splitIndex@/: byte index of position to split item, relative to the start of the item
    -> Int32
    -- ^ /@splitOffset@/: number of chars between start of /@orig@/ and /@splitIndex@/
    -> m Item
    -- ^ __Returns:__ new item representing text before /@splitIndex@/, which
    --               should be freed with 'GI.Pango.Structs.Item.itemFree'.
itemSplit :: Item -> Int32 -> Int32 -> m Item
itemSplit orig :: Item
orig splitIndex :: Int32
splitIndex splitOffset :: Int32
splitOffset = IO Item -> m Item
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Item -> m Item) -> IO Item -> m Item
forall a b. (a -> b) -> a -> b
$ do
    Ptr Item
orig' <- Item -> IO (Ptr Item)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Item
orig
    Ptr Item
result <- Ptr Item -> Int32 -> Int32 -> IO (Ptr Item)
pango_item_split Ptr Item
orig' Int32
splitIndex Int32
splitOffset
    Text -> Ptr Item -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "itemSplit" Ptr Item
result
    Item
result' <- ((ManagedPtr Item -> Item) -> Ptr Item -> IO Item
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Item -> Item
Item) Ptr Item
result
    Item -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Item
orig
    Item -> IO Item
forall (m :: * -> *) a. Monad m => a -> m a
return Item
result'

#if defined(ENABLE_OVERLOADING)
data ItemSplitMethodInfo
instance (signature ~ (Int32 -> Int32 -> m Item), MonadIO m) => O.MethodInfo ItemSplitMethodInfo Item signature where
    overloadedMethod = itemSplit

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveItemMethod (t :: Symbol) (o :: *) :: * where
    ResolveItemMethod "copy" o = ItemCopyMethodInfo
    ResolveItemMethod "free" o = ItemFreeMethodInfo
    ResolveItemMethod "split" o = ItemSplitMethodInfo
    ResolveItemMethod l o = O.MethodResolutionFailed l o

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

#endif