{-# LANGUAGE TypeApplications #-}


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

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

module GI.Poppler.Objects.AnnotStamp
    ( 

-- * Exported types
    AnnotStamp(..)                          ,
    IsAnnotStamp                            ,
    toAnnotStamp                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAnnotType]("GI.Poppler.Objects.Annot#g:method:getAnnotType"), [getColor]("GI.Poppler.Objects.Annot#g:method:getColor"), [getContents]("GI.Poppler.Objects.Annot#g:method:getContents"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFlags]("GI.Poppler.Objects.Annot#g:method:getFlags"), [getIcon]("GI.Poppler.Objects.AnnotStamp#g:method:getIcon"), [getModified]("GI.Poppler.Objects.Annot#g:method:getModified"), [getName]("GI.Poppler.Objects.Annot#g:method:getName"), [getPageIndex]("GI.Poppler.Objects.Annot#g:method:getPageIndex"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRectangle]("GI.Poppler.Objects.Annot#g:method:getRectangle").
-- 
-- ==== Setters
-- [setColor]("GI.Poppler.Objects.Annot#g:method:setColor"), [setContents]("GI.Poppler.Objects.Annot#g:method:setContents"), [setCustomImage]("GI.Poppler.Objects.AnnotStamp#g:method:setCustomImage"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFlags]("GI.Poppler.Objects.Annot#g:method:setFlags"), [setIcon]("GI.Poppler.Objects.AnnotStamp#g:method:setIcon"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRectangle]("GI.Poppler.Objects.Annot#g:method:setRectangle").

#if defined(ENABLE_OVERLOADING)
    ResolveAnnotStampMethod                 ,
#endif

-- ** getIcon #method:getIcon#

#if defined(ENABLE_OVERLOADING)
    AnnotStampGetIconMethodInfo             ,
#endif
    annotStampGetIcon                       ,


-- ** new #method:new#

    annotStampNew                           ,


-- ** setCustomImage #method:setCustomImage#

#if defined(ENABLE_OVERLOADING)
    AnnotStampSetCustomImageMethodInfo      ,
#endif
    annotStampSetCustomImage                ,


-- ** setIcon #method:setIcon#

#if defined(ENABLE_OVERLOADING)
    AnnotStampSetIconMethodInfo             ,
#endif
    annotStampSetIcon                       ,




    ) where

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

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

import qualified GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums
import {-# SOURCE #-} qualified GI.Poppler.Objects.Annot as Poppler.Annot
import {-# SOURCE #-} qualified GI.Poppler.Objects.Document as Poppler.Document
import {-# SOURCE #-} qualified GI.Poppler.Structs.Rectangle as Poppler.Rectangle

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

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

foreign import ccall "poppler_annot_stamp_get_type"
    c_poppler_annot_stamp_get_type :: IO B.Types.GType

instance B.Types.TypedObject AnnotStamp where
    glibType :: IO GType
glibType = IO GType
c_poppler_annot_stamp_get_type

instance B.Types.GObject AnnotStamp

-- | Type class for types which can be safely cast to `AnnotStamp`, for instance with `toAnnotStamp`.
class (SP.GObject o, O.IsDescendantOf AnnotStamp o) => IsAnnotStamp o
instance (SP.GObject o, O.IsDescendantOf AnnotStamp o) => IsAnnotStamp o

instance O.HasParentTypes AnnotStamp
type instance O.ParentTypes AnnotStamp = '[Poppler.Annot.Annot, GObject.Object.Object]

-- | Cast to `AnnotStamp`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toAnnotStamp :: (MIO.MonadIO m, IsAnnotStamp o) => o -> m AnnotStamp
toAnnotStamp :: forall (m :: * -> *) o.
(MonadIO m, IsAnnotStamp o) =>
o -> m AnnotStamp
toAnnotStamp = IO AnnotStamp -> m AnnotStamp
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO AnnotStamp -> m AnnotStamp)
-> (o -> IO AnnotStamp) -> o -> m AnnotStamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr AnnotStamp -> AnnotStamp) -> o -> IO AnnotStamp
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr AnnotStamp -> AnnotStamp
AnnotStamp

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

#if defined(ENABLE_OVERLOADING)
type family ResolveAnnotStampMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveAnnotStampMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAnnotStampMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAnnotStampMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAnnotStampMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAnnotStampMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAnnotStampMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAnnotStampMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAnnotStampMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAnnotStampMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAnnotStampMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAnnotStampMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAnnotStampMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAnnotStampMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAnnotStampMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAnnotStampMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAnnotStampMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAnnotStampMethod "getAnnotType" o = Poppler.Annot.AnnotGetAnnotTypeMethodInfo
    ResolveAnnotStampMethod "getColor" o = Poppler.Annot.AnnotGetColorMethodInfo
    ResolveAnnotStampMethod "getContents" o = Poppler.Annot.AnnotGetContentsMethodInfo
    ResolveAnnotStampMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAnnotStampMethod "getFlags" o = Poppler.Annot.AnnotGetFlagsMethodInfo
    ResolveAnnotStampMethod "getIcon" o = AnnotStampGetIconMethodInfo
    ResolveAnnotStampMethod "getModified" o = Poppler.Annot.AnnotGetModifiedMethodInfo
    ResolveAnnotStampMethod "getName" o = Poppler.Annot.AnnotGetNameMethodInfo
    ResolveAnnotStampMethod "getPageIndex" o = Poppler.Annot.AnnotGetPageIndexMethodInfo
    ResolveAnnotStampMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAnnotStampMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAnnotStampMethod "getRectangle" o = Poppler.Annot.AnnotGetRectangleMethodInfo
    ResolveAnnotStampMethod "setColor" o = Poppler.Annot.AnnotSetColorMethodInfo
    ResolveAnnotStampMethod "setContents" o = Poppler.Annot.AnnotSetContentsMethodInfo
    ResolveAnnotStampMethod "setCustomImage" o = AnnotStampSetCustomImageMethodInfo
    ResolveAnnotStampMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAnnotStampMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAnnotStampMethod "setFlags" o = Poppler.Annot.AnnotSetFlagsMethodInfo
    ResolveAnnotStampMethod "setIcon" o = AnnotStampSetIconMethodInfo
    ResolveAnnotStampMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAnnotStampMethod "setRectangle" o = Poppler.Annot.AnnotSetRectangleMethodInfo
    ResolveAnnotStampMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AnnotStamp
type instance O.AttributeList AnnotStamp = AnnotStampAttributeList
type AnnotStampAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList AnnotStamp = AnnotStampSignalList
type AnnotStampSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method AnnotStamp::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "doc"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerRectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "AnnotStamp" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_stamp_new" poppler_annot_stamp_new :: 
    Ptr Poppler.Document.Document ->        -- doc : TInterface (Name {namespace = "Poppler", name = "Document"})
    Ptr Poppler.Rectangle.Rectangle ->      -- rect : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO (Ptr AnnotStamp)

-- | Creates a new Stamp annotation that will be
-- located on /@rect@/ when added to a page. See
-- 'GI.Poppler.Objects.Page.pageAddAnnot'
-- 
-- /Since: 22.07.0/
annotStampNew ::
    (B.CallStack.HasCallStack, MonadIO m, Poppler.Document.IsDocument a) =>
    a
    -- ^ /@doc@/: a t'GI.Poppler.Objects.Document.Document'
    -> Poppler.Rectangle.Rectangle
    -- ^ /@rect@/: a t'GI.Poppler.Structs.Rectangle.Rectangle'
    -> m AnnotStamp
    -- ^ __Returns:__ a newly created t'GI.Poppler.Objects.AnnotStamp.AnnotStamp' annotation
annotStampNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Rectangle -> m AnnotStamp
annotStampNew a
doc Rectangle
rect = IO AnnotStamp -> m AnnotStamp
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnnotStamp -> m AnnotStamp) -> IO AnnotStamp -> m AnnotStamp
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
doc' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
doc
    Ptr Rectangle
rect' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
rect
    Ptr AnnotStamp
result <- Ptr Document -> Ptr Rectangle -> IO (Ptr AnnotStamp)
poppler_annot_stamp_new Ptr Document
doc' Ptr Rectangle
rect'
    Text -> Ptr AnnotStamp -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"annotStampNew" Ptr AnnotStamp
result
    AnnotStamp
result' <- ((ManagedPtr AnnotStamp -> AnnotStamp)
-> Ptr AnnotStamp -> IO AnnotStamp
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AnnotStamp -> AnnotStamp
AnnotStamp) Ptr AnnotStamp
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
doc
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
rect
    AnnotStamp -> IO AnnotStamp
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AnnotStamp
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "poppler_annot_stamp_get_icon" poppler_annot_stamp_get_icon :: 
    Ptr AnnotStamp ->                       -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotStamp"})
    IO CUInt

-- | /No description available in the introspection data./
-- 
-- /Since: 22.07.0/
annotStampGetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotStamp a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotStamp.AnnotStamp'
    -> m Poppler.Enums.AnnotStampIcon
    -- ^ __Returns:__ the corresponding t'GI.Poppler.Enums.AnnotStampIcon' of the icon
annotStampGetIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotStamp a) =>
a -> m AnnotStampIcon
annotStampGetIcon a
popplerAnnot = IO AnnotStampIcon -> m AnnotStampIcon
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnnotStampIcon -> m AnnotStampIcon)
-> IO AnnotStampIcon -> m AnnotStampIcon
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotStamp
popplerAnnot' <- a -> IO (Ptr AnnotStamp)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CUInt
result <- Ptr AnnotStamp -> IO CUInt
poppler_annot_stamp_get_icon Ptr AnnotStamp
popplerAnnot'
    let result' :: AnnotStampIcon
result' = (Int -> AnnotStampIcon
forall a. Enum a => Int -> a
toEnum (Int -> AnnotStampIcon)
-> (CUInt -> Int) -> CUInt -> AnnotStampIcon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    AnnotStampIcon -> IO AnnotStampIcon
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AnnotStampIcon
result'

#if defined(ENABLE_OVERLOADING)
data AnnotStampGetIconMethodInfo
instance (signature ~ (m Poppler.Enums.AnnotStampIcon), MonadIO m, IsAnnotStamp a) => O.OverloadedMethod AnnotStampGetIconMethodInfo a signature where
    overloadedMethod = annotStampGetIcon

instance O.OverloadedMethodInfo AnnotStampGetIconMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotStamp.annotStampGetIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.29/docs/GI-Poppler-Objects-AnnotStamp.html#v:annotStampGetIcon"
        })


#endif

-- method AnnotStamp::set_custom_image
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotStamp" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotStamp"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "image"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an image cairo surface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "poppler_annot_stamp_set_custom_image" poppler_annot_stamp_set_custom_image :: 
    Ptr AnnotStamp ->                       -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotStamp"})
    Ptr Cairo.Surface.Surface ->            -- image : TInterface (Name {namespace = "cairo", name = "Surface"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets the custom image of /@popplerAnnot@/ to be /@image@/
-- 
-- /Since: 22.07.0/
annotStampSetCustomImage ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotStamp a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotStamp.AnnotStamp'
    -> Cairo.Surface.Surface
    -- ^ /@image@/: an image cairo surface
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
annotStampSetCustomImage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotStamp a) =>
a -> Surface -> m ()
annotStampSetCustomImage a
popplerAnnot Surface
image = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotStamp
popplerAnnot' <- a -> IO (Ptr AnnotStamp)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    Ptr Surface
image' <- Surface -> IO (Ptr Surface)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Surface
image
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AnnotStamp -> Ptr Surface -> Ptr (Ptr GError) -> IO CInt
poppler_annot_stamp_set_custom_image Ptr AnnotStamp
popplerAnnot' Ptr Surface
image'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
        Surface -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Surface
image
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data AnnotStampSetCustomImageMethodInfo
instance (signature ~ (Cairo.Surface.Surface -> m ()), MonadIO m, IsAnnotStamp a) => O.OverloadedMethod AnnotStampSetCustomImageMethodInfo a signature where
    overloadedMethod = annotStampSetCustomImage

instance O.OverloadedMethodInfo AnnotStampSetCustomImageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotStamp.annotStampSetCustomImage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.29/docs/GI-Poppler-Objects-AnnotStamp.html#v:annotStampSetCustomImage"
        })


#endif

-- method AnnotStamp::set_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotStamp" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotStamp"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotStampIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #PopplerAnnotStampIcon type of the icon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_stamp_set_icon" poppler_annot_stamp_set_icon :: 
    Ptr AnnotStamp ->                       -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotStamp"})
    CUInt ->                                -- icon : TInterface (Name {namespace = "Poppler", name = "AnnotStampIcon"})
    IO ()

-- | Sets the icon of /@popplerAnnot@/ to be one of the predefined values in t'GI.Poppler.Enums.AnnotStampIcon'
-- 
-- /Since: 22.07.0/
annotStampSetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotStamp a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotStamp.AnnotStamp'
    -> Poppler.Enums.AnnotStampIcon
    -- ^ /@icon@/: the t'GI.Poppler.Enums.AnnotStampIcon' type of the icon
    -> m ()
annotStampSetIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotStamp a) =>
a -> AnnotStampIcon -> m ()
annotStampSetIcon a
popplerAnnot AnnotStampIcon
icon = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotStamp
popplerAnnot' <- a -> IO (Ptr AnnotStamp)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    let icon' :: CUInt
icon' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (AnnotStampIcon -> Int) -> AnnotStampIcon -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnnotStampIcon -> Int
forall a. Enum a => a -> Int
fromEnum) AnnotStampIcon
icon
    Ptr AnnotStamp -> CUInt -> IO ()
poppler_annot_stamp_set_icon Ptr AnnotStamp
popplerAnnot' CUInt
icon'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnnotStampSetIconMethodInfo
instance (signature ~ (Poppler.Enums.AnnotStampIcon -> m ()), MonadIO m, IsAnnotStamp a) => O.OverloadedMethod AnnotStampSetIconMethodInfo a signature where
    overloadedMethod = annotStampSetIcon

instance O.OverloadedMethodInfo AnnotStampSetIconMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotStamp.annotStampSetIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.29/docs/GI-Poppler-Objects-AnnotStamp.html#v:annotStampSetIcon"
        })


#endif