{-# 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.Page
    ( 

-- * Exported types
    Page(..)                                ,
    IsPage                                  ,
    toPage                                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addAnnot]("GI.Poppler.Objects.Page#g:method:addAnnot"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [findText]("GI.Poppler.Objects.Page#g:method:findText"), [findTextWithOptions]("GI.Poppler.Objects.Page#g:method:findTextWithOptions"), [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"), [removeAnnot]("GI.Poppler.Objects.Page#g:method:removeAnnot"), [render]("GI.Poppler.Objects.Page#g:method:render"), [renderForPrinting]("GI.Poppler.Objects.Page#g:method:renderForPrinting"), [renderForPrintingWithOptions]("GI.Poppler.Objects.Page#g:method:renderForPrintingWithOptions"), [renderSelection]("GI.Poppler.Objects.Page#g:method:renderSelection"), [renderToPs]("GI.Poppler.Objects.Page#g:method:renderToPs"), [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
-- [getAnnotMapping]("GI.Poppler.Objects.Page#g:method:getAnnotMapping"), [getBoundingBox]("GI.Poppler.Objects.Page#g:method:getBoundingBox"), [getCropBox]("GI.Poppler.Objects.Page#g:method:getCropBox"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDuration]("GI.Poppler.Objects.Page#g:method:getDuration"), [getFormFieldMapping]("GI.Poppler.Objects.Page#g:method:getFormFieldMapping"), [getImage]("GI.Poppler.Objects.Page#g:method:getImage"), [getImageMapping]("GI.Poppler.Objects.Page#g:method:getImageMapping"), [getIndex]("GI.Poppler.Objects.Page#g:method:getIndex"), [getLabel]("GI.Poppler.Objects.Page#g:method:getLabel"), [getLinkMapping]("GI.Poppler.Objects.Page#g:method:getLinkMapping"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSelectedRegion]("GI.Poppler.Objects.Page#g:method:getSelectedRegion"), [getSelectedText]("GI.Poppler.Objects.Page#g:method:getSelectedText"), [getSelectionRegion]("GI.Poppler.Objects.Page#g:method:getSelectionRegion"), [getSize]("GI.Poppler.Objects.Page#g:method:getSize"), [getText]("GI.Poppler.Objects.Page#g:method:getText"), [getTextAttributes]("GI.Poppler.Objects.Page#g:method:getTextAttributes"), [getTextAttributesForArea]("GI.Poppler.Objects.Page#g:method:getTextAttributesForArea"), [getTextForArea]("GI.Poppler.Objects.Page#g:method:getTextForArea"), [getTextLayout]("GI.Poppler.Objects.Page#g:method:getTextLayout"), [getTextLayoutForArea]("GI.Poppler.Objects.Page#g:method:getTextLayoutForArea"), [getThumbnail]("GI.Poppler.Objects.Page#g:method:getThumbnail"), [getThumbnailSize]("GI.Poppler.Objects.Page#g:method:getThumbnailSize"), [getTransition]("GI.Poppler.Objects.Page#g:method:getTransition").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolvePageMethod                       ,
#endif

-- ** addAnnot #method:addAnnot#

#if defined(ENABLE_OVERLOADING)
    PageAddAnnotMethodInfo                  ,
#endif
    pageAddAnnot                            ,


-- ** findText #method:findText#

#if defined(ENABLE_OVERLOADING)
    PageFindTextMethodInfo                  ,
#endif
    pageFindText                            ,


-- ** findTextWithOptions #method:findTextWithOptions#

#if defined(ENABLE_OVERLOADING)
    PageFindTextWithOptionsMethodInfo       ,
#endif
    pageFindTextWithOptions                 ,


-- ** freeAnnotMapping #method:freeAnnotMapping#

    pageFreeAnnotMapping                    ,


-- ** freeFormFieldMapping #method:freeFormFieldMapping#

    pageFreeFormFieldMapping                ,


-- ** freeImageMapping #method:freeImageMapping#

    pageFreeImageMapping                    ,


-- ** freeLinkMapping #method:freeLinkMapping#

    pageFreeLinkMapping                     ,


-- ** freeTextAttributes #method:freeTextAttributes#

    pageFreeTextAttributes                  ,


-- ** getAnnotMapping #method:getAnnotMapping#

#if defined(ENABLE_OVERLOADING)
    PageGetAnnotMappingMethodInfo           ,
#endif
    pageGetAnnotMapping                     ,


-- ** getBoundingBox #method:getBoundingBox#

#if defined(ENABLE_OVERLOADING)
    PageGetBoundingBoxMethodInfo            ,
#endif
    pageGetBoundingBox                      ,


-- ** getCropBox #method:getCropBox#

#if defined(ENABLE_OVERLOADING)
    PageGetCropBoxMethodInfo                ,
#endif
    pageGetCropBox                          ,


-- ** getDuration #method:getDuration#

#if defined(ENABLE_OVERLOADING)
    PageGetDurationMethodInfo               ,
#endif
    pageGetDuration                         ,


-- ** getFormFieldMapping #method:getFormFieldMapping#

#if defined(ENABLE_OVERLOADING)
    PageGetFormFieldMappingMethodInfo       ,
#endif
    pageGetFormFieldMapping                 ,


-- ** getImage #method:getImage#

#if defined(ENABLE_OVERLOADING)
    PageGetImageMethodInfo                  ,
#endif
    pageGetImage                            ,


-- ** getImageMapping #method:getImageMapping#

#if defined(ENABLE_OVERLOADING)
    PageGetImageMappingMethodInfo           ,
#endif
    pageGetImageMapping                     ,


-- ** getIndex #method:getIndex#

#if defined(ENABLE_OVERLOADING)
    PageGetIndexMethodInfo                  ,
#endif
    pageGetIndex                            ,


-- ** getLabel #method:getLabel#

#if defined(ENABLE_OVERLOADING)
    PageGetLabelMethodInfo                  ,
#endif
    pageGetLabel                            ,


-- ** getLinkMapping #method:getLinkMapping#

#if defined(ENABLE_OVERLOADING)
    PageGetLinkMappingMethodInfo            ,
#endif
    pageGetLinkMapping                      ,


-- ** getSelectedRegion #method:getSelectedRegion#

#if defined(ENABLE_OVERLOADING)
    PageGetSelectedRegionMethodInfo         ,
#endif
    pageGetSelectedRegion                   ,


-- ** getSelectedText #method:getSelectedText#

#if defined(ENABLE_OVERLOADING)
    PageGetSelectedTextMethodInfo           ,
#endif
    pageGetSelectedText                     ,


-- ** getSelectionRegion #method:getSelectionRegion#

#if defined(ENABLE_OVERLOADING)
    PageGetSelectionRegionMethodInfo        ,
#endif
    pageGetSelectionRegion                  ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    PageGetSizeMethodInfo                   ,
#endif
    pageGetSize                             ,


-- ** getText #method:getText#

#if defined(ENABLE_OVERLOADING)
    PageGetTextMethodInfo                   ,
#endif
    pageGetText                             ,


-- ** getTextAttributes #method:getTextAttributes#

#if defined(ENABLE_OVERLOADING)
    PageGetTextAttributesMethodInfo         ,
#endif
    pageGetTextAttributes                   ,


-- ** getTextAttributesForArea #method:getTextAttributesForArea#

#if defined(ENABLE_OVERLOADING)
    PageGetTextAttributesForAreaMethodInfo  ,
#endif
    pageGetTextAttributesForArea            ,


-- ** getTextForArea #method:getTextForArea#

#if defined(ENABLE_OVERLOADING)
    PageGetTextForAreaMethodInfo            ,
#endif
    pageGetTextForArea                      ,


-- ** getTextLayout #method:getTextLayout#

#if defined(ENABLE_OVERLOADING)
    PageGetTextLayoutMethodInfo             ,
#endif
    pageGetTextLayout                       ,


-- ** getTextLayoutForArea #method:getTextLayoutForArea#

#if defined(ENABLE_OVERLOADING)
    PageGetTextLayoutForAreaMethodInfo      ,
#endif
    pageGetTextLayoutForArea                ,


-- ** getThumbnail #method:getThumbnail#

#if defined(ENABLE_OVERLOADING)
    PageGetThumbnailMethodInfo              ,
#endif
    pageGetThumbnail                        ,


-- ** getThumbnailSize #method:getThumbnailSize#

#if defined(ENABLE_OVERLOADING)
    PageGetThumbnailSizeMethodInfo          ,
#endif
    pageGetThumbnailSize                    ,


-- ** getTransition #method:getTransition#

#if defined(ENABLE_OVERLOADING)
    PageGetTransitionMethodInfo             ,
#endif
    pageGetTransition                       ,


-- ** removeAnnot #method:removeAnnot#

#if defined(ENABLE_OVERLOADING)
    PageRemoveAnnotMethodInfo               ,
#endif
    pageRemoveAnnot                         ,


-- ** render #method:render#

#if defined(ENABLE_OVERLOADING)
    PageRenderMethodInfo                    ,
#endif
    pageRender                              ,


-- ** renderForPrinting #method:renderForPrinting#

#if defined(ENABLE_OVERLOADING)
    PageRenderForPrintingMethodInfo         ,
#endif
    pageRenderForPrinting                   ,


-- ** renderForPrintingWithOptions #method:renderForPrintingWithOptions#

#if defined(ENABLE_OVERLOADING)
    PageRenderForPrintingWithOptionsMethodInfo,
#endif
    pageRenderForPrintingWithOptions        ,


-- ** renderSelection #method:renderSelection#

#if defined(ENABLE_OVERLOADING)
    PageRenderSelectionMethodInfo           ,
#endif
    pageRenderSelection                     ,


-- ** renderToPs #method:renderToPs#

#if defined(ENABLE_OVERLOADING)
    PageRenderToPsMethodInfo                ,
#endif
    pageRenderToPs                          ,


-- ** selectionRegionFree #method:selectionRegionFree#

    pageSelectionRegionFree                 ,




 -- * Properties


-- ** label #attr:label#
-- | The label of the page or 'P.Nothing'. See also 'GI.Poppler.Objects.Page.pageGetLabel'

#if defined(ENABLE_OVERLOADING)
    PageLabelPropertyInfo                   ,
#endif
    getPageLabel                            ,
#if defined(ENABLE_OVERLOADING)
    pageLabel                               ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.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.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.Context as Cairo.Context
import qualified GI.Cairo.Structs.Region as Cairo.Region
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.Flags as Poppler.Flags
import {-# SOURCE #-} qualified GI.Poppler.Objects.Annot as Poppler.Annot
import {-# SOURCE #-} qualified GI.Poppler.Objects.PSFile as Poppler.PSFile
import {-# SOURCE #-} qualified GI.Poppler.Structs.AnnotMapping as Poppler.AnnotMapping
import {-# SOURCE #-} qualified GI.Poppler.Structs.Color as Poppler.Color
import {-# SOURCE #-} qualified GI.Poppler.Structs.FormFieldMapping as Poppler.FormFieldMapping
import {-# SOURCE #-} qualified GI.Poppler.Structs.ImageMapping as Poppler.ImageMapping
import {-# SOURCE #-} qualified GI.Poppler.Structs.LinkMapping as Poppler.LinkMapping
import {-# SOURCE #-} qualified GI.Poppler.Structs.PageTransition as Poppler.PageTransition
import {-# SOURCE #-} qualified GI.Poppler.Structs.Rectangle as Poppler.Rectangle
import {-# SOURCE #-} qualified GI.Poppler.Structs.TextAttributes as Poppler.TextAttributes

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

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

foreign import ccall "poppler_page_get_type"
    c_poppler_page_get_type :: IO B.Types.GType

instance B.Types.TypedObject Page where
    glibType :: IO GType
glibType = IO GType
c_poppler_page_get_type

instance B.Types.GObject Page

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePageMethod (t :: Symbol) (o :: *) :: * where
    ResolvePageMethod "addAnnot" o = PageAddAnnotMethodInfo
    ResolvePageMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePageMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePageMethod "findText" o = PageFindTextMethodInfo
    ResolvePageMethod "findTextWithOptions" o = PageFindTextWithOptionsMethodInfo
    ResolvePageMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePageMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePageMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePageMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePageMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePageMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePageMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePageMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePageMethod "removeAnnot" o = PageRemoveAnnotMethodInfo
    ResolvePageMethod "render" o = PageRenderMethodInfo
    ResolvePageMethod "renderForPrinting" o = PageRenderForPrintingMethodInfo
    ResolvePageMethod "renderForPrintingWithOptions" o = PageRenderForPrintingWithOptionsMethodInfo
    ResolvePageMethod "renderSelection" o = PageRenderSelectionMethodInfo
    ResolvePageMethod "renderToPs" o = PageRenderToPsMethodInfo
    ResolvePageMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePageMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePageMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePageMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePageMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePageMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePageMethod "getAnnotMapping" o = PageGetAnnotMappingMethodInfo
    ResolvePageMethod "getBoundingBox" o = PageGetBoundingBoxMethodInfo
    ResolvePageMethod "getCropBox" o = PageGetCropBoxMethodInfo
    ResolvePageMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePageMethod "getDuration" o = PageGetDurationMethodInfo
    ResolvePageMethod "getFormFieldMapping" o = PageGetFormFieldMappingMethodInfo
    ResolvePageMethod "getImage" o = PageGetImageMethodInfo
    ResolvePageMethod "getImageMapping" o = PageGetImageMappingMethodInfo
    ResolvePageMethod "getIndex" o = PageGetIndexMethodInfo
    ResolvePageMethod "getLabel" o = PageGetLabelMethodInfo
    ResolvePageMethod "getLinkMapping" o = PageGetLinkMappingMethodInfo
    ResolvePageMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePageMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePageMethod "getSelectedRegion" o = PageGetSelectedRegionMethodInfo
    ResolvePageMethod "getSelectedText" o = PageGetSelectedTextMethodInfo
    ResolvePageMethod "getSelectionRegion" o = PageGetSelectionRegionMethodInfo
    ResolvePageMethod "getSize" o = PageGetSizeMethodInfo
    ResolvePageMethod "getText" o = PageGetTextMethodInfo
    ResolvePageMethod "getTextAttributes" o = PageGetTextAttributesMethodInfo
    ResolvePageMethod "getTextAttributesForArea" o = PageGetTextAttributesForAreaMethodInfo
    ResolvePageMethod "getTextForArea" o = PageGetTextForAreaMethodInfo
    ResolvePageMethod "getTextLayout" o = PageGetTextLayoutMethodInfo
    ResolvePageMethod "getTextLayoutForArea" o = PageGetTextLayoutForAreaMethodInfo
    ResolvePageMethod "getThumbnail" o = PageGetThumbnailMethodInfo
    ResolvePageMethod "getThumbnailSize" o = PageGetThumbnailSizeMethodInfo
    ResolvePageMethod "getTransition" o = PageGetTransitionMethodInfo
    ResolvePageMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePageMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePageMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePageMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "label"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' page #label
-- @
getPageLabel :: (MonadIO m, IsPage o) => o -> m (Maybe T.Text)
getPageLabel :: forall (m :: * -> *) o.
(MonadIO m, IsPage o) =>
o -> m (Maybe Text)
getPageLabel o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"label"

#if defined(ENABLE_OVERLOADING)
data PageLabelPropertyInfo
instance AttrInfo PageLabelPropertyInfo where
    type AttrAllowedOps PageLabelPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PageLabelPropertyInfo = IsPage
    type AttrSetTypeConstraint PageLabelPropertyInfo = (~) ()
    type AttrTransferTypeConstraint PageLabelPropertyInfo = (~) ()
    type AttrTransferType PageLabelPropertyInfo = ()
    type AttrGetType PageLabelPropertyInfo = (Maybe T.Text)
    type AttrLabel PageLabelPropertyInfo = "label"
    type AttrOrigin PageLabelPropertyInfo = Page
    attrGet = getPageLabel
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Page.label"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-Page.html#g:attr:label"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Page
type instance O.AttributeList Page = PageAttributeList
type PageAttributeList = ('[ '("label", PageLabelPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
pageLabel :: AttrLabelProxy "label"
pageLabel = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "poppler_page_add_annot" poppler_page_add_annot :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr Poppler.Annot.Annot ->              -- annot : TInterface (Name {namespace = "Poppler", name = "Annot"})
    IO ()

-- | Adds annotation /@annot@/ to /@page@/.
-- 
-- /Since: 0.16/
pageAddAnnot ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a, Poppler.Annot.IsAnnot b) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> b
    -- ^ /@annot@/: a t'GI.Poppler.Objects.Annot.Annot' to add
    -> m ()
pageAddAnnot :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPage a, IsAnnot b) =>
a -> b -> m ()
pageAddAnnot a
page b
annot = 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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Annot
annot' <- b -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
annot
    Ptr Page -> Ptr Annot -> IO ()
poppler_page_add_annot Ptr Page
page' Ptr Annot
annot'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
annot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PageAddAnnotMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPage a, Poppler.Annot.IsAnnot b) => O.OverloadedMethod PageAddAnnotMethodInfo a signature where
    overloadedMethod = pageAddAnnot

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


#endif

-- method Page::find_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the text to search for (UTF-8 encoded)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Poppler" , name = "Rectangle" }))
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_find_text" poppler_page_find_text :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    CString ->                              -- text : TBasicType TUTF8
    IO (Ptr (GList (Ptr Poppler.Rectangle.Rectangle)))

-- | Finds /@text@/ in /@page@/ with the default options ('GI.Poppler.Flags.FindFlagsDefault') and
-- returns a t'GI.GLib.Structs.List.List' of rectangles for each occurrence of the text on the page.
-- The coordinates are in PDF points.
pageFindText ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> T.Text
    -- ^ /@text@/: the text to search for (UTF-8 encoded)
    -> m [Poppler.Rectangle.Rectangle]
    -- ^ __Returns:__ a t'GI.GLib.Structs.List.List' of t'GI.Poppler.Structs.Rectangle.Rectangle',
pageFindText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> Text -> m [Rectangle]
pageFindText a
page Text
text = IO [Rectangle] -> m [Rectangle]
forall a. IO a -> m a
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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr (GList (Ptr Rectangle))
result <- Ptr Page -> CString -> IO (Ptr (GList (Ptr Rectangle)))
poppler_page_find_text Ptr Page
page' CString
text'
    [Ptr Rectangle]
result' <- Ptr (GList (Ptr Rectangle)) -> IO [Ptr Rectangle]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Rectangle))
result
    [Rectangle]
result'' <- (Ptr Rectangle -> IO Rectangle)
-> [Ptr Rectangle] -> IO [Rectangle]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((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]
result'
    Ptr (GList (Ptr Rectangle)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Rectangle))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    [Rectangle] -> IO [Rectangle]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Rectangle]
result''

#if defined(ENABLE_OVERLOADING)
data PageFindTextMethodInfo
instance (signature ~ (T.Text -> m [Poppler.Rectangle.Rectangle]), MonadIO m, IsPage a) => O.OverloadedMethod PageFindTextMethodInfo a signature where
    overloadedMethod = pageFindText

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


#endif

-- method Page::find_text_with_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the text to search for (UTF-8 encoded)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FindFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "find options" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Poppler" , name = "Rectangle" }))
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_find_text_with_options" poppler_page_find_text_with_options :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    CString ->                              -- text : TBasicType TUTF8
    CUInt ->                                -- options : TInterface (Name {namespace = "Poppler", name = "FindFlags"})
    IO (Ptr (GList (Ptr Poppler.Rectangle.Rectangle)))

-- | Finds /@text@/ in /@page@/ with the given t'GI.Poppler.Flags.FindFlags' options and
-- returns a t'GI.GLib.Structs.List.List' of rectangles for each occurrence of the text on the page.
-- The coordinates are in PDF points.
-- 
-- When 'GI.Poppler.Flags.FindFlagsMultiline' is passed in /@options@/, matches may span more than
-- one line. In this case, the returned list will contain one t'GI.Poppler.Structs.Rectangle.Rectangle'
-- for each part of a match. The function 'GI.Poppler.Structs.Rectangle.rectangleFindGetMatchContinued'
-- will return 'P.True' for all rectangles belonging to the same match, except for
-- the last one. If a hyphen was ignored at the end of the part of the match,
-- 'GI.Poppler.Structs.Rectangle.rectangleFindGetIgnoredHyphen' will return 'P.True' for that
-- rectangle.
-- 
-- Note that currently matches spanning more than two lines are not found.
-- (This limitation may be lifted in a future version.)
-- 
-- Note also that currently finding multi-line matches backwards is not
-- implemented; if you pass 'GI.Poppler.Flags.FindFlagsBackwards' and 'GI.Poppler.Flags.FindFlagsMultiline'
-- together, 'GI.Poppler.Flags.FindFlagsMultiline' will be ignored.
-- 
-- /Since: 0.22/
pageFindTextWithOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> T.Text
    -- ^ /@text@/: the text to search for (UTF-8 encoded)
    -> [Poppler.Flags.FindFlags]
    -- ^ /@options@/: find options
    -> m [Poppler.Rectangle.Rectangle]
    -- ^ __Returns:__ a newly allocated list
    -- of newly allocated t'GI.Poppler.Structs.Rectangle.Rectangle'. Free with @/g_list_free_full()/@ using 'GI.Poppler.Structs.Rectangle.rectangleFree'.
pageFindTextWithOptions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> Text -> [FindFlags] -> m [Rectangle]
pageFindTextWithOptions a
page Text
text [FindFlags]
options = IO [Rectangle] -> m [Rectangle]
forall a. IO a -> m a
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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    CString
text' <- Text -> IO CString
textToCString Text
text
    let options' :: CUInt
options' = [FindFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FindFlags]
options
    Ptr (GList (Ptr Rectangle))
result <- Ptr Page -> CString -> CUInt -> IO (Ptr (GList (Ptr Rectangle)))
poppler_page_find_text_with_options Ptr Page
page' CString
text' CUInt
options'
    [Ptr Rectangle]
result' <- Ptr (GList (Ptr Rectangle)) -> IO [Ptr Rectangle]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Rectangle))
result
    [Rectangle]
result'' <- (Ptr Rectangle -> IO Rectangle)
-> [Ptr Rectangle] -> IO [Rectangle]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((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]
result'
    Ptr (GList (Ptr Rectangle)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Rectangle))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    [Rectangle] -> IO [Rectangle]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Rectangle]
result''

#if defined(ENABLE_OVERLOADING)
data PageFindTextWithOptionsMethodInfo
instance (signature ~ (T.Text -> [Poppler.Flags.FindFlags] -> m [Poppler.Rectangle.Rectangle]), MonadIO m, IsPage a) => O.OverloadedMethod PageFindTextWithOptionsMethodInfo a signature where
    overloadedMethod = pageFindTextWithOptions

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


#endif

-- method Page::get_annot_mapping
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface
--                     Name { namespace = "Poppler" , name = "AnnotMapping" }))
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_annot_mapping" poppler_page_get_annot_mapping :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    IO (Ptr (GList (Ptr Poppler.AnnotMapping.AnnotMapping)))

-- | Returns a list of t'GI.Poppler.Structs.AnnotMapping.AnnotMapping' items that map from a location on
-- /@page@/ to a t'GI.Poppler.Objects.Annot.Annot'.  This list must be freed with
-- 'GI.Poppler.Objects.Page.pageFreeAnnotMapping' when done.
pageGetAnnotMapping ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: A t'GI.Poppler.Objects.Page.Page'
    -> m [Poppler.AnnotMapping.AnnotMapping]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of t'GI.Poppler.Structs.AnnotMapping.AnnotMapping'
pageGetAnnotMapping :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m [AnnotMapping]
pageGetAnnotMapping a
page = IO [AnnotMapping] -> m [AnnotMapping]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AnnotMapping] -> m [AnnotMapping])
-> IO [AnnotMapping] -> m [AnnotMapping]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr (GList (Ptr AnnotMapping))
result <- Ptr Page -> IO (Ptr (GList (Ptr AnnotMapping)))
poppler_page_get_annot_mapping Ptr Page
page'
    [Ptr AnnotMapping]
result' <- Ptr (GList (Ptr AnnotMapping)) -> IO [Ptr AnnotMapping]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr AnnotMapping))
result
    [AnnotMapping]
result'' <- (Ptr AnnotMapping -> IO AnnotMapping)
-> [Ptr AnnotMapping] -> IO [AnnotMapping]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr AnnotMapping -> AnnotMapping)
-> Ptr AnnotMapping -> IO AnnotMapping
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr AnnotMapping -> AnnotMapping
Poppler.AnnotMapping.AnnotMapping) [Ptr AnnotMapping]
result'
    Ptr (GList (Ptr AnnotMapping)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr AnnotMapping))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    [AnnotMapping] -> IO [AnnotMapping]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [AnnotMapping]
result''

#if defined(ENABLE_OVERLOADING)
data PageGetAnnotMappingMethodInfo
instance (signature ~ (m [Poppler.AnnotMapping.AnnotMapping]), MonadIO m, IsPage a) => O.OverloadedMethod PageGetAnnotMappingMethodInfo a signature where
    overloadedMethod = pageGetAnnotMapping

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


#endif

-- method Page::get_bounding_box
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_bounding_box" poppler_page_get_bounding_box :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr Poppler.Rectangle.Rectangle ->      -- rect : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO CInt

-- | /No description available in the introspection data./
pageGetBoundingBox ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -> Poppler.Rectangle.Rectangle
    -> m Bool
pageGetBoundingBox :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> Rectangle -> m Bool
pageGetBoundingBox a
page Rectangle
rect = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Rectangle
rect' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
rect
    CInt
result <- Ptr Page -> Ptr Rectangle -> IO CInt
poppler_page_get_bounding_box Ptr Page
page' Ptr Rectangle
rect'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
rect
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PageGetBoundingBoxMethodInfo
instance (signature ~ (Poppler.Rectangle.Rectangle -> m Bool), MonadIO m, IsPage a) => O.OverloadedMethod PageGetBoundingBoxMethodInfo a signature where
    overloadedMethod = pageGetBoundingBox

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


#endif

-- method Page::get_crop_box
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rect"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerRectangle to fill"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_crop_box" poppler_page_get_crop_box :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr Poppler.Rectangle.Rectangle ->      -- rect : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO ()

-- | Retrurns the crop box of /@page@/
pageGetCropBox ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> m (Poppler.Rectangle.Rectangle)
pageGetCropBox :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m Rectangle
pageGetCropBox a
page = IO Rectangle -> m Rectangle
forall a. IO a -> m a
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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Rectangle
rect <- Int -> IO (Ptr Rectangle)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
32 :: IO (Ptr Poppler.Rectangle.Rectangle)
    Ptr Page -> Ptr Rectangle -> IO ()
poppler_page_get_crop_box Ptr Page
page' Ptr Rectangle
rect
    Rectangle
rect' <- ((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
rect
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Rectangle -> IO Rectangle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
rect'

#if defined(ENABLE_OVERLOADING)
data PageGetCropBoxMethodInfo
instance (signature ~ (m (Poppler.Rectangle.Rectangle)), MonadIO m, IsPage a) => O.OverloadedMethod PageGetCropBoxMethodInfo a signature where
    overloadedMethod = pageGetCropBox

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


#endif

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

foreign import ccall "poppler_page_get_duration" poppler_page_get_duration :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    IO CDouble

-- | Returns the duration of /@page@/
pageGetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> m Double
    -- ^ __Returns:__ duration in seconds of /@page@/ or -1.
pageGetDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m Double
pageGetDuration a
page = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    CDouble
result <- Ptr Page -> IO CDouble
poppler_page_get_duration Ptr Page
page'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data PageGetDurationMethodInfo
instance (signature ~ (m Double), MonadIO m, IsPage a) => O.OverloadedMethod PageGetDurationMethodInfo a signature where
    overloadedMethod = pageGetDuration

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


#endif

-- method Page::get_form_field_mapping
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface
--                     Name { namespace = "Poppler" , name = "FormFieldMapping" }))
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_form_field_mapping" poppler_page_get_form_field_mapping :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    IO (Ptr (GList (Ptr Poppler.FormFieldMapping.FormFieldMapping)))

-- | Returns a list of t'GI.Poppler.Structs.FormFieldMapping.FormFieldMapping' items that map from a
-- location on /@page@/ to a form field.  This list must be freed
-- with 'GI.Poppler.Objects.Page.pageFreeFormFieldMapping' when done.
pageGetFormFieldMapping ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: A t'GI.Poppler.Objects.Page.Page'
    -> m [Poppler.FormFieldMapping.FormFieldMapping]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of t'GI.Poppler.Structs.FormFieldMapping.FormFieldMapping'
pageGetFormFieldMapping :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m [FormFieldMapping]
pageGetFormFieldMapping a
page = IO [FormFieldMapping] -> m [FormFieldMapping]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FormFieldMapping] -> m [FormFieldMapping])
-> IO [FormFieldMapping] -> m [FormFieldMapping]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr (GList (Ptr FormFieldMapping))
result <- Ptr Page -> IO (Ptr (GList (Ptr FormFieldMapping)))
poppler_page_get_form_field_mapping Ptr Page
page'
    [Ptr FormFieldMapping]
result' <- Ptr (GList (Ptr FormFieldMapping)) -> IO [Ptr FormFieldMapping]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr FormFieldMapping))
result
    [FormFieldMapping]
result'' <- (Ptr FormFieldMapping -> IO FormFieldMapping)
-> [Ptr FormFieldMapping] -> IO [FormFieldMapping]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr FormFieldMapping -> FormFieldMapping)
-> Ptr FormFieldMapping -> IO FormFieldMapping
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FormFieldMapping -> FormFieldMapping
Poppler.FormFieldMapping.FormFieldMapping) [Ptr FormFieldMapping]
result'
    Ptr (GList (Ptr FormFieldMapping)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr FormFieldMapping))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    [FormFieldMapping] -> IO [FormFieldMapping]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FormFieldMapping]
result''

#if defined(ENABLE_OVERLOADING)
data PageGetFormFieldMappingMethodInfo
instance (signature ~ (m [Poppler.FormFieldMapping.FormFieldMapping]), MonadIO m, IsPage a) => O.OverloadedMethod PageGetFormFieldMappingMethodInfo a signature where
    overloadedMethod = pageGetFormFieldMapping

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


#endif

-- method Page::get_image
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "image_id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The image identifier"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "cairo" , name = "Surface" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_image" poppler_page_get_image :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Int32 ->                                -- image_id : TBasicType TInt
    IO (Ptr Cairo.Surface.Surface)

-- | Returns a cairo surface for the image of the /@page@/
pageGetImage ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: A t'GI.Poppler.Objects.Page.Page'
    -> Int32
    -- ^ /@imageId@/: The image identifier
    -> m Cairo.Surface.Surface
    -- ^ __Returns:__ A cairo surface for the image
pageGetImage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> Int32 -> m Surface
pageGetImage a
page Int32
imageId = IO Surface -> m Surface
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Surface -> m Surface) -> IO Surface -> m Surface
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Surface
result <- Ptr Page -> Int32 -> IO (Ptr Surface)
poppler_page_get_image Ptr Page
page' Int32
imageId
    Text -> Ptr Surface -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pageGetImage" Ptr Surface
result
    Surface
result' <- ((ManagedPtr Surface -> Surface) -> Ptr Surface -> IO Surface
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Surface -> Surface
Cairo.Surface.Surface) Ptr Surface
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Surface -> IO Surface
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Surface
result'

#if defined(ENABLE_OVERLOADING)
data PageGetImageMethodInfo
instance (signature ~ (Int32 -> m Cairo.Surface.Surface), MonadIO m, IsPage a) => O.OverloadedMethod PageGetImageMethodInfo a signature where
    overloadedMethod = pageGetImage

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


#endif

-- method Page::get_image_mapping
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface
--                     Name { namespace = "Poppler" , name = "ImageMapping" }))
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_image_mapping" poppler_page_get_image_mapping :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    IO (Ptr (GList (Ptr Poppler.ImageMapping.ImageMapping)))

-- | Returns a list of t'GI.Poppler.Structs.ImageMapping.ImageMapping' items that map from a
-- location on /@page@/ to an image of the page. This list must be freed
-- with 'GI.Poppler.Objects.Page.pageFreeImageMapping' when done.
pageGetImageMapping ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: A t'GI.Poppler.Objects.Page.Page'
    -> m [Poppler.ImageMapping.ImageMapping]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of t'GI.Poppler.Structs.ImageMapping.ImageMapping'
pageGetImageMapping :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m [ImageMapping]
pageGetImageMapping a
page = IO [ImageMapping] -> m [ImageMapping]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ImageMapping] -> m [ImageMapping])
-> IO [ImageMapping] -> m [ImageMapping]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr (GList (Ptr ImageMapping))
result <- Ptr Page -> IO (Ptr (GList (Ptr ImageMapping)))
poppler_page_get_image_mapping Ptr Page
page'
    [Ptr ImageMapping]
result' <- Ptr (GList (Ptr ImageMapping)) -> IO [Ptr ImageMapping]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr ImageMapping))
result
    [ImageMapping]
result'' <- (Ptr ImageMapping -> IO ImageMapping)
-> [Ptr ImageMapping] -> IO [ImageMapping]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr ImageMapping -> ImageMapping)
-> Ptr ImageMapping -> IO ImageMapping
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ImageMapping -> ImageMapping
Poppler.ImageMapping.ImageMapping) [Ptr ImageMapping]
result'
    Ptr (GList (Ptr ImageMapping)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr ImageMapping))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    [ImageMapping] -> IO [ImageMapping]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ImageMapping]
result''

#if defined(ENABLE_OVERLOADING)
data PageGetImageMappingMethodInfo
instance (signature ~ (m [Poppler.ImageMapping.ImageMapping]), MonadIO m, IsPage a) => O.OverloadedMethod PageGetImageMappingMethodInfo a signature where
    overloadedMethod = pageGetImageMapping

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


#endif

-- method Page::get_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerPage" , 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_page_get_index" poppler_page_get_index :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    IO Int32

-- | Returns the index of /@page@/
pageGetIndex ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> m Int32
    -- ^ __Returns:__ index value of /@page@/
pageGetIndex :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m Int32
pageGetIndex a
page = IO Int32 -> m Int32
forall a. IO a -> m a
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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Int32
result <- Ptr Page -> IO Int32
poppler_page_get_index Ptr Page
page'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data PageGetIndexMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsPage a) => O.OverloadedMethod PageGetIndexMethodInfo a signature where
    overloadedMethod = pageGetIndex

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


#endif

-- method Page::get_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerPage" , 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_page_get_label" poppler_page_get_label :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    IO CString

-- | Returns the label of /@page@/. Note that page labels
-- and page indices might not coincide.
-- 
-- /Since: 0.16/
pageGetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string containing the label of /@page@/,
    --               or 'P.Nothing' if /@page@/ doesn\'t have a label
pageGetLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m Text
pageGetLabel a
page = IO Text -> m Text
forall a. IO a -> m a
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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    CString
result <- Ptr Page -> IO CString
poppler_page_get_label Ptr Page
page'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pageGetLabel" 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
page
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PageGetLabelMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPage a) => O.OverloadedMethod PageGetLabelMethodInfo a signature where
    overloadedMethod = pageGetLabel

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


#endif

-- method Page::get_link_mapping
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Poppler" , name = "LinkMapping" }))
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_link_mapping" poppler_page_get_link_mapping :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    IO (Ptr (GList (Ptr Poppler.LinkMapping.LinkMapping)))

-- | Returns a list of t'GI.Poppler.Structs.LinkMapping.LinkMapping' items that map from a
-- location on /@page@/ to a t'GI.Poppler.Unions.Action.Action'.  This list must be freed
-- with 'GI.Poppler.Objects.Page.pageFreeLinkMapping' when done.
pageGetLinkMapping ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: A t'GI.Poppler.Objects.Page.Page'
    -> m [Poppler.LinkMapping.LinkMapping]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of t'GI.Poppler.Structs.LinkMapping.LinkMapping'
pageGetLinkMapping :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m [LinkMapping]
pageGetLinkMapping a
page = IO [LinkMapping] -> m [LinkMapping]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [LinkMapping] -> m [LinkMapping])
-> IO [LinkMapping] -> m [LinkMapping]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr (GList (Ptr LinkMapping))
result <- Ptr Page -> IO (Ptr (GList (Ptr LinkMapping)))
poppler_page_get_link_mapping Ptr Page
page'
    [Ptr LinkMapping]
result' <- Ptr (GList (Ptr LinkMapping)) -> IO [Ptr LinkMapping]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr LinkMapping))
result
    [LinkMapping]
result'' <- (Ptr LinkMapping -> IO LinkMapping)
-> [Ptr LinkMapping] -> IO [LinkMapping]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr LinkMapping -> LinkMapping)
-> Ptr LinkMapping -> IO LinkMapping
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr LinkMapping -> LinkMapping
Poppler.LinkMapping.LinkMapping) [Ptr LinkMapping]
result'
    Ptr (GList (Ptr LinkMapping)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr LinkMapping))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    [LinkMapping] -> IO [LinkMapping]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [LinkMapping]
result''

#if defined(ENABLE_OVERLOADING)
data PageGetLinkMappingMethodInfo
instance (signature ~ (m [Poppler.LinkMapping.LinkMapping]), MonadIO m, IsPage a) => O.OverloadedMethod PageGetLinkMappingMethodInfo a signature where
    overloadedMethod = pageGetLinkMapping

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


#endif

-- method Page::get_selected_region
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scale"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "scale specified as pixels per point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "style"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "SelectionStyle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerSelectionStyle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "selection"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "start and end point of selection as a rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "cairo" , name = "Region" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_selected_region" poppler_page_get_selected_region :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    CDouble ->                              -- scale : TBasicType TDouble
    CUInt ->                                -- style : TInterface (Name {namespace = "Poppler", name = "SelectionStyle"})
    Ptr Poppler.Rectangle.Rectangle ->      -- selection : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO (Ptr Cairo.Region.Region)

-- | Returns a region containing the area that would be rendered by
-- 'GI.Poppler.Objects.Page.pageRenderSelection'.
-- The returned region must be freed with @/cairo_region_destroy()/@
-- 
-- /Since: 0.16/
pageGetSelectedRegion ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> Double
    -- ^ /@scale@/: scale specified as pixels per point
    -> Poppler.Enums.SelectionStyle
    -- ^ /@style@/: a t'GI.Poppler.Enums.SelectionStyle'
    -> Poppler.Rectangle.Rectangle
    -- ^ /@selection@/: start and end point of selection as a rectangle
    -> m Cairo.Region.Region
    -- ^ __Returns:__ a cairo_region_t
pageGetSelectedRegion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> Double -> SelectionStyle -> Rectangle -> m Region
pageGetSelectedRegion a
page Double
scale SelectionStyle
style Rectangle
selection = IO Region -> m Region
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Region -> m Region) -> IO Region -> m Region
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    let scale' :: CDouble
scale' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
scale
    let style' :: CUInt
style' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (SelectionStyle -> Int) -> SelectionStyle -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionStyle -> Int
forall a. Enum a => a -> Int
fromEnum) SelectionStyle
style
    Ptr Rectangle
selection' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
selection
    Ptr Region
result <- Ptr Page -> CDouble -> CUInt -> Ptr Rectangle -> IO (Ptr Region)
poppler_page_get_selected_region Ptr Page
page' CDouble
scale' CUInt
style' Ptr Rectangle
selection'
    Text -> Ptr Region -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pageGetSelectedRegion" Ptr Region
result
    Region
result' <- ((ManagedPtr Region -> Region) -> Ptr Region -> IO Region
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Region -> Region
Cairo.Region.Region) Ptr Region
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
selection
    Region -> IO Region
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Region
result'

#if defined(ENABLE_OVERLOADING)
data PageGetSelectedRegionMethodInfo
instance (signature ~ (Double -> Poppler.Enums.SelectionStyle -> Poppler.Rectangle.Rectangle -> m Cairo.Region.Region), MonadIO m, IsPage a) => O.OverloadedMethod PageGetSelectedRegionMethodInfo a signature where
    overloadedMethod = pageGetSelectedRegion

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


#endif

-- method Page::get_selected_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "style"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "SelectionStyle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerSelectionStyle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "selection"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #PopplerRectangle including the text"
--                 , 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_page_get_selected_text" poppler_page_get_selected_text :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    CUInt ->                                -- style : TInterface (Name {namespace = "Poppler", name = "SelectionStyle"})
    Ptr Poppler.Rectangle.Rectangle ->      -- selection : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO CString

-- | Retrieves the contents of the specified /@selection@/ as text.
-- 
-- /Since: 0.16/
pageGetSelectedText ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> Poppler.Enums.SelectionStyle
    -- ^ /@style@/: a t'GI.Poppler.Enums.SelectionStyle'
    -> Poppler.Rectangle.Rectangle
    -- ^ /@selection@/: the t'GI.Poppler.Structs.Rectangle.Rectangle' including the text
    -> m T.Text
    -- ^ __Returns:__ a pointer to the contents of the /@selection@/
    --               as a string
pageGetSelectedText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> SelectionStyle -> Rectangle -> m Text
pageGetSelectedText a
page SelectionStyle
style Rectangle
selection = IO Text -> m Text
forall a. IO a -> m a
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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    let style' :: CUInt
style' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (SelectionStyle -> Int) -> SelectionStyle -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionStyle -> Int
forall a. Enum a => a -> Int
fromEnum) SelectionStyle
style
    Ptr Rectangle
selection' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
selection
    CString
result <- Ptr Page -> CUInt -> Ptr Rectangle -> IO CString
poppler_page_get_selected_text Ptr Page
page' CUInt
style' Ptr Rectangle
selection'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pageGetSelectedText" 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
page
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
selection
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PageGetSelectedTextMethodInfo
instance (signature ~ (Poppler.Enums.SelectionStyle -> Poppler.Rectangle.Rectangle -> m T.Text), MonadIO m, IsPage a) => O.OverloadedMethod PageGetSelectedTextMethodInfo a signature where
    overloadedMethod = pageGetSelectedText

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


#endif

-- method Page::get_selection_region
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scale"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "scale specified as pixels per point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "style"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "SelectionStyle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerSelectionStyle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "selection"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "start and end point of selection as a rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Poppler" , name = "Rectangle" }))
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_selection_region" poppler_page_get_selection_region :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    CDouble ->                              -- scale : TBasicType TDouble
    CUInt ->                                -- style : TInterface (Name {namespace = "Poppler", name = "SelectionStyle"})
    Ptr Poppler.Rectangle.Rectangle ->      -- selection : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO (Ptr (GList (Ptr Poppler.Rectangle.Rectangle)))

{-# DEPRECATED pageGetSelectionRegion ["(Since version 0.16)","Use 'GI.Poppler.Objects.Page.pageGetSelectedRegion' instead."] #-}
-- | Returns a region containing the area that would be rendered by
-- 'GI.Poppler.Objects.Page.pageRenderSelection' as a t'GI.GLib.Structs.List.List' of
-- t'GI.Poppler.Structs.Rectangle.Rectangle'. The returned list must be freed with
-- 'GI.Poppler.Objects.Page.pageSelectionRegionFree'.
pageGetSelectionRegion ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> Double
    -- ^ /@scale@/: scale specified as pixels per point
    -> Poppler.Enums.SelectionStyle
    -- ^ /@style@/: a t'GI.Poppler.Enums.SelectionStyle'
    -> Poppler.Rectangle.Rectangle
    -- ^ /@selection@/: start and end point of selection as a rectangle
    -> m [Poppler.Rectangle.Rectangle]
    -- ^ __Returns:__ a t'GI.GLib.Structs.List.List' of t'GI.Poppler.Structs.Rectangle.Rectangle'
pageGetSelectionRegion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> Double -> SelectionStyle -> Rectangle -> m [Rectangle]
pageGetSelectionRegion a
page Double
scale SelectionStyle
style Rectangle
selection = IO [Rectangle] -> m [Rectangle]
forall a. IO a -> m a
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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    let scale' :: CDouble
scale' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
scale
    let style' :: CUInt
style' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (SelectionStyle -> Int) -> SelectionStyle -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionStyle -> Int
forall a. Enum a => a -> Int
fromEnum) SelectionStyle
style
    Ptr Rectangle
selection' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
selection
    Ptr (GList (Ptr Rectangle))
result <- Ptr Page
-> CDouble
-> CUInt
-> Ptr Rectangle
-> IO (Ptr (GList (Ptr Rectangle)))
poppler_page_get_selection_region Ptr Page
page' CDouble
scale' CUInt
style' Ptr Rectangle
selection'
    [Ptr Rectangle]
result' <- Ptr (GList (Ptr Rectangle)) -> IO [Ptr Rectangle]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Rectangle))
result
    [Rectangle]
result'' <- (Ptr Rectangle -> IO Rectangle)
-> [Ptr Rectangle] -> IO [Rectangle]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((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]
result'
    Ptr (GList (Ptr Rectangle)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Rectangle))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
selection
    [Rectangle] -> IO [Rectangle]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Rectangle]
result''

#if defined(ENABLE_OVERLOADING)
data PageGetSelectionRegionMethodInfo
instance (signature ~ (Double -> Poppler.Enums.SelectionStyle -> Poppler.Rectangle.Rectangle -> m [Poppler.Rectangle.Rectangle]), MonadIO m, IsPage a) => O.OverloadedMethod PageGetSelectionRegionMethodInfo a signature where
    overloadedMethod = pageGetSelectionRegion

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


#endif

-- method Page::get_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the width of @page"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the height of @page"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_size" poppler_page_get_size :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr CDouble ->                          -- width : TBasicType TDouble
    Ptr CDouble ->                          -- height : TBasicType TDouble
    IO ()

-- | Gets the size of /@page@/ at the current scale and rotation.
pageGetSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: A t'GI.Poppler.Objects.Page.Page'
    -> m ((Double, Double))
pageGetSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m (Double, Double)
pageGetSize a
page = IO (Double, Double) -> m (Double, Double)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, Double) -> m (Double, Double))
-> IO (Double, Double) -> m (Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr CDouble
width <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
height <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr Page -> Ptr CDouble -> Ptr CDouble -> IO ()
poppler_page_get_size Ptr Page
page' Ptr CDouble
width Ptr CDouble
height
    CDouble
width' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
width
    let width'' :: Double
width'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
width'
    CDouble
height' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
height
    let height'' :: Double
height'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
height'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
width
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
height
    (Double, Double) -> IO (Double, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
width'', Double
height'')

#if defined(ENABLE_OVERLOADING)
data PageGetSizeMethodInfo
instance (signature ~ (m ((Double, Double))), MonadIO m, IsPage a) => O.OverloadedMethod PageGetSizeMethodInfo a signature where
    overloadedMethod = pageGetSize

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


#endif

-- method Page::get_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerPage" , 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_page_get_text" poppler_page_get_text :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    IO CString

-- | Retrieves the text of /@page@/.
-- 
-- /Since: 0.16/
pageGetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> m T.Text
    -- ^ __Returns:__ a pointer to the text of the /@page@/
    --               as a string
pageGetText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m Text
pageGetText a
page = IO Text -> m Text
forall a. IO a -> m a
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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    CString
result <- Ptr Page -> IO CString
poppler_page_get_text Ptr Page
page'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pageGetText" 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
page
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PageGetTextMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPage a) => O.OverloadedMethod PageGetTextMethodInfo a signature where
    overloadedMethod = pageGetText

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


#endif

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

foreign import ccall "poppler_page_get_text_attributes" poppler_page_get_text_attributes :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    IO (Ptr (GList (Ptr Poppler.TextAttributes.TextAttributes)))

-- | Obtains the attributes of the text as a t'GI.GLib.Structs.List.List' of t'GI.Poppler.Structs.TextAttributes.TextAttributes'.
-- This list must be freed with 'GI.Poppler.Objects.Page.pageFreeTextAttributes' when done.
-- 
-- Each list element is a t'GI.Poppler.Structs.TextAttributes.TextAttributes' struct where start_index and
-- end_index indicates the range of text (as returned by 'GI.Poppler.Objects.Page.pageGetText')
-- to which text attributes apply.
-- 
-- See also 'GI.Poppler.Objects.Page.pageGetTextAttributesForArea'
-- 
-- /Since: 0.18/
pageGetTextAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: A t'GI.Poppler.Objects.Page.Page'
    -> m [Poppler.TextAttributes.TextAttributes]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of t'GI.Poppler.Structs.TextAttributes.TextAttributes'
pageGetTextAttributes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m [TextAttributes]
pageGetTextAttributes a
page = IO [TextAttributes] -> m [TextAttributes]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TextAttributes] -> m [TextAttributes])
-> IO [TextAttributes] -> m [TextAttributes]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr (GList (Ptr TextAttributes))
result <- Ptr Page -> IO (Ptr (GList (Ptr TextAttributes)))
poppler_page_get_text_attributes Ptr Page
page'
    [Ptr TextAttributes]
result' <- Ptr (GList (Ptr TextAttributes)) -> IO [Ptr TextAttributes]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr TextAttributes))
result
    [TextAttributes]
result'' <- (Ptr TextAttributes -> IO TextAttributes)
-> [Ptr TextAttributes] -> IO [TextAttributes]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr TextAttributes -> TextAttributes)
-> Ptr TextAttributes -> IO TextAttributes
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TextAttributes -> TextAttributes
Poppler.TextAttributes.TextAttributes) [Ptr TextAttributes]
result'
    Ptr (GList (Ptr TextAttributes)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr TextAttributes))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    [TextAttributes] -> IO [TextAttributes]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [TextAttributes]
result''

#if defined(ENABLE_OVERLOADING)
data PageGetTextAttributesMethodInfo
instance (signature ~ (m [Poppler.TextAttributes.TextAttributes]), MonadIO m, IsPage a) => O.OverloadedMethod PageGetTextAttributesMethodInfo a signature where
    overloadedMethod = pageGetTextAttributes

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


#endif

-- method Page::get_text_attributes_for_area
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "area"
--           , 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
--               (TGList
--                  (TInterface
--                     Name { namespace = "Poppler" , name = "TextAttributes" }))
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_text_attributes_for_area" poppler_page_get_text_attributes_for_area :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr Poppler.Rectangle.Rectangle ->      -- area : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO (Ptr (GList (Ptr Poppler.TextAttributes.TextAttributes)))

-- | Obtains the attributes of the text in /@area@/ as a t'GI.GLib.Structs.List.List' of t'GI.Poppler.Structs.TextAttributes.TextAttributes'.
-- This list must be freed with 'GI.Poppler.Objects.Page.pageFreeTextAttributes' when done.
-- 
-- Each list element is a t'GI.Poppler.Structs.TextAttributes.TextAttributes' struct where start_index and
-- end_index indicates the range of text (as returned by 'GI.Poppler.Objects.Page.pageGetTextForArea')
-- to which text attributes apply.
-- 
-- /Since: 0.26/
pageGetTextAttributesForArea ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: A t'GI.Poppler.Objects.Page.Page'
    -> Poppler.Rectangle.Rectangle
    -- ^ /@area@/: a t'GI.Poppler.Structs.Rectangle.Rectangle'
    -> m [Poppler.TextAttributes.TextAttributes]
    -- ^ __Returns:__ A t'GI.GLib.Structs.List.List' of t'GI.Poppler.Structs.TextAttributes.TextAttributes'
pageGetTextAttributesForArea :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> Rectangle -> m [TextAttributes]
pageGetTextAttributesForArea a
page Rectangle
area = IO [TextAttributes] -> m [TextAttributes]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TextAttributes] -> m [TextAttributes])
-> IO [TextAttributes] -> m [TextAttributes]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Rectangle
area' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
area
    Ptr (GList (Ptr TextAttributes))
result <- Ptr Page -> Ptr Rectangle -> IO (Ptr (GList (Ptr TextAttributes)))
poppler_page_get_text_attributes_for_area Ptr Page
page' Ptr Rectangle
area'
    [Ptr TextAttributes]
result' <- Ptr (GList (Ptr TextAttributes)) -> IO [Ptr TextAttributes]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr TextAttributes))
result
    [TextAttributes]
result'' <- (Ptr TextAttributes -> IO TextAttributes)
-> [Ptr TextAttributes] -> IO [TextAttributes]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr TextAttributes -> TextAttributes)
-> Ptr TextAttributes -> IO TextAttributes
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TextAttributes -> TextAttributes
Poppler.TextAttributes.TextAttributes) [Ptr TextAttributes]
result'
    Ptr (GList (Ptr TextAttributes)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr TextAttributes))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
area
    [TextAttributes] -> IO [TextAttributes]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [TextAttributes]
result''

#if defined(ENABLE_OVERLOADING)
data PageGetTextAttributesForAreaMethodInfo
instance (signature ~ (Poppler.Rectangle.Rectangle -> m [Poppler.TextAttributes.TextAttributes]), MonadIO m, IsPage a) => O.OverloadedMethod PageGetTextAttributesForAreaMethodInfo a signature where
    overloadedMethod = pageGetTextAttributesForArea

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


#endif

-- method Page::get_text_for_area
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "area"
--           , 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 (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_text_for_area" poppler_page_get_text_for_area :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr Poppler.Rectangle.Rectangle ->      -- area : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO CString

-- | Retrieves the text of /@page@/ contained in /@area@/.
-- 
-- /Since: 0.26/
pageGetTextForArea ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> Poppler.Rectangle.Rectangle
    -- ^ /@area@/: a t'GI.Poppler.Structs.Rectangle.Rectangle'
    -> m T.Text
    -- ^ __Returns:__ a pointer to the text as a string
pageGetTextForArea :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> Rectangle -> m Text
pageGetTextForArea a
page Rectangle
area = IO Text -> m Text
forall a. IO a -> m a
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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Rectangle
area' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
area
    CString
result <- Ptr Page -> Ptr Rectangle -> IO CString
poppler_page_get_text_for_area Ptr Page
page' Ptr Rectangle
area'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pageGetTextForArea" 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
page
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
area
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PageGetTextForAreaMethodInfo
instance (signature ~ (Poppler.Rectangle.Rectangle -> m T.Text), MonadIO m, IsPage a) => O.OverloadedMethod PageGetTextForAreaMethodInfo a signature where
    overloadedMethod = pageGetTextForArea

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


#endif

-- method Page::get_text_layout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rectangles"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Poppler" , name = "Rectangle" })
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for an array of #PopplerRectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferContainer
--           }
--       , Arg
--           { argCName = "n_rectangles"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "length of returned array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_rectangles"
--              , argType = TBasicType TUInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "length of returned array"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_text_layout" poppler_page_get_text_layout :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr (Ptr Poppler.Rectangle.Rectangle) -> -- rectangles : TCArray False (-1) 2 (TInterface (Name {namespace = "Poppler", name = "Rectangle"}))
    Ptr Word32 ->                           -- n_rectangles : TBasicType TUInt
    IO CInt

-- | Obtains the layout of the text as a list of t'GI.Poppler.Structs.Rectangle.Rectangle'
-- This array must be freed with 'GI.GLib.Functions.free' when done.
-- 
-- The position in the array represents an offset in the text returned by
-- 'GI.Poppler.Objects.Page.pageGetText'
-- 
-- See also 'GI.Poppler.Objects.Page.pageGetTextLayoutForArea'.
-- 
-- /Since: 0.16/
pageGetTextLayout ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: A t'GI.Poppler.Objects.Page.Page'
    -> m ((Bool, [Poppler.Rectangle.Rectangle]))
    -- ^ __Returns:__ 'P.True' if the page contains text, 'P.False' otherwise
pageGetTextLayout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m (Bool, [Rectangle])
pageGetTextLayout a
page = IO (Bool, [Rectangle]) -> m (Bool, [Rectangle])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, [Rectangle]) -> m (Bool, [Rectangle]))
-> IO (Bool, [Rectangle]) -> m (Bool, [Rectangle])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr (Ptr Rectangle)
rectangles <- IO (Ptr (Ptr Rectangle))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Poppler.Rectangle.Rectangle))
    Ptr Word32
nRectangles <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Page -> Ptr (Ptr Rectangle) -> Ptr Word32 -> IO CInt
poppler_page_get_text_layout Ptr Page
page' Ptr (Ptr Rectangle)
rectangles Ptr Word32
nRectangles
    Word32
nRectangles' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
nRectangles
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Rectangle
rectangles' <- Ptr (Ptr Rectangle) -> IO (Ptr Rectangle)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Rectangle)
rectangles
    [Ptr Rectangle]
rectangles'' <- (Int -> Word32 -> Ptr Rectangle -> IO [Ptr Rectangle]
forall a b.
(Integral a, GBoxed b) =>
Int -> a -> Ptr b -> IO [Ptr b]
unpackBoxedArrayWithLength Int
32 Word32
nRectangles') Ptr Rectangle
rectangles'
    [Rectangle]
rectangles''' <- (Ptr Rectangle -> IO Rectangle)
-> [Ptr Rectangle] -> IO [Rectangle]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((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]
rectangles''
    Ptr Rectangle -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Rectangle
rectangles'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Ptr (Ptr Rectangle) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Rectangle)
rectangles
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
nRectangles
    (Bool, [Rectangle]) -> IO (Bool, [Rectangle])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', [Rectangle]
rectangles''')

#if defined(ENABLE_OVERLOADING)
data PageGetTextLayoutMethodInfo
instance (signature ~ (m ((Bool, [Poppler.Rectangle.Rectangle]))), MonadIO m, IsPage a) => O.OverloadedMethod PageGetTextLayoutMethodInfo a signature where
    overloadedMethod = pageGetTextLayout

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


#endif

-- method Page::get_text_layout_for_area
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "area"
--           , 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
--           }
--       , Arg
--           { argCName = "rectangles"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 3
--                 (TInterface Name { namespace = "Poppler" , name = "Rectangle" })
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for an array of #PopplerRectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferContainer
--           }
--       , Arg
--           { argCName = "n_rectangles"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "length of returned array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_rectangles"
--              , argType = TBasicType TUInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "length of returned array"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_text_layout_for_area" poppler_page_get_text_layout_for_area :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr Poppler.Rectangle.Rectangle ->      -- area : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    Ptr (Ptr Poppler.Rectangle.Rectangle) -> -- rectangles : TCArray False (-1) 3 (TInterface (Name {namespace = "Poppler", name = "Rectangle"}))
    Ptr Word32 ->                           -- n_rectangles : TBasicType TUInt
    IO CInt

-- | Obtains the layout of the text contained in /@area@/ as a list of t'GI.Poppler.Structs.Rectangle.Rectangle'
-- This array must be freed with 'GI.GLib.Functions.free' when done.
-- 
-- The position in the array represents an offset in the text returned by
-- 'GI.Poppler.Objects.Page.pageGetTextForArea'
-- 
-- /Since: 0.26/
pageGetTextLayoutForArea ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: A t'GI.Poppler.Objects.Page.Page'
    -> Poppler.Rectangle.Rectangle
    -- ^ /@area@/: a t'GI.Poppler.Structs.Rectangle.Rectangle'
    -> m ((Bool, [Poppler.Rectangle.Rectangle]))
    -- ^ __Returns:__ 'P.True' if the page contains text, 'P.False' otherwise
pageGetTextLayoutForArea :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> Rectangle -> m (Bool, [Rectangle])
pageGetTextLayoutForArea a
page Rectangle
area = IO (Bool, [Rectangle]) -> m (Bool, [Rectangle])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, [Rectangle]) -> m (Bool, [Rectangle]))
-> IO (Bool, [Rectangle]) -> m (Bool, [Rectangle])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Rectangle
area' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
area
    Ptr (Ptr Rectangle)
rectangles <- IO (Ptr (Ptr Rectangle))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Poppler.Rectangle.Rectangle))
    Ptr Word32
nRectangles <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr Page
-> Ptr Rectangle -> Ptr (Ptr Rectangle) -> Ptr Word32 -> IO CInt
poppler_page_get_text_layout_for_area Ptr Page
page' Ptr Rectangle
area' Ptr (Ptr Rectangle)
rectangles Ptr Word32
nRectangles
    Word32
nRectangles' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
nRectangles
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr Rectangle
rectangles' <- Ptr (Ptr Rectangle) -> IO (Ptr Rectangle)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Rectangle)
rectangles
    [Ptr Rectangle]
rectangles'' <- (Int -> Word32 -> Ptr Rectangle -> IO [Ptr Rectangle]
forall a b.
(Integral a, GBoxed b) =>
Int -> a -> Ptr b -> IO [Ptr b]
unpackBoxedArrayWithLength Int
32 Word32
nRectangles') Ptr Rectangle
rectangles'
    [Rectangle]
rectangles''' <- (Ptr Rectangle -> IO Rectangle)
-> [Ptr Rectangle] -> IO [Rectangle]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((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]
rectangles''
    Ptr Rectangle -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Rectangle
rectangles'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
area
    Ptr (Ptr Rectangle) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Rectangle)
rectangles
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
nRectangles
    (Bool, [Rectangle]) -> IO (Bool, [Rectangle])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', [Rectangle]
rectangles''')

#if defined(ENABLE_OVERLOADING)
data PageGetTextLayoutForAreaMethodInfo
instance (signature ~ (Poppler.Rectangle.Rectangle -> m ((Bool, [Poppler.Rectangle.Rectangle]))), MonadIO m, IsPage a) => O.OverloadedMethod PageGetTextLayoutForAreaMethodInfo a signature where
    overloadedMethod = pageGetTextLayoutForArea

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


#endif

-- method Page::get_thumbnail
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #PopplerPage to get the thumbnail for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "cairo" , name = "Surface" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_thumbnail" poppler_page_get_thumbnail :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    IO (Ptr Cairo.Surface.Surface)

-- | Get the embedded thumbnail for the specified page.  If the document
-- doesn\'t have an embedded thumbnail for the page, this function
-- returns 'P.Nothing'.
pageGetThumbnail ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: the t'GI.Poppler.Objects.Page.Page' to get the thumbnail for
    -> m Cairo.Surface.Surface
    -- ^ __Returns:__ the tumbnail as a cairo_surface_t or 'P.Nothing' if the document
    -- doesn\'t have a thumbnail for this page.
pageGetThumbnail :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m Surface
pageGetThumbnail a
page = IO Surface -> m Surface
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Surface -> m Surface) -> IO Surface -> m Surface
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Surface
result <- Ptr Page -> IO (Ptr Surface)
poppler_page_get_thumbnail Ptr Page
page'
    Text -> Ptr Surface -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pageGetThumbnail" Ptr Surface
result
    Surface
result' <- ((ManagedPtr Surface -> Surface) -> Ptr Surface -> IO Surface
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Surface -> Surface
Cairo.Surface.Surface) Ptr Surface
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Surface -> IO Surface
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Surface
result'

#if defined(ENABLE_OVERLOADING)
data PageGetThumbnailMethodInfo
instance (signature ~ (m Cairo.Surface.Surface), MonadIO m, IsPage a) => O.OverloadedMethod PageGetThumbnailMethodInfo a signature where
    overloadedMethod = pageGetThumbnail

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


#endif

-- method Page::get_thumbnail_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for width"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for height"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_get_thumbnail_size" poppler_page_get_thumbnail_size :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr Int32 ->                            -- width : TBasicType TInt
    Ptr Int32 ->                            -- height : TBasicType TInt
    IO CInt

-- | Returns 'P.True' if /@page@/ has a thumbnail associated with it.  It also
-- fills in /@width@/ and /@height@/ with the width and height of the
-- thumbnail.  The values of width and height are not changed if no
-- appropriate thumbnail exists.
pageGetThumbnailSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: A t'GI.Poppler.Objects.Page.Page'
    -> m ((Bool, Int32, Int32))
    -- ^ __Returns:__ 'P.True', if /@page@/ has a thumbnail associated with it.
pageGetThumbnailSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m (Bool, Int32, Int32)
pageGetThumbnailSize a
page = IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32))
-> IO (Bool, Int32, Int32) -> m (Bool, Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Int32
width <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
height <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    CInt
result <- Ptr Page -> Ptr Int32 -> Ptr Int32 -> IO CInt
poppler_page_get_thumbnail_size Ptr Page
page' Ptr Int32
width Ptr Int32
height
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Int32
width' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
width
    Int32
height' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
height
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
width
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
height
    (Bool, Int32, Int32) -> IO (Bool, Int32, Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Int32
width', Int32
height')

#if defined(ENABLE_OVERLOADING)
data PageGetThumbnailSizeMethodInfo
instance (signature ~ (m ((Bool, Int32, Int32))), MonadIO m, IsPage a) => O.OverloadedMethod PageGetThumbnailSizeMethodInfo a signature where
    overloadedMethod = pageGetThumbnailSize

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


#endif

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

foreign import ccall "poppler_page_get_transition" poppler_page_get_transition :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    IO (Ptr Poppler.PageTransition.PageTransition)

-- | Returns the transition effect of /@page@/
pageGetTransition ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> m Poppler.PageTransition.PageTransition
    -- ^ __Returns:__ a t'GI.Poppler.Structs.PageTransition.PageTransition' or 'P.Nothing'.
pageGetTransition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> m PageTransition
pageGetTransition a
page = IO PageTransition -> m PageTransition
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PageTransition -> m PageTransition)
-> IO PageTransition -> m PageTransition
forall a b. (a -> b) -> a -> b
$ do
    Ptr Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr PageTransition
result <- Ptr Page -> IO (Ptr PageTransition)
poppler_page_get_transition Ptr Page
page'
    Text -> Ptr PageTransition -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pageGetTransition" Ptr PageTransition
result
    PageTransition
result' <- ((ManagedPtr PageTransition -> PageTransition)
-> Ptr PageTransition -> IO PageTransition
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr PageTransition -> PageTransition
Poppler.PageTransition.PageTransition) Ptr PageTransition
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    PageTransition -> IO PageTransition
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PageTransition
result'

#if defined(ENABLE_OVERLOADING)
data PageGetTransitionMethodInfo
instance (signature ~ (m Poppler.PageTransition.PageTransition), MonadIO m, IsPage a) => O.OverloadedMethod PageGetTransitionMethodInfo a signature where
    overloadedMethod = pageGetTransition

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


#endif

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

foreign import ccall "poppler_page_remove_annot" poppler_page_remove_annot :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr Poppler.Annot.Annot ->              -- annot : TInterface (Name {namespace = "Poppler", name = "Annot"})
    IO ()

-- | Removes annotation /@annot@/ from /@page@/
-- 
-- /Since: 0.22/
pageRemoveAnnot ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a, Poppler.Annot.IsAnnot b) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> b
    -- ^ /@annot@/: a t'GI.Poppler.Objects.Annot.Annot' to remove
    -> m ()
pageRemoveAnnot :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPage a, IsAnnot b) =>
a -> b -> m ()
pageRemoveAnnot a
page b
annot = 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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Annot
annot' <- b -> IO (Ptr Annot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
annot
    Ptr Page -> Ptr Annot -> IO ()
poppler_page_remove_annot Ptr Page
page' Ptr Annot
annot'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
annot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PageRemoveAnnotMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPage a, Poppler.Annot.IsAnnot b) => O.OverloadedMethod PageRemoveAnnotMethodInfo a signature where
    overloadedMethod = pageRemoveAnnot

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


#endif

-- method Page::render
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the page to render from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cairo"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "cairo context to render to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_render" poppler_page_render :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr Cairo.Context.Context ->            -- cairo : TInterface (Name {namespace = "cairo", name = "Context"})
    IO ()

-- | Render the page to the given cairo context. This function
-- is for rendering a page that will be displayed. If you want
-- to render a page that will be printed use
-- 'GI.Poppler.Objects.Page.pageRenderForPrinting' instead.  Please see the documentation
-- for that function for the differences between rendering to the screen and
-- rendering to a printer.
pageRender ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: the page to render from
    -> Cairo.Context.Context
    -- ^ /@cairo@/: cairo context to render to
    -> m ()
pageRender :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> Context -> m ()
pageRender a
page Context
cairo = 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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Context
cairo' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cairo
    Ptr Page -> Ptr Context -> IO ()
poppler_page_render Ptr Page
page' Ptr Context
cairo'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cairo
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PageRenderMethodInfo
instance (signature ~ (Cairo.Context.Context -> m ()), MonadIO m, IsPage a) => O.OverloadedMethod PageRenderMethodInfo a signature where
    overloadedMethod = pageRender

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


#endif

-- method Page::render_for_printing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the page to render from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cairo"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "cairo context to render to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_render_for_printing" poppler_page_render_for_printing :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr Cairo.Context.Context ->            -- cairo : TInterface (Name {namespace = "cairo", name = "Context"})
    IO ()

-- | Render the page to the given cairo context for printing with
-- @/POPPLER_PRINT_ALL/@ flags selected.  If you want a different set of flags,
-- use 'GI.Poppler.Objects.Page.pageRenderForPrintingWithOptions'.
-- 
-- The difference between 'GI.Poppler.Objects.Page.pageRender' and this function is that some
-- things get rendered differently between screens and printers:
-- 
-- \<itemizedlist>
--   \<listitem>
--     PDF annotations get rendered according to their t'GI.Poppler.Flags.AnnotFlag' value.
--     For example, @/POPPLER_ANNOT_FLAG_PRINT/@ refers to whether an annotation
--     is printed or not, whereas @/POPPLER_ANNOT_FLAG_NO_VIEW/@ refers to whether
--     an annotation is invisible when displaying to the screen.
--   \<\/listitem>
--   \<listitem>
--     PDF supports \"hairlines\" of width 0.0, which often get rendered as
--     having a width of 1 device pixel.  When displaying on a screen, Cairo
--     may render such lines wide so that they are hard to see, and Poppler
--     makes use of PDF\'s Stroke Adjust graphics parameter to make the lines
--     easier to see.  However, when printing, Poppler is able to directly use a
--     printer\'s pixel size instead.
--   \<\/listitem>
--   \<listitem>
--     Some advanced features in PDF may require an image to be rasterized
--     before sending off to a printer.  This may produce raster images which
--     exceed Cairo\'s limits.  The \"printing\" functions will detect this condition
--     and try to down-scale the intermediate surfaces as appropriate.
--   \<\/listitem>
-- \<\/itemizedlist>
pageRenderForPrinting ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: the page to render from
    -> Cairo.Context.Context
    -- ^ /@cairo@/: cairo context to render to
    -> m ()
pageRenderForPrinting :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> Context -> m ()
pageRenderForPrinting a
page Context
cairo = 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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Context
cairo' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cairo
    Ptr Page -> Ptr Context -> IO ()
poppler_page_render_for_printing Ptr Page
page' Ptr Context
cairo'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cairo
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PageRenderForPrintingMethodInfo
instance (signature ~ (Cairo.Context.Context -> m ()), MonadIO m, IsPage a) => O.OverloadedMethod PageRenderForPrintingMethodInfo a signature where
    overloadedMethod = pageRenderForPrinting

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


#endif

-- method Page::render_for_printing_with_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the page to render from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cairo"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "cairo context to render to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "PrintFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "print options" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_render_for_printing_with_options" poppler_page_render_for_printing_with_options :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr Cairo.Context.Context ->            -- cairo : TInterface (Name {namespace = "cairo", name = "Context"})
    CUInt ->                                -- options : TInterface (Name {namespace = "Poppler", name = "PrintFlags"})
    IO ()

-- | Render the page to the given cairo context for printing
-- with the specified options
-- 
-- See the documentation for 'GI.Poppler.Objects.Page.pageRenderForPrinting' for the
-- differences between rendering to the screen and rendering to a printer.
-- 
-- /Since: 0.16/
pageRenderForPrintingWithOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: the page to render from
    -> Cairo.Context.Context
    -- ^ /@cairo@/: cairo context to render to
    -> [Poppler.Flags.PrintFlags]
    -- ^ /@options@/: print options
    -> m ()
pageRenderForPrintingWithOptions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a -> Context -> [PrintFlags] -> m ()
pageRenderForPrintingWithOptions a
page Context
cairo [PrintFlags]
options = 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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Context
cairo' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cairo
    let options' :: CUInt
options' = [PrintFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [PrintFlags]
options
    Ptr Page -> Ptr Context -> CUInt -> IO ()
poppler_page_render_for_printing_with_options Ptr Page
page' Ptr Context
cairo' CUInt
options'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cairo
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PageRenderForPrintingWithOptionsMethodInfo
instance (signature ~ (Cairo.Context.Context -> [Poppler.Flags.PrintFlags] -> m ()), MonadIO m, IsPage a) => O.OverloadedMethod PageRenderForPrintingWithOptionsMethodInfo a signature where
    overloadedMethod = pageRenderForPrintingWithOptions

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


#endif

-- method Page::render_selection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #PopplerPage for which to render selection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cairo"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "cairo context to render to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "selection"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "start and end point of selection as a rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "old_selection"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "previous selection" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "style"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "SelectionStyle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerSelectionStyle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "glyph_color"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "color to use for drawing glyphs"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "background_color"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Color" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "color to use for the selection background"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_render_selection" poppler_page_render_selection :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr Cairo.Context.Context ->            -- cairo : TInterface (Name {namespace = "cairo", name = "Context"})
    Ptr Poppler.Rectangle.Rectangle ->      -- selection : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    Ptr Poppler.Rectangle.Rectangle ->      -- old_selection : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    CUInt ->                                -- style : TInterface (Name {namespace = "Poppler", name = "SelectionStyle"})
    Ptr Poppler.Color.Color ->              -- glyph_color : TInterface (Name {namespace = "Poppler", name = "Color"})
    Ptr Poppler.Color.Color ->              -- background_color : TInterface (Name {namespace = "Poppler", name = "Color"})
    IO ()

-- | Render the selection specified by /@selection@/ for /@page@/ to
-- the given cairo context.  The selection will be rendered, using
-- /@glyphColor@/ for the glyphs and /@backgroundColor@/ for the selection
-- background.
-- 
-- If non-NULL, /@oldSelection@/ specifies the selection that is already
-- rendered to /@cairo@/, in which case this function will (some day)
-- only render the changed part of the selection.
pageRenderSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a) =>
    a
    -- ^ /@page@/: the t'GI.Poppler.Objects.Page.Page' for which to render selection
    -> Cairo.Context.Context
    -- ^ /@cairo@/: cairo context to render to
    -> Poppler.Rectangle.Rectangle
    -- ^ /@selection@/: start and end point of selection as a rectangle
    -> Poppler.Rectangle.Rectangle
    -- ^ /@oldSelection@/: previous selection
    -> Poppler.Enums.SelectionStyle
    -- ^ /@style@/: a t'GI.Poppler.Enums.SelectionStyle'
    -> Poppler.Color.Color
    -- ^ /@glyphColor@/: color to use for drawing glyphs
    -> Poppler.Color.Color
    -- ^ /@backgroundColor@/: color to use for the selection background
    -> m ()
pageRenderSelection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPage a) =>
a
-> Context
-> Rectangle
-> Rectangle
-> SelectionStyle
-> Color
-> Color
-> m ()
pageRenderSelection a
page Context
cairo Rectangle
selection Rectangle
oldSelection SelectionStyle
style Color
glyphColor Color
backgroundColor = 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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr Context
cairo' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cairo
    Ptr Rectangle
selection' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
selection
    Ptr Rectangle
oldSelection' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
oldSelection
    let style' :: CUInt
style' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (SelectionStyle -> Int) -> SelectionStyle -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionStyle -> Int
forall a. Enum a => a -> Int
fromEnum) SelectionStyle
style
    Ptr Color
glyphColor' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
glyphColor
    Ptr Color
backgroundColor' <- Color -> IO (Ptr Color)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Color
backgroundColor
    Ptr Page
-> Ptr Context
-> Ptr Rectangle
-> Ptr Rectangle
-> CUInt
-> Ptr Color
-> Ptr Color
-> IO ()
poppler_page_render_selection Ptr Page
page' Ptr Context
cairo' Ptr Rectangle
selection' Ptr Rectangle
oldSelection' CUInt
style' Ptr Color
glyphColor' Ptr Color
backgroundColor'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cairo
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
selection
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
oldSelection
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
glyphColor
    Color -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Color
backgroundColor
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PageRenderSelectionMethodInfo
instance (signature ~ (Cairo.Context.Context -> Poppler.Rectangle.Rectangle -> Poppler.Rectangle.Rectangle -> Poppler.Enums.SelectionStyle -> Poppler.Color.Color -> Poppler.Color.Color -> m ()), MonadIO m, IsPage a) => O.OverloadedMethod PageRenderSelectionMethodInfo a signature where
    overloadedMethod = pageRenderSelection

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


#endif

-- method Page::render_to_ps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "page"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Page" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ps_file"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "PSFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the PopplerPSFile to render to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_render_to_ps" poppler_page_render_to_ps :: 
    Ptr Page ->                             -- page : TInterface (Name {namespace = "Poppler", name = "Page"})
    Ptr Poppler.PSFile.PSFile ->            -- ps_file : TInterface (Name {namespace = "Poppler", name = "PSFile"})
    IO ()

-- | Render the page on a postscript file
pageRenderToPs ::
    (B.CallStack.HasCallStack, MonadIO m, IsPage a, Poppler.PSFile.IsPSFile b) =>
    a
    -- ^ /@page@/: a t'GI.Poppler.Objects.Page.Page'
    -> b
    -- ^ /@psFile@/: the PopplerPSFile to render to
    -> m ()
pageRenderToPs :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPage a, IsPSFile b) =>
a -> b -> m ()
pageRenderToPs a
page b
psFile = 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 Page
page' <- a -> IO (Ptr Page)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
page
    Ptr PSFile
psFile' <- b -> IO (Ptr PSFile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
psFile
    Ptr Page -> Ptr PSFile -> IO ()
poppler_page_render_to_ps Ptr Page
page' Ptr PSFile
psFile'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
page
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
psFile
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PageRenderToPsMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPage a, Poppler.PSFile.IsPSFile b) => O.OverloadedMethod PageRenderToPsMethodInfo a signature where
    overloadedMethod = pageRenderToPs

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


#endif

-- method Page::free_annot_mapping
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TGList
--                 (TInterface Name { namespace = "Poppler" , name = "AnnotMapping" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A list of\n  #PopplerAnnotMapping<!-- -->s"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_free_annot_mapping" poppler_page_free_annot_mapping :: 
    Ptr (GList (Ptr Poppler.AnnotMapping.AnnotMapping)) -> -- list : TGList (TInterface (Name {namespace = "Poppler", name = "AnnotMapping"}))
    IO ()

-- | Frees a list of t'GI.Poppler.Structs.AnnotMapping.AnnotMapping's allocated by
-- 'GI.Poppler.Objects.Page.pageGetAnnotMapping'.  It also unreferences the t'GI.Poppler.Objects.Annot.Annot's
-- that each mapping contains, so if you want to keep them around, you need to
-- reference them with 'GI.GObject.Objects.Object.objectRef'.
pageFreeAnnotMapping ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Poppler.AnnotMapping.AnnotMapping]
    -- ^ /@list@/: A list of
    --   t'GI.Poppler.Structs.AnnotMapping.AnnotMapping's
    -> m ()
pageFreeAnnotMapping :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[AnnotMapping] -> m ()
pageFreeAnnotMapping [AnnotMapping]
list = 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 AnnotMapping]
list' <- (AnnotMapping -> IO (Ptr AnnotMapping))
-> [AnnotMapping] -> IO [Ptr AnnotMapping]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AnnotMapping -> IO (Ptr AnnotMapping)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed [AnnotMapping]
list
    Ptr (GList (Ptr AnnotMapping))
list'' <- [Ptr AnnotMapping] -> IO (Ptr (GList (Ptr AnnotMapping)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr AnnotMapping]
list'
    Ptr (GList (Ptr AnnotMapping)) -> IO ()
poppler_page_free_annot_mapping Ptr (GList (Ptr AnnotMapping))
list''
    (AnnotMapping -> IO ()) -> [AnnotMapping] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AnnotMapping -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [AnnotMapping]
list
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Page::free_form_field_mapping
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TGList
--                 (TInterface
--                    Name { namespace = "Poppler" , name = "FormFieldMapping" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A list of\n  #PopplerFormFieldMapping<!-- -->s"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_free_form_field_mapping" poppler_page_free_form_field_mapping :: 
    Ptr (GList (Ptr Poppler.FormFieldMapping.FormFieldMapping)) -> -- list : TGList (TInterface (Name {namespace = "Poppler", name = "FormFieldMapping"}))
    IO ()

-- | Frees a list of t'GI.Poppler.Structs.FormFieldMapping.FormFieldMapping's allocated by
-- 'GI.Poppler.Objects.Page.pageGetFormFieldMapping'.
pageFreeFormFieldMapping ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Poppler.FormFieldMapping.FormFieldMapping]
    -- ^ /@list@/: A list of
    --   t'GI.Poppler.Structs.FormFieldMapping.FormFieldMapping's
    -> m ()
pageFreeFormFieldMapping :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[FormFieldMapping] -> m ()
pageFreeFormFieldMapping [FormFieldMapping]
list = 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 FormFieldMapping]
list' <- (FormFieldMapping -> IO (Ptr FormFieldMapping))
-> [FormFieldMapping] -> IO [Ptr FormFieldMapping]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FormFieldMapping -> IO (Ptr FormFieldMapping)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed [FormFieldMapping]
list
    Ptr (GList (Ptr FormFieldMapping))
list'' <- [Ptr FormFieldMapping] -> IO (Ptr (GList (Ptr FormFieldMapping)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr FormFieldMapping]
list'
    Ptr (GList (Ptr FormFieldMapping)) -> IO ()
poppler_page_free_form_field_mapping Ptr (GList (Ptr FormFieldMapping))
list''
    (FormFieldMapping -> IO ()) -> [FormFieldMapping] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FormFieldMapping -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [FormFieldMapping]
list
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Page::free_image_mapping
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TGList
--                 (TInterface Name { namespace = "Poppler" , name = "ImageMapping" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A list of\n  #PopplerImageMapping<!-- -->s"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_free_image_mapping" poppler_page_free_image_mapping :: 
    Ptr (GList (Ptr Poppler.ImageMapping.ImageMapping)) -> -- list : TGList (TInterface (Name {namespace = "Poppler", name = "ImageMapping"}))
    IO ()

-- | Frees a list of t'GI.Poppler.Structs.ImageMapping.ImageMapping's allocated by
-- 'GI.Poppler.Objects.Page.pageGetImageMapping'.
pageFreeImageMapping ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Poppler.ImageMapping.ImageMapping]
    -- ^ /@list@/: A list of
    --   t'GI.Poppler.Structs.ImageMapping.ImageMapping's
    -> m ()
pageFreeImageMapping :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[ImageMapping] -> m ()
pageFreeImageMapping [ImageMapping]
list = 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 ImageMapping]
list' <- (ImageMapping -> IO (Ptr ImageMapping))
-> [ImageMapping] -> IO [Ptr ImageMapping]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ImageMapping -> IO (Ptr ImageMapping)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed [ImageMapping]
list
    Ptr (GList (Ptr ImageMapping))
list'' <- [Ptr ImageMapping] -> IO (Ptr (GList (Ptr ImageMapping)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr ImageMapping]
list'
    Ptr (GList (Ptr ImageMapping)) -> IO ()
poppler_page_free_image_mapping Ptr (GList (Ptr ImageMapping))
list''
    (ImageMapping -> IO ()) -> [ImageMapping] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ImageMapping -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [ImageMapping]
list
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Page::free_link_mapping
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TGList
--                 (TInterface Name { namespace = "Poppler" , name = "LinkMapping" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A list of\n  #PopplerLinkMapping<!-- -->s"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_free_link_mapping" poppler_page_free_link_mapping :: 
    Ptr (GList (Ptr Poppler.LinkMapping.LinkMapping)) -> -- list : TGList (TInterface (Name {namespace = "Poppler", name = "LinkMapping"}))
    IO ()

-- | Frees a list of t'GI.Poppler.Structs.LinkMapping.LinkMapping's allocated by
-- 'GI.Poppler.Objects.Page.pageGetLinkMapping'.  It also frees the t'GI.Poppler.Unions.Action.Action's
-- that each mapping contains, so if you want to keep them around, you need to
-- copy them with 'GI.Poppler.Unions.Action.actionCopy'.
pageFreeLinkMapping ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Poppler.LinkMapping.LinkMapping]
    -- ^ /@list@/: A list of
    --   t'GI.Poppler.Structs.LinkMapping.LinkMapping's
    -> m ()
pageFreeLinkMapping :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[LinkMapping] -> m ()
pageFreeLinkMapping [LinkMapping]
list = 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 LinkMapping]
list' <- (LinkMapping -> IO (Ptr LinkMapping))
-> [LinkMapping] -> IO [Ptr LinkMapping]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LinkMapping -> IO (Ptr LinkMapping)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed [LinkMapping]
list
    Ptr (GList (Ptr LinkMapping))
list'' <- [Ptr LinkMapping] -> IO (Ptr (GList (Ptr LinkMapping)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr LinkMapping]
list'
    Ptr (GList (Ptr LinkMapping)) -> IO ()
poppler_page_free_link_mapping Ptr (GList (Ptr LinkMapping))
list''
    (LinkMapping -> IO ()) -> [LinkMapping] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LinkMapping -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [LinkMapping]
list
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Page::free_text_attributes
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TGList
--                 (TInterface
--                    Name { namespace = "Poppler" , name = "TextAttributes" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A list of\n  #PopplerTextAttributes<!-- -->s"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_free_text_attributes" poppler_page_free_text_attributes :: 
    Ptr (GList (Ptr Poppler.TextAttributes.TextAttributes)) -> -- list : TGList (TInterface (Name {namespace = "Poppler", name = "TextAttributes"}))
    IO ()

-- | Frees a list of t'GI.Poppler.Structs.TextAttributes.TextAttributes's allocated by
-- 'GI.Poppler.Objects.Page.pageGetTextAttributes'.
-- 
-- /Since: 0.18/
pageFreeTextAttributes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Poppler.TextAttributes.TextAttributes]
    -- ^ /@list@/: A list of
    --   t'GI.Poppler.Structs.TextAttributes.TextAttributes's
    -> m ()
pageFreeTextAttributes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[TextAttributes] -> m ()
pageFreeTextAttributes [TextAttributes]
list = 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 TextAttributes]
list' <- (TextAttributes -> IO (Ptr TextAttributes))
-> [TextAttributes] -> IO [Ptr TextAttributes]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TextAttributes -> IO (Ptr TextAttributes)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed [TextAttributes]
list
    Ptr (GList (Ptr TextAttributes))
list'' <- [Ptr TextAttributes] -> IO (Ptr (GList (Ptr TextAttributes)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr TextAttributes]
list'
    Ptr (GList (Ptr TextAttributes)) -> IO ()
poppler_page_free_text_attributes Ptr (GList (Ptr TextAttributes))
list''
    (TextAttributes -> IO ()) -> [TextAttributes] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TextAttributes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [TextAttributes]
list
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Page::selection_region_free
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "region"
--           , argType =
--               TGList
--                 (TInterface Name { namespace = "Poppler" , name = "Rectangle" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GList of\n  #PopplerRectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_page_selection_region_free" poppler_page_selection_region_free :: 
    Ptr (GList (Ptr Poppler.Rectangle.Rectangle)) -> -- region : TGList (TInterface (Name {namespace = "Poppler", name = "Rectangle"}))
    IO ()

{-# DEPRECATED pageSelectionRegionFree ["(Since version 0.16)","Use only to free deprecated regions created by","'GI.Poppler.Objects.Page.pageGetSelectionRegion'. Regions created by","'GI.Poppler.Objects.Page.pageGetSelectedRegion' should be freed with","@/cairo_region_destroy()/@ instead."] #-}
-- | Frees /@region@/
pageSelectionRegionFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Poppler.Rectangle.Rectangle]
    -- ^ /@region@/: a t'GI.GLib.Structs.List.List' of
    --   t'GI.Poppler.Structs.Rectangle.Rectangle'
    -> m ()
pageSelectionRegionFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[Rectangle] -> m ()
pageSelectionRegionFree [Rectangle]
region = 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 Rectangle]
region' <- (Rectangle -> IO (Ptr Rectangle))
-> [Rectangle] -> IO [Ptr Rectangle]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [Rectangle]
region
    Ptr (GList (Ptr Rectangle))
region'' <- [Ptr Rectangle] -> IO (Ptr (GList (Ptr Rectangle)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr Rectangle]
region'
    Ptr (GList (Ptr Rectangle)) -> IO ()
poppler_page_selection_region_free Ptr (GList (Ptr Rectangle))
region''
    (Rectangle -> IO ()) -> [Rectangle] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Rectangle]
region
    Ptr (GList (Ptr Rectangle)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Rectangle))
region''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif