{-# LANGUAGE TypeApplications #-}


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

-- * Exported types
    Annot(..)                               ,
    IsAnnot                                 ,
    toAnnot                                 ,


 -- * 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"), [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"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFlags]("GI.Poppler.Objects.Annot#g:method:setFlags"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRectangle]("GI.Poppler.Objects.Annot#g:method:setRectangle").

#if defined(ENABLE_OVERLOADING)
    ResolveAnnotMethod                      ,
#endif

-- ** getAnnotType #method:getAnnotType#

#if defined(ENABLE_OVERLOADING)
    AnnotGetAnnotTypeMethodInfo             ,
#endif
    annotGetAnnotType                       ,


-- ** getColor #method:getColor#

#if defined(ENABLE_OVERLOADING)
    AnnotGetColorMethodInfo                 ,
#endif
    annotGetColor                           ,


-- ** getContents #method:getContents#

#if defined(ENABLE_OVERLOADING)
    AnnotGetContentsMethodInfo              ,
#endif
    annotGetContents                        ,


-- ** getFlags #method:getFlags#

#if defined(ENABLE_OVERLOADING)
    AnnotGetFlagsMethodInfo                 ,
#endif
    annotGetFlags                           ,


-- ** getModified #method:getModified#

#if defined(ENABLE_OVERLOADING)
    AnnotGetModifiedMethodInfo              ,
#endif
    annotGetModified                        ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    AnnotGetNameMethodInfo                  ,
#endif
    annotGetName                            ,


-- ** getPageIndex #method:getPageIndex#

#if defined(ENABLE_OVERLOADING)
    AnnotGetPageIndexMethodInfo             ,
#endif
    annotGetPageIndex                       ,


-- ** getRectangle #method:getRectangle#

#if defined(ENABLE_OVERLOADING)
    AnnotGetRectangleMethodInfo             ,
#endif
    annotGetRectangle                       ,


-- ** setColor #method:setColor#

#if defined(ENABLE_OVERLOADING)
    AnnotSetColorMethodInfo                 ,
#endif
    annotSetColor                           ,


-- ** setContents #method:setContents#

#if defined(ENABLE_OVERLOADING)
    AnnotSetContentsMethodInfo              ,
#endif
    annotSetContents                        ,


-- ** setFlags #method:setFlags#

#if defined(ENABLE_OVERLOADING)
    AnnotSetFlagsMethodInfo                 ,
#endif
    annotSetFlags                           ,


-- ** setRectangle #method:setRectangle#

#if defined(ENABLE_OVERLOADING)
    AnnotSetRectangleMethodInfo             ,
#endif
    annotSetRectangle                       ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums
import {-# SOURCE #-} qualified GI.Poppler.Flags as Poppler.Flags
import {-# SOURCE #-} qualified GI.Poppler.Structs.Color as Poppler.Color
import {-# SOURCE #-} qualified GI.Poppler.Structs.Rectangle as Poppler.Rectangle

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

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

foreign import ccall "poppler_annot_get_type"
    c_poppler_annot_get_type :: IO B.Types.GType

instance B.Types.TypedObject Annot where
    glibType :: IO GType
glibType = IO GType
c_poppler_annot_get_type

instance B.Types.GObject Annot

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

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

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

-- | Convert 'Annot' 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 Annot) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_poppler_annot_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Annot -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Annot
P.Nothing = Ptr GValue -> Ptr Annot -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Annot
forall a. Ptr a
FP.nullPtr :: FP.Ptr Annot)
    gvalueSet_ Ptr GValue
gv (P.Just Annot
obj) = Annot -> (Ptr Annot -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Annot
obj (Ptr GValue -> Ptr Annot -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Annot)
gvalueGet_ Ptr GValue
gv = do
        Ptr Annot
ptr <- Ptr GValue -> IO (Ptr Annot)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Annot)
        if Ptr Annot
ptr Ptr Annot -> Ptr Annot -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Annot
forall a. Ptr a
FP.nullPtr
        then Annot -> Maybe Annot
forall a. a -> Maybe a
P.Just (Annot -> Maybe Annot) -> IO Annot -> IO (Maybe Annot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Annot -> Annot) -> Ptr Annot -> IO Annot
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Annot -> Annot
Annot Ptr Annot
ptr
        else Maybe Annot -> IO (Maybe Annot)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Annot
forall a. Maybe a
P.Nothing
        
    

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

instance (info ~ ResolveAnnotMethod t Annot, O.OverloadedMethod info Annot p) => OL.IsLabel t (Annot -> 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 ~ ResolveAnnotMethod t Annot, O.OverloadedMethod info Annot p, R.HasField t Annot p) => R.HasField t Annot p where
    getField = O.overloadedMethod @info

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Annot = AnnotSignalList
type AnnotSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

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

-- | Gets the type of /@popplerAnnot@/
annotGetAnnotType ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnot a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.Annot.Annot'
    -> m Poppler.Enums.AnnotType
    -- ^ __Returns:__ t'GI.Poppler.Enums.AnnotType' of /@popplerAnnot@/.
annotGetAnnotType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnot a) =>
a -> m AnnotType
annotGetAnnotType a
popplerAnnot = IO AnnotType -> m AnnotType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnnotType -> m AnnotType) -> IO AnnotType -> m AnnotType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Annot
popplerAnnot' <- a -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CUInt
result <- Ptr Annot -> IO CUInt
poppler_annot_get_annot_type Ptr Annot
popplerAnnot'
    let result' :: AnnotType
result' = (Int -> AnnotType
forall a. Enum a => Int -> a
toEnum (Int -> AnnotType) -> (CUInt -> Int) -> CUInt -> AnnotType
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
    AnnotType -> IO AnnotType
forall (m :: * -> *) a. Monad m => a -> m a
return AnnotType
result'

#if defined(ENABLE_OVERLOADING)
data AnnotGetAnnotTypeMethodInfo
instance (signature ~ (m Poppler.Enums.AnnotType), MonadIO m, IsAnnot a) => O.OverloadedMethod AnnotGetAnnotTypeMethodInfo a signature where
    overloadedMethod = annotGetAnnotType

instance O.OverloadedMethodInfo AnnotGetAnnotTypeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Annot.annotGetAnnotType",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Annot.html#v:annotGetAnnotType"
        }


#endif

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

foreign import ccall "poppler_annot_get_color" poppler_annot_get_color :: 
    Ptr Annot ->                            -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "Annot"})
    IO (Ptr Poppler.Color.Color)

-- | Retrieves the color of /@popplerAnnot@/.
annotGetColor ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnot a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.Annot.Annot'
    -> m Poppler.Color.Color
    -- ^ __Returns:__ a new allocated t'GI.Poppler.Structs.Color.Color' with the color values of
    --               /@popplerAnnot@/, or 'P.Nothing'. It must be freed with 'GI.GLib.Functions.free' when done.
annotGetColor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnot a) =>
a -> m Color
annotGetColor a
popplerAnnot = IO Color -> m Color
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Color -> m Color) -> IO Color -> m Color
forall a b. (a -> b) -> a -> b
$ do
    Ptr Annot
popplerAnnot' <- a -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    Ptr Color
result <- Ptr Annot -> IO (Ptr Color)
poppler_annot_get_color Ptr Annot
popplerAnnot'
    Text -> Ptr Color -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"annotGetColor" Ptr Color
result
    Color
result' <- ((ManagedPtr Color -> Color) -> Ptr Color -> IO Color
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Color -> Color
Poppler.Color.Color) Ptr Color
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Color -> IO Color
forall (m :: * -> *) a. Monad m => a -> m a
return Color
result'

#if defined(ENABLE_OVERLOADING)
data AnnotGetColorMethodInfo
instance (signature ~ (m Poppler.Color.Color), MonadIO m, IsAnnot a) => O.OverloadedMethod AnnotGetColorMethodInfo a signature where
    overloadedMethod = annotGetColor

instance O.OverloadedMethodInfo AnnotGetColorMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Annot.annotGetColor",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Annot.html#v:annotGetColor"
        }


#endif

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

foreign import ccall "poppler_annot_get_contents" poppler_annot_get_contents :: 
    Ptr Annot ->                            -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "Annot"})
    IO CString

-- | Retrieves the contents of /@popplerAnnot@/.
annotGetContents ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnot a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.Annot.Annot'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string with the contents of /@popplerAnnot@/. It
    --               must be freed with 'GI.GLib.Functions.free' when done.
annotGetContents :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnot a) =>
a -> m Text
annotGetContents a
popplerAnnot = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Annot
popplerAnnot' <- a -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CString
result <- Ptr Annot -> IO CString
poppler_annot_get_contents Ptr Annot
popplerAnnot'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"annotGetContents" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AnnotGetContentsMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAnnot a) => O.OverloadedMethod AnnotGetContentsMethodInfo a signature where
    overloadedMethod = annotGetContents

instance O.OverloadedMethodInfo AnnotGetContentsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Annot.annotGetContents",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Annot.html#v:annotGetContents"
        }


#endif

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

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

-- | Retrieves the flag field specifying various characteristics of the
-- /@popplerAnnot@/.
annotGetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnot a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.Annot.Annot'
    -> m [Poppler.Flags.AnnotFlag]
    -- ^ __Returns:__ the flag field of /@popplerAnnot@/.
annotGetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnot a) =>
a -> m [AnnotFlag]
annotGetFlags a
popplerAnnot = IO [AnnotFlag] -> m [AnnotFlag]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AnnotFlag] -> m [AnnotFlag])
-> IO [AnnotFlag] -> m [AnnotFlag]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Annot
popplerAnnot' <- a -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CUInt
result <- Ptr Annot -> IO CUInt
poppler_annot_get_flags Ptr Annot
popplerAnnot'
    let result' :: [AnnotFlag]
result' = CUInt -> [AnnotFlag]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    [AnnotFlag] -> IO [AnnotFlag]
forall (m :: * -> *) a. Monad m => a -> m a
return [AnnotFlag]
result'

#if defined(ENABLE_OVERLOADING)
data AnnotGetFlagsMethodInfo
instance (signature ~ (m [Poppler.Flags.AnnotFlag]), MonadIO m, IsAnnot a) => O.OverloadedMethod AnnotGetFlagsMethodInfo a signature where
    overloadedMethod = annotGetFlags

instance O.OverloadedMethodInfo AnnotGetFlagsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Annot.annotGetFlags",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Annot.html#v:annotGetFlags"
        }


#endif

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

foreign import ccall "poppler_annot_get_modified" poppler_annot_get_modified :: 
    Ptr Annot ->                            -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "Annot"})
    IO CString

-- | Retrieves the last modification data of /@popplerAnnot@/. The returned
-- string will be either a PDF format date or a text string.
-- See also @/poppler_date_parse/@()
annotGetModified ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnot a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.Annot.Annot'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string with the last modification data of
    --               /@popplerAnnot@/. It must be freed with 'GI.GLib.Functions.free' when done.
annotGetModified :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnot a) =>
a -> m Text
annotGetModified a
popplerAnnot = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Annot
popplerAnnot' <- a -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CString
result <- Ptr Annot -> IO CString
poppler_annot_get_modified Ptr Annot
popplerAnnot'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"annotGetModified" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AnnotGetModifiedMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAnnot a) => O.OverloadedMethod AnnotGetModifiedMethodInfo a signature where
    overloadedMethod = annotGetModified

instance O.OverloadedMethodInfo AnnotGetModifiedMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Annot.annotGetModified",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Annot.html#v:annotGetModified"
        }


#endif

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

foreign import ccall "poppler_annot_get_name" poppler_annot_get_name :: 
    Ptr Annot ->                            -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "Annot"})
    IO CString

-- | Retrieves the name of /@popplerAnnot@/.
annotGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnot a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.Annot.Annot'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string with the name of /@popplerAnnot@/. It must
    --               be freed with 'GI.GLib.Functions.free' when done.
annotGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnot a) =>
a -> m Text
annotGetName a
popplerAnnot = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Annot
popplerAnnot' <- a -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CString
result <- Ptr Annot -> IO CString
poppler_annot_get_name Ptr Annot
popplerAnnot'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"annotGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AnnotGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAnnot a) => O.OverloadedMethod AnnotGetNameMethodInfo a signature where
    overloadedMethod = annotGetName

instance O.OverloadedMethodInfo AnnotGetNameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Annot.annotGetName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Annot.html#v:annotGetName"
        }


#endif

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

foreign import ccall "poppler_annot_get_page_index" poppler_annot_get_page_index :: 
    Ptr Annot ->                            -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "Annot"})
    IO Int32

-- | Returns the page index to which /@popplerAnnot@/ is associated, or -1 if unknown
-- 
-- /Since: 0.14/
annotGetPageIndex ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnot a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.Annot.Annot'
    -> m Int32
    -- ^ __Returns:__ page index or -1
annotGetPageIndex :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnot a) =>
a -> m Int32
annotGetPageIndex a
popplerAnnot = 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
$ do
    Ptr Annot
popplerAnnot' <- a -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    Int32
result <- Ptr Annot -> IO Int32
poppler_annot_get_page_index Ptr Annot
popplerAnnot'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data AnnotGetPageIndexMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsAnnot a) => O.OverloadedMethod AnnotGetPageIndexMethodInfo a signature where
    overloadedMethod = annotGetPageIndex

instance O.OverloadedMethodInfo AnnotGetPageIndexMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Annot.annotGetPageIndex",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Annot.html#v:annotGetPageIndex"
        }


#endif

-- method Annot::get_rectangle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Annot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "poppler_rect"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #PopplerRectangle to store the annotation's coordinates"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_get_rectangle" poppler_annot_get_rectangle :: 
    Ptr Annot ->                            -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "Annot"})
    Ptr Poppler.Rectangle.Rectangle ->      -- poppler_rect : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO ()

-- | Retrieves the rectangle representing the page coordinates where the
-- annotation /@popplerAnnot@/ is placed.
-- 
-- /Since: 0.26/
annotGetRectangle ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnot a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.Annot.Annot'
    -> m (Poppler.Rectangle.Rectangle)
annotGetRectangle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnot a) =>
a -> m Rectangle
annotGetRectangle a
popplerAnnot = IO Rectangle -> m Rectangle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rectangle -> m Rectangle) -> IO Rectangle -> m Rectangle
forall a b. (a -> b) -> a -> b
$ do
    Ptr Annot
popplerAnnot' <- a -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    Ptr Rectangle
popplerRect <- Int -> IO (Ptr Rectangle)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
32 :: IO (Ptr Poppler.Rectangle.Rectangle)
    Ptr Annot -> Ptr Rectangle -> IO ()
poppler_annot_get_rectangle Ptr Annot
popplerAnnot' Ptr Rectangle
popplerRect
    Rectangle
popplerRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rectangle -> Rectangle
Poppler.Rectangle.Rectangle) Ptr Rectangle
popplerRect
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Rectangle -> IO Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
popplerRect'

#if defined(ENABLE_OVERLOADING)
data AnnotGetRectangleMethodInfo
instance (signature ~ (m (Poppler.Rectangle.Rectangle)), MonadIO m, IsAnnot a) => O.OverloadedMethod AnnotGetRectangleMethodInfo a signature where
    overloadedMethod = annotGetRectangle

instance O.OverloadedMethodInfo AnnotGetRectangleMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Annot.annotGetRectangle",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Annot.html#v:annotGetRectangle"
        }


#endif

-- method Annot::set_color
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Annot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "poppler_color"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerColor, or %NULL"
--                 , 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_set_color" poppler_annot_set_color :: 
    Ptr Annot ->                            -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "Annot"})
    Ptr Poppler.Color.Color ->              -- poppler_color : TInterface (Name {namespace = "Poppler", name = "Color"})
    IO ()

-- | Sets the color of /@popplerAnnot@/.
-- 
-- /Since: 0.16/
annotSetColor ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnot a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.Annot.Annot'
    -> Maybe (Poppler.Color.Color)
    -- ^ /@popplerColor@/: a t'GI.Poppler.Structs.Color.Color', or 'P.Nothing'
    -> m ()
annotSetColor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnot a) =>
a -> Maybe Color -> m ()
annotSetColor a
popplerAnnot Maybe Color
popplerColor = 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 Annot
popplerAnnot' <- a -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    Ptr Color
maybePopplerColor <- case Maybe Color
popplerColor of
        Maybe Color
Nothing -> Ptr Color -> IO (Ptr Color)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Color
forall a. Ptr a
nullPtr
        Just Color
jPopplerColor -> do
            Ptr Color
jPopplerColor' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
jPopplerColor
            Ptr Color -> IO (Ptr Color)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Color
jPopplerColor'
    Ptr Annot -> Ptr Color -> IO ()
poppler_annot_set_color Ptr Annot
popplerAnnot' Ptr Color
maybePopplerColor
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Maybe Color -> (Color -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Color
popplerColor Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnnotSetColorMethodInfo
instance (signature ~ (Maybe (Poppler.Color.Color) -> m ()), MonadIO m, IsAnnot a) => O.OverloadedMethod AnnotSetColorMethodInfo a signature where
    overloadedMethod = annotSetColor

instance O.OverloadedMethodInfo AnnotSetColorMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Annot.annotSetColor",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Annot.html#v:annotSetColor"
        }


#endif

-- method Annot::set_contents
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Annot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "contents"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a text string containing the new contents"
--                 , 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_set_contents" poppler_annot_set_contents :: 
    Ptr Annot ->                            -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "Annot"})
    CString ->                              -- contents : TBasicType TUTF8
    IO ()

-- | Sets the contents of /@popplerAnnot@/ to the given value,
-- replacing the current contents.
-- 
-- /Since: 0.12/
annotSetContents ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnot a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.Annot.Annot'
    -> T.Text
    -- ^ /@contents@/: a text string containing the new contents
    -> m ()
annotSetContents :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnot a) =>
a -> Text -> m ()
annotSetContents a
popplerAnnot Text
contents = 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 Annot
popplerAnnot' <- a -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CString
contents' <- Text -> IO CString
textToCString Text
contents
    Ptr Annot -> CString -> IO ()
poppler_annot_set_contents Ptr Annot
popplerAnnot' CString
contents'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contents'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnnotSetContentsMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsAnnot a) => O.OverloadedMethod AnnotSetContentsMethodInfo a signature where
    overloadedMethod = annotSetContents

instance O.OverloadedMethodInfo AnnotSetContentsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Annot.annotSetContents",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Annot.html#v:annotSetContents"
        }


#endif

-- method Annot::set_flags
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Annot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotFlag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotFlag"
--                 , 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_set_flags" poppler_annot_set_flags :: 
    Ptr Annot ->                            -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "Annot"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Poppler", name = "AnnotFlag"})
    IO ()

-- | Sets the flag field specifying various characteristics of the
-- /@popplerAnnot@/.
-- 
-- /Since: 0.22/
annotSetFlags ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnot a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.Annot.Annot'
    -> [Poppler.Flags.AnnotFlag]
    -- ^ /@flags@/: a t'GI.Poppler.Flags.AnnotFlag'
    -> m ()
annotSetFlags :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnot a) =>
a -> [AnnotFlag] -> m ()
annotSetFlags a
popplerAnnot [AnnotFlag]
flags = 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 Annot
popplerAnnot' <- a -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    let flags' :: CUInt
flags' = [AnnotFlag] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [AnnotFlag]
flags
    Ptr Annot -> CUInt -> IO ()
poppler_annot_set_flags Ptr Annot
popplerAnnot' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnnotSetFlagsMethodInfo
instance (signature ~ ([Poppler.Flags.AnnotFlag] -> m ()), MonadIO m, IsAnnot a) => O.OverloadedMethod AnnotSetFlagsMethodInfo a signature where
    overloadedMethod = annotSetFlags

instance O.OverloadedMethodInfo AnnotSetFlagsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Annot.annotSetFlags",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Annot.html#v:annotSetFlags"
        }


#endif

-- method Annot::set_rectangle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Annot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "poppler_rect"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #PopplerRectangle with the new annotation's coordinates"
--                 , 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_set_rectangle" poppler_annot_set_rectangle :: 
    Ptr Annot ->                            -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "Annot"})
    Ptr Poppler.Rectangle.Rectangle ->      -- poppler_rect : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO ()

-- | Move the annotation to the rectangle representing the page coordinates
-- where the annotation /@popplerAnnot@/ should be placed.
-- 
-- /Since: 0.26/
annotSetRectangle ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnot a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.Annot.Annot'
    -> Poppler.Rectangle.Rectangle
    -- ^ /@popplerRect@/: a t'GI.Poppler.Structs.Rectangle.Rectangle' with the new annotation\'s coordinates
    -> m ()
annotSetRectangle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnot a) =>
a -> Rectangle -> m ()
annotSetRectangle a
popplerAnnot Rectangle
popplerRect = 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 Annot
popplerAnnot' <- a -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    Ptr Rectangle
popplerRect' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
popplerRect
    Ptr Annot -> Ptr Rectangle -> IO ()
poppler_annot_set_rectangle Ptr Annot
popplerAnnot' Ptr Rectangle
popplerRect'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
popplerRect
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnnotSetRectangleMethodInfo
instance (signature ~ (Poppler.Rectangle.Rectangle -> m ()), MonadIO m, IsAnnot a) => O.OverloadedMethod AnnotSetRectangleMethodInfo a signature where
    overloadedMethod = annotSetRectangle

instance O.OverloadedMethodInfo AnnotSetRectangleMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Poppler.Objects.Annot.annotSetRectangle",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-poppler-0.18.25/docs/GI-Poppler-Objects-Annot.html#v:annotSetRectangle"
        }


#endif