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

-- * Exported types
    Document(..)                            ,
    IsDocument                              ,
    toDocument                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [createDestsTree]("GI.Poppler.Objects.Document#g:method:createDestsTree"), [findDest]("GI.Poppler.Objects.Document#g:method:findDest"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasAttachments]("GI.Poppler.Objects.Document#g:method:hasAttachments"), [hasJavascript]("GI.Poppler.Objects.Document#g:method:hasJavascript"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isLinearized]("GI.Poppler.Objects.Document#g:method:isLinearized"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [save]("GI.Poppler.Objects.Document#g:method:save"), [saveACopy]("GI.Poppler.Objects.Document#g:method:saveACopy"), [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
-- [getAttachments]("GI.Poppler.Objects.Document#g:method:getAttachments"), [getAuthor]("GI.Poppler.Objects.Document#g:method:getAuthor"), [getCreationDate]("GI.Poppler.Objects.Document#g:method:getCreationDate"), [getCreationDateTime]("GI.Poppler.Objects.Document#g:method:getCreationDateTime"), [getCreator]("GI.Poppler.Objects.Document#g:method:getCreator"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFormField]("GI.Poppler.Objects.Document#g:method:getFormField"), [getId]("GI.Poppler.Objects.Document#g:method:getId"), [getKeywords]("GI.Poppler.Objects.Document#g:method:getKeywords"), [getMetadata]("GI.Poppler.Objects.Document#g:method:getMetadata"), [getModificationDate]("GI.Poppler.Objects.Document#g:method:getModificationDate"), [getModificationDateTime]("GI.Poppler.Objects.Document#g:method:getModificationDateTime"), [getNAttachments]("GI.Poppler.Objects.Document#g:method:getNAttachments"), [getNPages]("GI.Poppler.Objects.Document#g:method:getNPages"), [getPage]("GI.Poppler.Objects.Document#g:method:getPage"), [getPageByLabel]("GI.Poppler.Objects.Document#g:method:getPageByLabel"), [getPageLayout]("GI.Poppler.Objects.Document#g:method:getPageLayout"), [getPageMode]("GI.Poppler.Objects.Document#g:method:getPageMode"), [getPdfConformance]("GI.Poppler.Objects.Document#g:method:getPdfConformance"), [getPdfPart]("GI.Poppler.Objects.Document#g:method:getPdfPart"), [getPdfSubtype]("GI.Poppler.Objects.Document#g:method:getPdfSubtype"), [getPdfSubtypeString]("GI.Poppler.Objects.Document#g:method:getPdfSubtypeString"), [getPdfVersion]("GI.Poppler.Objects.Document#g:method:getPdfVersion"), [getPdfVersionString]("GI.Poppler.Objects.Document#g:method:getPdfVersionString"), [getPermissions]("GI.Poppler.Objects.Document#g:method:getPermissions"), [getPrintDuplex]("GI.Poppler.Objects.Document#g:method:getPrintDuplex"), [getPrintNCopies]("GI.Poppler.Objects.Document#g:method:getPrintNCopies"), [getPrintPageRanges]("GI.Poppler.Objects.Document#g:method:getPrintPageRanges"), [getPrintScaling]("GI.Poppler.Objects.Document#g:method:getPrintScaling"), [getProducer]("GI.Poppler.Objects.Document#g:method:getProducer"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSubject]("GI.Poppler.Objects.Document#g:method:getSubject"), [getTitle]("GI.Poppler.Objects.Document#g:method:getTitle").
-- 
-- ==== Setters
-- [setAuthor]("GI.Poppler.Objects.Document#g:method:setAuthor"), [setCreationDate]("GI.Poppler.Objects.Document#g:method:setCreationDate"), [setCreationDateTime]("GI.Poppler.Objects.Document#g:method:setCreationDateTime"), [setCreator]("GI.Poppler.Objects.Document#g:method:setCreator"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setKeywords]("GI.Poppler.Objects.Document#g:method:setKeywords"), [setModificationDate]("GI.Poppler.Objects.Document#g:method:setModificationDate"), [setModificationDateTime]("GI.Poppler.Objects.Document#g:method:setModificationDateTime"), [setProducer]("GI.Poppler.Objects.Document#g:method:setProducer"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSubject]("GI.Poppler.Objects.Document#g:method:setSubject"), [setTitle]("GI.Poppler.Objects.Document#g:method:setTitle").

#if defined(ENABLE_OVERLOADING)
    ResolveDocumentMethod                   ,
#endif

-- ** createDestsTree #method:createDestsTree#

#if defined(ENABLE_OVERLOADING)
    DocumentCreateDestsTreeMethodInfo       ,
#endif
    documentCreateDestsTree                 ,


-- ** findDest #method:findDest#

#if defined(ENABLE_OVERLOADING)
    DocumentFindDestMethodInfo              ,
#endif
    documentFindDest                        ,


-- ** getAttachments #method:getAttachments#

#if defined(ENABLE_OVERLOADING)
    DocumentGetAttachmentsMethodInfo        ,
#endif
    documentGetAttachments                  ,


-- ** getAuthor #method:getAuthor#

#if defined(ENABLE_OVERLOADING)
    DocumentGetAuthorMethodInfo             ,
#endif
    documentGetAuthor                       ,


-- ** getCreationDate #method:getCreationDate#

#if defined(ENABLE_OVERLOADING)
    DocumentGetCreationDateMethodInfo       ,
#endif
    documentGetCreationDate                 ,


-- ** getCreationDateTime #method:getCreationDateTime#

#if defined(ENABLE_OVERLOADING)
    DocumentGetCreationDateTimeMethodInfo   ,
#endif
    documentGetCreationDateTime             ,


-- ** getCreator #method:getCreator#

#if defined(ENABLE_OVERLOADING)
    DocumentGetCreatorMethodInfo            ,
#endif
    documentGetCreator                      ,


-- ** getFormField #method:getFormField#

#if defined(ENABLE_OVERLOADING)
    DocumentGetFormFieldMethodInfo          ,
#endif
    documentGetFormField                    ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    DocumentGetIdMethodInfo                 ,
#endif
    documentGetId                           ,


-- ** getKeywords #method:getKeywords#

#if defined(ENABLE_OVERLOADING)
    DocumentGetKeywordsMethodInfo           ,
#endif
    documentGetKeywords                     ,


-- ** getMetadata #method:getMetadata#

#if defined(ENABLE_OVERLOADING)
    DocumentGetMetadataMethodInfo           ,
#endif
    documentGetMetadata                     ,


-- ** getModificationDate #method:getModificationDate#

#if defined(ENABLE_OVERLOADING)
    DocumentGetModificationDateMethodInfo   ,
#endif
    documentGetModificationDate             ,


-- ** getModificationDateTime #method:getModificationDateTime#

#if defined(ENABLE_OVERLOADING)
    DocumentGetModificationDateTimeMethodInfo,
#endif
    documentGetModificationDateTime         ,


-- ** getNAttachments #method:getNAttachments#

#if defined(ENABLE_OVERLOADING)
    DocumentGetNAttachmentsMethodInfo       ,
#endif
    documentGetNAttachments                 ,


-- ** getNPages #method:getNPages#

#if defined(ENABLE_OVERLOADING)
    DocumentGetNPagesMethodInfo             ,
#endif
    documentGetNPages                       ,


-- ** getPage #method:getPage#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPageMethodInfo               ,
#endif
    documentGetPage                         ,


-- ** getPageByLabel #method:getPageByLabel#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPageByLabelMethodInfo        ,
#endif
    documentGetPageByLabel                  ,


-- ** getPageLayout #method:getPageLayout#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPageLayoutMethodInfo         ,
#endif
    documentGetPageLayout                   ,


-- ** getPageMode #method:getPageMode#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPageModeMethodInfo           ,
#endif
    documentGetPageMode                     ,


-- ** getPdfConformance #method:getPdfConformance#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPdfConformanceMethodInfo     ,
#endif
    documentGetPdfConformance               ,


-- ** getPdfPart #method:getPdfPart#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPdfPartMethodInfo            ,
#endif
    documentGetPdfPart                      ,


-- ** getPdfSubtype #method:getPdfSubtype#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPdfSubtypeMethodInfo         ,
#endif
    documentGetPdfSubtype                   ,


-- ** getPdfSubtypeString #method:getPdfSubtypeString#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPdfSubtypeStringMethodInfo   ,
#endif
    documentGetPdfSubtypeString             ,


-- ** getPdfVersion #method:getPdfVersion#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPdfVersionMethodInfo         ,
#endif
    documentGetPdfVersion                   ,


-- ** getPdfVersionString #method:getPdfVersionString#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPdfVersionStringMethodInfo   ,
#endif
    documentGetPdfVersionString             ,


-- ** getPermissions #method:getPermissions#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPermissionsMethodInfo        ,
#endif
    documentGetPermissions                  ,


-- ** getPrintDuplex #method:getPrintDuplex#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPrintDuplexMethodInfo        ,
#endif
    documentGetPrintDuplex                  ,


-- ** getPrintNCopies #method:getPrintNCopies#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPrintNCopiesMethodInfo       ,
#endif
    documentGetPrintNCopies                 ,


-- ** getPrintPageRanges #method:getPrintPageRanges#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPrintPageRangesMethodInfo    ,
#endif
    documentGetPrintPageRanges              ,


-- ** getPrintScaling #method:getPrintScaling#

#if defined(ENABLE_OVERLOADING)
    DocumentGetPrintScalingMethodInfo       ,
#endif
    documentGetPrintScaling                 ,


-- ** getProducer #method:getProducer#

#if defined(ENABLE_OVERLOADING)
    DocumentGetProducerMethodInfo           ,
#endif
    documentGetProducer                     ,


-- ** getSubject #method:getSubject#

#if defined(ENABLE_OVERLOADING)
    DocumentGetSubjectMethodInfo            ,
#endif
    documentGetSubject                      ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    DocumentGetTitleMethodInfo              ,
#endif
    documentGetTitle                        ,


-- ** hasAttachments #method:hasAttachments#

#if defined(ENABLE_OVERLOADING)
    DocumentHasAttachmentsMethodInfo        ,
#endif
    documentHasAttachments                  ,


-- ** hasJavascript #method:hasJavascript#

#if defined(ENABLE_OVERLOADING)
    DocumentHasJavascriptMethodInfo         ,
#endif
    documentHasJavascript                   ,


-- ** isLinearized #method:isLinearized#

#if defined(ENABLE_OVERLOADING)
    DocumentIsLinearizedMethodInfo          ,
#endif
    documentIsLinearized                    ,


-- ** newFromBytes #method:newFromBytes#

    documentNewFromBytes                    ,


-- ** newFromData #method:newFromData#

    documentNewFromData                     ,


-- ** newFromFile #method:newFromFile#

    documentNewFromFile                     ,


-- ** newFromGfile #method:newFromGfile#

    documentNewFromGfile                    ,


-- ** newFromStream #method:newFromStream#

    documentNewFromStream                   ,


-- ** save #method:save#

#if defined(ENABLE_OVERLOADING)
    DocumentSaveMethodInfo                  ,
#endif
    documentSave                            ,


-- ** saveACopy #method:saveACopy#

#if defined(ENABLE_OVERLOADING)
    DocumentSaveACopyMethodInfo             ,
#endif
    documentSaveACopy                       ,


-- ** setAuthor #method:setAuthor#

#if defined(ENABLE_OVERLOADING)
    DocumentSetAuthorMethodInfo             ,
#endif
    documentSetAuthor                       ,


-- ** setCreationDate #method:setCreationDate#

#if defined(ENABLE_OVERLOADING)
    DocumentSetCreationDateMethodInfo       ,
#endif
    documentSetCreationDate                 ,


-- ** setCreationDateTime #method:setCreationDateTime#

#if defined(ENABLE_OVERLOADING)
    DocumentSetCreationDateTimeMethodInfo   ,
#endif
    documentSetCreationDateTime             ,


-- ** setCreator #method:setCreator#

#if defined(ENABLE_OVERLOADING)
    DocumentSetCreatorMethodInfo            ,
#endif
    documentSetCreator                      ,


-- ** setKeywords #method:setKeywords#

#if defined(ENABLE_OVERLOADING)
    DocumentSetKeywordsMethodInfo           ,
#endif
    documentSetKeywords                     ,


-- ** setModificationDate #method:setModificationDate#

#if defined(ENABLE_OVERLOADING)
    DocumentSetModificationDateMethodInfo   ,
#endif
    documentSetModificationDate             ,


-- ** setModificationDateTime #method:setModificationDateTime#

#if defined(ENABLE_OVERLOADING)
    DocumentSetModificationDateTimeMethodInfo,
#endif
    documentSetModificationDateTime         ,


-- ** setProducer #method:setProducer#

#if defined(ENABLE_OVERLOADING)
    DocumentSetProducerMethodInfo           ,
#endif
    documentSetProducer                     ,


-- ** setSubject #method:setSubject#

#if defined(ENABLE_OVERLOADING)
    DocumentSetSubjectMethodInfo            ,
#endif
    documentSetSubject                      ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    DocumentSetTitleMethodInfo              ,
#endif
    documentSetTitle                        ,




 -- * Properties


-- ** author #attr:author#
-- | The author of the document

#if defined(ENABLE_OVERLOADING)
    DocumentAuthorPropertyInfo              ,
#endif
    constructDocumentAuthor                 ,
#if defined(ENABLE_OVERLOADING)
    documentAuthor                          ,
#endif
    getDocumentAuthor                       ,
    setDocumentAuthor                       ,


-- ** creationDate #attr:creationDate#
-- | The date the document was created as seconds since the Epoch, or -1

#if defined(ENABLE_OVERLOADING)
    DocumentCreationDatePropertyInfo        ,
#endif
    constructDocumentCreationDate           ,
#if defined(ENABLE_OVERLOADING)
    documentCreationDate                    ,
#endif
    getDocumentCreationDate                 ,
    setDocumentCreationDate                 ,


-- ** creationDatetime #attr:creationDatetime#
-- | The t'GI.GLib.Structs.DateTime.DateTime' the document was created.
-- 
-- /Since: 20.09.0/

#if defined(ENABLE_OVERLOADING)
    DocumentCreationDatetimePropertyInfo    ,
#endif
    clearDocumentCreationDatetime           ,
    constructDocumentCreationDatetime       ,
#if defined(ENABLE_OVERLOADING)
    documentCreationDatetime                ,
#endif
    getDocumentCreationDatetime             ,
    setDocumentCreationDatetime             ,


-- ** creator #attr:creator#
-- | The creator of the document. See also 'GI.Poppler.Objects.Document.documentGetCreator'

#if defined(ENABLE_OVERLOADING)
    DocumentCreatorPropertyInfo             ,
#endif
    constructDocumentCreator                ,
#if defined(ENABLE_OVERLOADING)
    documentCreator                         ,
#endif
    getDocumentCreator                      ,
    setDocumentCreator                      ,


-- ** format #attr:format#
-- | The PDF version as string. See also 'GI.Poppler.Objects.Document.documentGetPdfVersionString'

#if defined(ENABLE_OVERLOADING)
    DocumentFormatPropertyInfo              ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentFormat                          ,
#endif
    getDocumentFormat                       ,


-- ** formatMajor #attr:formatMajor#
-- | The PDF major version number. See also 'GI.Poppler.Objects.Document.documentGetPdfVersion'

#if defined(ENABLE_OVERLOADING)
    DocumentFormatMajorPropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentFormatMajor                     ,
#endif
    getDocumentFormatMajor                  ,


-- ** formatMinor #attr:formatMinor#
-- | The PDF minor version number. See also 'GI.Poppler.Objects.Document.documentGetPdfVersion'

#if defined(ENABLE_OVERLOADING)
    DocumentFormatMinorPropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentFormatMinor                     ,
#endif
    getDocumentFormatMinor                  ,


-- ** keywords #attr:keywords#
-- | The keywords associated to the document

#if defined(ENABLE_OVERLOADING)
    DocumentKeywordsPropertyInfo            ,
#endif
    constructDocumentKeywords               ,
#if defined(ENABLE_OVERLOADING)
    documentKeywords                        ,
#endif
    getDocumentKeywords                     ,
    setDocumentKeywords                     ,


-- ** linearized #attr:linearized#
-- | Whether document is linearized. See also 'GI.Poppler.Objects.Document.documentIsLinearized'

#if defined(ENABLE_OVERLOADING)
    DocumentLinearizedPropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentLinearized                      ,
#endif
    getDocumentLinearized                   ,


-- ** metadata #attr:metadata#
-- | Document metadata in XML format, or 'P.Nothing'

#if defined(ENABLE_OVERLOADING)
    DocumentMetadataPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentMetadata                        ,
#endif
    getDocumentMetadata                     ,


-- ** modDate #attr:modDate#
-- | The date the document was most recently modified as seconds since the Epoch, or -1

#if defined(ENABLE_OVERLOADING)
    DocumentModDatePropertyInfo             ,
#endif
    constructDocumentModDate                ,
#if defined(ENABLE_OVERLOADING)
    documentModDate                         ,
#endif
    getDocumentModDate                      ,
    setDocumentModDate                      ,


-- ** modDatetime #attr:modDatetime#
-- | The t'GI.GLib.Structs.DateTime.DateTime' the document was most recently modified.
-- 
-- /Since: 20.09.0/

#if defined(ENABLE_OVERLOADING)
    DocumentModDatetimePropertyInfo         ,
#endif
    clearDocumentModDatetime                ,
    constructDocumentModDatetime            ,
#if defined(ENABLE_OVERLOADING)
    documentModDatetime                     ,
#endif
    getDocumentModDatetime                  ,
    setDocumentModDatetime                  ,


-- ** pageLayout #attr:pageLayout#
-- | The page layout that should be used when the document is opened

#if defined(ENABLE_OVERLOADING)
    DocumentPageLayoutPropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentPageLayout                      ,
#endif
    getDocumentPageLayout                   ,


-- ** pageMode #attr:pageMode#
-- | The mode that should be used when the document is opened

#if defined(ENABLE_OVERLOADING)
    DocumentPageModePropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentPageMode                        ,
#endif
    getDocumentPageMode                     ,


-- ** permissions #attr:permissions#
-- | Flags specifying which operations are permitted when the document is opened

#if defined(ENABLE_OVERLOADING)
    DocumentPermissionsPropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentPermissions                     ,
#endif
    getDocumentPermissions                  ,


-- ** printDuplex #attr:printDuplex#
-- | /No description available in the introspection data./
-- 
-- /Since: 0.80/

#if defined(ENABLE_OVERLOADING)
    DocumentPrintDuplexPropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentPrintDuplex                     ,
#endif
    getDocumentPrintDuplex                  ,


-- ** printNCopies #attr:printNCopies#
-- | Suggested number of copies to be printed for this document
-- 
-- /Since: 0.80/

#if defined(ENABLE_OVERLOADING)
    DocumentPrintNCopiesPropertyInfo        ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentPrintNCopies                    ,
#endif
    getDocumentPrintNCopies                 ,


-- ** printScaling #attr:printScaling#
-- | /No description available in the introspection data./
-- 
-- /Since: 0.73/

#if defined(ENABLE_OVERLOADING)
    DocumentPrintScalingPropertyInfo        ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentPrintScaling                    ,
#endif
    getDocumentPrintScaling                 ,


-- ** producer #attr:producer#
-- | The producer of the document. See also 'GI.Poppler.Objects.Document.documentGetProducer'

#if defined(ENABLE_OVERLOADING)
    DocumentProducerPropertyInfo            ,
#endif
    constructDocumentProducer               ,
#if defined(ENABLE_OVERLOADING)
    documentProducer                        ,
#endif
    getDocumentProducer                     ,
    setDocumentProducer                     ,


-- ** subject #attr:subject#
-- | The subject of the document

#if defined(ENABLE_OVERLOADING)
    DocumentSubjectPropertyInfo             ,
#endif
    constructDocumentSubject                ,
#if defined(ENABLE_OVERLOADING)
    documentSubject                         ,
#endif
    getDocumentSubject                      ,
    setDocumentSubject                      ,


-- ** subtype #attr:subtype#
-- | Document PDF subtype type

#if defined(ENABLE_OVERLOADING)
    DocumentSubtypePropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentSubtype                         ,
#endif
    getDocumentSubtype                      ,


-- ** subtypeConformance #attr:subtypeConformance#
-- | Document PDF subtype conformance

#if defined(ENABLE_OVERLOADING)
    DocumentSubtypeConformancePropertyInfo  ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentSubtypeConformance              ,
#endif
    getDocumentSubtypeConformance           ,


-- ** subtypePart #attr:subtypePart#
-- | Document PDF subtype part

#if defined(ENABLE_OVERLOADING)
    DocumentSubtypePartPropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentSubtypePart                     ,
#endif
    getDocumentSubtypePart                  ,


-- ** subtypeString #attr:subtypeString#
-- | Document PDF subtype. See also 'GI.Poppler.Objects.Document.documentGetPdfSubtypeString'

#if defined(ENABLE_OVERLOADING)
    DocumentSubtypeStringPropertyInfo       ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentSubtypeString                   ,
#endif
    getDocumentSubtypeString                ,


-- ** title #attr:title#
-- | The document\'s title or 'P.Nothing'

#if defined(ENABLE_OVERLOADING)
    DocumentTitlePropertyInfo               ,
#endif
    constructDocumentTitle                  ,
#if defined(ENABLE_OVERLOADING)
    documentTitle                           ,
#endif
    getDocumentTitle                        ,
    setDocumentTitle                        ,


-- ** viewerPreferences #attr:viewerPreferences#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DocumentViewerPreferencesPropertyInfo   ,
#endif
#if defined(ENABLE_OVERLOADING)
    documentViewerPreferences               ,
#endif
    getDocumentViewerPreferences            ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.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.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.DateTime as GLib.DateTime
import qualified GI.GLib.Structs.Tree as GLib.Tree
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.InputStream as Gio.InputStream
import {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums
import {-# SOURCE #-} qualified GI.Poppler.Flags as Poppler.Flags
import {-# SOURCE #-} qualified GI.Poppler.Objects.Attachment as Poppler.Attachment
import {-# SOURCE #-} qualified GI.Poppler.Objects.FormField as Poppler.FormField
import {-# SOURCE #-} qualified GI.Poppler.Objects.Page as Poppler.Page
import {-# SOURCE #-} qualified GI.Poppler.Structs.Dest as Poppler.Dest
import {-# SOURCE #-} qualified GI.Poppler.Structs.PageRange as Poppler.PageRange

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

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

foreign import ccall "poppler_document_get_type"
    c_poppler_document_get_type :: IO B.Types.GType

instance B.Types.TypedObject Document where
    glibType :: IO GType
glibType = IO GType
c_poppler_document_get_type

instance B.Types.GObject Document

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDocumentMethod (t :: Symbol) (o :: *) :: * where
    ResolveDocumentMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDocumentMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDocumentMethod "createDestsTree" o = DocumentCreateDestsTreeMethodInfo
    ResolveDocumentMethod "findDest" o = DocumentFindDestMethodInfo
    ResolveDocumentMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDocumentMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDocumentMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDocumentMethod "hasAttachments" o = DocumentHasAttachmentsMethodInfo
    ResolveDocumentMethod "hasJavascript" o = DocumentHasJavascriptMethodInfo
    ResolveDocumentMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDocumentMethod "isLinearized" o = DocumentIsLinearizedMethodInfo
    ResolveDocumentMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDocumentMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDocumentMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDocumentMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDocumentMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDocumentMethod "save" o = DocumentSaveMethodInfo
    ResolveDocumentMethod "saveACopy" o = DocumentSaveACopyMethodInfo
    ResolveDocumentMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDocumentMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDocumentMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDocumentMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDocumentMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDocumentMethod "getAttachments" o = DocumentGetAttachmentsMethodInfo
    ResolveDocumentMethod "getAuthor" o = DocumentGetAuthorMethodInfo
    ResolveDocumentMethod "getCreationDate" o = DocumentGetCreationDateMethodInfo
    ResolveDocumentMethod "getCreationDateTime" o = DocumentGetCreationDateTimeMethodInfo
    ResolveDocumentMethod "getCreator" o = DocumentGetCreatorMethodInfo
    ResolveDocumentMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDocumentMethod "getFormField" o = DocumentGetFormFieldMethodInfo
    ResolveDocumentMethod "getId" o = DocumentGetIdMethodInfo
    ResolveDocumentMethod "getKeywords" o = DocumentGetKeywordsMethodInfo
    ResolveDocumentMethod "getMetadata" o = DocumentGetMetadataMethodInfo
    ResolveDocumentMethod "getModificationDate" o = DocumentGetModificationDateMethodInfo
    ResolveDocumentMethod "getModificationDateTime" o = DocumentGetModificationDateTimeMethodInfo
    ResolveDocumentMethod "getNAttachments" o = DocumentGetNAttachmentsMethodInfo
    ResolveDocumentMethod "getNPages" o = DocumentGetNPagesMethodInfo
    ResolveDocumentMethod "getPage" o = DocumentGetPageMethodInfo
    ResolveDocumentMethod "getPageByLabel" o = DocumentGetPageByLabelMethodInfo
    ResolveDocumentMethod "getPageLayout" o = DocumentGetPageLayoutMethodInfo
    ResolveDocumentMethod "getPageMode" o = DocumentGetPageModeMethodInfo
    ResolveDocumentMethod "getPdfConformance" o = DocumentGetPdfConformanceMethodInfo
    ResolveDocumentMethod "getPdfPart" o = DocumentGetPdfPartMethodInfo
    ResolveDocumentMethod "getPdfSubtype" o = DocumentGetPdfSubtypeMethodInfo
    ResolveDocumentMethod "getPdfSubtypeString" o = DocumentGetPdfSubtypeStringMethodInfo
    ResolveDocumentMethod "getPdfVersion" o = DocumentGetPdfVersionMethodInfo
    ResolveDocumentMethod "getPdfVersionString" o = DocumentGetPdfVersionStringMethodInfo
    ResolveDocumentMethod "getPermissions" o = DocumentGetPermissionsMethodInfo
    ResolveDocumentMethod "getPrintDuplex" o = DocumentGetPrintDuplexMethodInfo
    ResolveDocumentMethod "getPrintNCopies" o = DocumentGetPrintNCopiesMethodInfo
    ResolveDocumentMethod "getPrintPageRanges" o = DocumentGetPrintPageRangesMethodInfo
    ResolveDocumentMethod "getPrintScaling" o = DocumentGetPrintScalingMethodInfo
    ResolveDocumentMethod "getProducer" o = DocumentGetProducerMethodInfo
    ResolveDocumentMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDocumentMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDocumentMethod "getSubject" o = DocumentGetSubjectMethodInfo
    ResolveDocumentMethod "getTitle" o = DocumentGetTitleMethodInfo
    ResolveDocumentMethod "setAuthor" o = DocumentSetAuthorMethodInfo
    ResolveDocumentMethod "setCreationDate" o = DocumentSetCreationDateMethodInfo
    ResolveDocumentMethod "setCreationDateTime" o = DocumentSetCreationDateTimeMethodInfo
    ResolveDocumentMethod "setCreator" o = DocumentSetCreatorMethodInfo
    ResolveDocumentMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDocumentMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDocumentMethod "setKeywords" o = DocumentSetKeywordsMethodInfo
    ResolveDocumentMethod "setModificationDate" o = DocumentSetModificationDateMethodInfo
    ResolveDocumentMethod "setModificationDateTime" o = DocumentSetModificationDateTimeMethodInfo
    ResolveDocumentMethod "setProducer" o = DocumentSetProducerMethodInfo
    ResolveDocumentMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDocumentMethod "setSubject" o = DocumentSetSubjectMethodInfo
    ResolveDocumentMethod "setTitle" o = DocumentSetTitleMethodInfo
    ResolveDocumentMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "author"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just False)

-- | Get the value of the “@author@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #author
-- @
getDocumentAuthor :: (MonadIO m, IsDocument o) => o -> m (Maybe T.Text)
getDocumentAuthor :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m (Maybe Text)
getDocumentAuthor o
obj = IO (Maybe Text) -> m (Maybe Text)
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
"author"

-- | Set the value of the “@author@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' document [ #author 'Data.GI.Base.Attributes.:=' value ]
-- @
setDocumentAuthor :: (MonadIO m, IsDocument o) => o -> T.Text -> m ()
setDocumentAuthor :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> Text -> m ()
setDocumentAuthor o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"author" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@author@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDocumentAuthor :: (IsDocument o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDocumentAuthor :: forall o (m :: * -> *).
(IsDocument o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDocumentAuthor Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"author" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DocumentAuthorPropertyInfo
instance AttrInfo DocumentAuthorPropertyInfo where
    type AttrAllowedOps DocumentAuthorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DocumentAuthorPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentAuthorPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DocumentAuthorPropertyInfo = (~) T.Text
    type AttrTransferType DocumentAuthorPropertyInfo = T.Text
    type AttrGetType DocumentAuthorPropertyInfo = (Maybe T.Text)
    type AttrLabel DocumentAuthorPropertyInfo = "author"
    type AttrOrigin DocumentAuthorPropertyInfo = Document
    attrGet = getDocumentAuthor
    attrSet = setDocumentAuthor
    attrTransfer _ v = do
        return v
    attrConstruct = constructDocumentAuthor
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.author"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:author"
        })
#endif

-- VVV Prop "creation-date"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@creation-date@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #creationDate
-- @
getDocumentCreationDate :: (MonadIO m, IsDocument o) => o -> m Int32
getDocumentCreationDate :: forall (m :: * -> *) o. (MonadIO m, IsDocument o) => o -> m Int32
getDocumentCreationDate o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"creation-date"

-- | Set the value of the “@creation-date@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' document [ #creationDate 'Data.GI.Base.Attributes.:=' value ]
-- @
setDocumentCreationDate :: (MonadIO m, IsDocument o) => o -> Int32 -> m ()
setDocumentCreationDate :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> Int32 -> m ()
setDocumentCreationDate o
obj Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"creation-date" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@creation-date@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDocumentCreationDate :: (IsDocument o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructDocumentCreationDate :: forall o (m :: * -> *).
(IsDocument o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructDocumentCreationDate Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"creation-date" Int32
val

#if defined(ENABLE_OVERLOADING)
data DocumentCreationDatePropertyInfo
instance AttrInfo DocumentCreationDatePropertyInfo where
    type AttrAllowedOps DocumentCreationDatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DocumentCreationDatePropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentCreationDatePropertyInfo = (~) Int32
    type AttrTransferTypeConstraint DocumentCreationDatePropertyInfo = (~) Int32
    type AttrTransferType DocumentCreationDatePropertyInfo = Int32
    type AttrGetType DocumentCreationDatePropertyInfo = Int32
    type AttrLabel DocumentCreationDatePropertyInfo = "creation-date"
    type AttrOrigin DocumentCreationDatePropertyInfo = Document
    attrGet = getDocumentCreationDate
    attrSet = setDocumentCreationDate
    attrTransfer _ v = do
        return v
    attrConstruct = constructDocumentCreationDate
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.creationDate"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:creationDate"
        })
#endif

-- VVV Prop "creation-datetime"
   -- Type: TInterface (Name {namespace = "GLib", name = "DateTime"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@creation-datetime@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #creationDatetime
-- @
getDocumentCreationDatetime :: (MonadIO m, IsDocument o) => o -> m (Maybe GLib.DateTime.DateTime)
getDocumentCreationDatetime :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m (Maybe DateTime)
getDocumentCreationDatetime o
obj = IO (Maybe DateTime) -> m (Maybe DateTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe DateTime) -> m (Maybe DateTime))
-> IO (Maybe DateTime) -> m (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr DateTime -> DateTime)
-> IO (Maybe DateTime)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"creation-datetime" ManagedPtr DateTime -> DateTime
GLib.DateTime.DateTime

-- | Set the value of the “@creation-datetime@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' document [ #creationDatetime 'Data.GI.Base.Attributes.:=' value ]
-- @
setDocumentCreationDatetime :: (MonadIO m, IsDocument o) => o -> GLib.DateTime.DateTime -> m ()
setDocumentCreationDatetime :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> DateTime -> m ()
setDocumentCreationDatetime o
obj DateTime
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe DateTime -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"creation-datetime" (DateTime -> Maybe DateTime
forall a. a -> Maybe a
Just DateTime
val)

-- | Construct a `GValueConstruct` with valid value for the “@creation-datetime@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDocumentCreationDatetime :: (IsDocument o, MIO.MonadIO m) => GLib.DateTime.DateTime -> m (GValueConstruct o)
constructDocumentCreationDatetime :: forall o (m :: * -> *).
(IsDocument o, MonadIO m) =>
DateTime -> m (GValueConstruct o)
constructDocumentCreationDatetime DateTime
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe DateTime -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"creation-datetime" (DateTime -> Maybe DateTime
forall a. a -> Maybe a
P.Just DateTime
val)

-- | Set the value of the “@creation-datetime@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #creationDatetime
-- @
clearDocumentCreationDatetime :: (MonadIO m, IsDocument o) => o -> m ()
clearDocumentCreationDatetime :: forall (m :: * -> *) o. (MonadIO m, IsDocument o) => o -> m ()
clearDocumentCreationDatetime o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe DateTime -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"creation-datetime" (Maybe DateTime
forall a. Maybe a
Nothing :: Maybe GLib.DateTime.DateTime)

#if defined(ENABLE_OVERLOADING)
data DocumentCreationDatetimePropertyInfo
instance AttrInfo DocumentCreationDatetimePropertyInfo where
    type AttrAllowedOps DocumentCreationDatetimePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DocumentCreationDatetimePropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentCreationDatetimePropertyInfo = (~) GLib.DateTime.DateTime
    type AttrTransferTypeConstraint DocumentCreationDatetimePropertyInfo = (~) GLib.DateTime.DateTime
    type AttrTransferType DocumentCreationDatetimePropertyInfo = GLib.DateTime.DateTime
    type AttrGetType DocumentCreationDatetimePropertyInfo = (Maybe GLib.DateTime.DateTime)
    type AttrLabel DocumentCreationDatetimePropertyInfo = "creation-datetime"
    type AttrOrigin DocumentCreationDatetimePropertyInfo = Document
    attrGet = getDocumentCreationDatetime
    attrSet = setDocumentCreationDatetime
    attrTransfer _ v = do
        return v
    attrConstruct = constructDocumentCreationDatetime
    attrClear = clearDocumentCreationDatetime
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.creationDatetime"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:creationDatetime"
        })
#endif

-- VVV Prop "creator"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just False)

-- | Get the value of the “@creator@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #creator
-- @
getDocumentCreator :: (MonadIO m, IsDocument o) => o -> m (Maybe T.Text)
getDocumentCreator :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m (Maybe Text)
getDocumentCreator o
obj = IO (Maybe Text) -> m (Maybe Text)
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
"creator"

-- | Set the value of the “@creator@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' document [ #creator 'Data.GI.Base.Attributes.:=' value ]
-- @
setDocumentCreator :: (MonadIO m, IsDocument o) => o -> T.Text -> m ()
setDocumentCreator :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> Text -> m ()
setDocumentCreator o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"creator" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@creator@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDocumentCreator :: (IsDocument o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDocumentCreator :: forall o (m :: * -> *).
(IsDocument o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDocumentCreator Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"creator" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DocumentCreatorPropertyInfo
instance AttrInfo DocumentCreatorPropertyInfo where
    type AttrAllowedOps DocumentCreatorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DocumentCreatorPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentCreatorPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DocumentCreatorPropertyInfo = (~) T.Text
    type AttrTransferType DocumentCreatorPropertyInfo = T.Text
    type AttrGetType DocumentCreatorPropertyInfo = (Maybe T.Text)
    type AttrLabel DocumentCreatorPropertyInfo = "creator"
    type AttrOrigin DocumentCreatorPropertyInfo = Document
    attrGet = getDocumentCreator
    attrSet = setDocumentCreator
    attrTransfer _ v = do
        return v
    attrConstruct = constructDocumentCreator
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.creator"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:creator"
        })
#endif

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

-- | Get the value of the “@format@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #format
-- @
getDocumentFormat :: (MonadIO m, IsDocument o) => o -> m (Maybe T.Text)
getDocumentFormat :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m (Maybe Text)
getDocumentFormat o
obj = IO (Maybe Text) -> m (Maybe Text)
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
"format"

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

-- VVV Prop "format-major"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@format-major@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #formatMajor
-- @
getDocumentFormatMajor :: (MonadIO m, IsDocument o) => o -> m Word32
getDocumentFormatMajor :: forall (m :: * -> *) o. (MonadIO m, IsDocument o) => o -> m Word32
getDocumentFormatMajor o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"format-major"

#if defined(ENABLE_OVERLOADING)
data DocumentFormatMajorPropertyInfo
instance AttrInfo DocumentFormatMajorPropertyInfo where
    type AttrAllowedOps DocumentFormatMajorPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DocumentFormatMajorPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentFormatMajorPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DocumentFormatMajorPropertyInfo = (~) ()
    type AttrTransferType DocumentFormatMajorPropertyInfo = ()
    type AttrGetType DocumentFormatMajorPropertyInfo = Word32
    type AttrLabel DocumentFormatMajorPropertyInfo = "format-major"
    type AttrOrigin DocumentFormatMajorPropertyInfo = Document
    attrGet = getDocumentFormatMajor
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.formatMajor"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:formatMajor"
        })
#endif

-- VVV Prop "format-minor"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@format-minor@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #formatMinor
-- @
getDocumentFormatMinor :: (MonadIO m, IsDocument o) => o -> m Word32
getDocumentFormatMinor :: forall (m :: * -> *) o. (MonadIO m, IsDocument o) => o -> m Word32
getDocumentFormatMinor o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"format-minor"

#if defined(ENABLE_OVERLOADING)
data DocumentFormatMinorPropertyInfo
instance AttrInfo DocumentFormatMinorPropertyInfo where
    type AttrAllowedOps DocumentFormatMinorPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DocumentFormatMinorPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentFormatMinorPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DocumentFormatMinorPropertyInfo = (~) ()
    type AttrTransferType DocumentFormatMinorPropertyInfo = ()
    type AttrGetType DocumentFormatMinorPropertyInfo = Word32
    type AttrLabel DocumentFormatMinorPropertyInfo = "format-minor"
    type AttrOrigin DocumentFormatMinorPropertyInfo = Document
    attrGet = getDocumentFormatMinor
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.formatMinor"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:formatMinor"
        })
#endif

-- VVV Prop "keywords"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just False)

-- | Get the value of the “@keywords@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #keywords
-- @
getDocumentKeywords :: (MonadIO m, IsDocument o) => o -> m (Maybe T.Text)
getDocumentKeywords :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m (Maybe Text)
getDocumentKeywords o
obj = IO (Maybe Text) -> m (Maybe Text)
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
"keywords"

-- | Set the value of the “@keywords@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' document [ #keywords 'Data.GI.Base.Attributes.:=' value ]
-- @
setDocumentKeywords :: (MonadIO m, IsDocument o) => o -> T.Text -> m ()
setDocumentKeywords :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> Text -> m ()
setDocumentKeywords o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"keywords" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@keywords@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDocumentKeywords :: (IsDocument o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDocumentKeywords :: forall o (m :: * -> *).
(IsDocument o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDocumentKeywords Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"keywords" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DocumentKeywordsPropertyInfo
instance AttrInfo DocumentKeywordsPropertyInfo where
    type AttrAllowedOps DocumentKeywordsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DocumentKeywordsPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentKeywordsPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DocumentKeywordsPropertyInfo = (~) T.Text
    type AttrTransferType DocumentKeywordsPropertyInfo = T.Text
    type AttrGetType DocumentKeywordsPropertyInfo = (Maybe T.Text)
    type AttrLabel DocumentKeywordsPropertyInfo = "keywords"
    type AttrOrigin DocumentKeywordsPropertyInfo = Document
    attrGet = getDocumentKeywords
    attrSet = setDocumentKeywords
    attrTransfer _ v = do
        return v
    attrConstruct = constructDocumentKeywords
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.keywords"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:keywords"
        })
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data DocumentLinearizedPropertyInfo
instance AttrInfo DocumentLinearizedPropertyInfo where
    type AttrAllowedOps DocumentLinearizedPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DocumentLinearizedPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentLinearizedPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DocumentLinearizedPropertyInfo = (~) ()
    type AttrTransferType DocumentLinearizedPropertyInfo = ()
    type AttrGetType DocumentLinearizedPropertyInfo = Bool
    type AttrLabel DocumentLinearizedPropertyInfo = "linearized"
    type AttrOrigin DocumentLinearizedPropertyInfo = Document
    attrGet = getDocumentLinearized
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.linearized"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:linearized"
        })
#endif

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

-- | Get the value of the “@metadata@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #metadata
-- @
getDocumentMetadata :: (MonadIO m, IsDocument o) => o -> m (Maybe T.Text)
getDocumentMetadata :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m (Maybe Text)
getDocumentMetadata o
obj = IO (Maybe Text) -> m (Maybe Text)
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
"metadata"

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

-- VVV Prop "mod-date"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@mod-date@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #modDate
-- @
getDocumentModDate :: (MonadIO m, IsDocument o) => o -> m Int32
getDocumentModDate :: forall (m :: * -> *) o. (MonadIO m, IsDocument o) => o -> m Int32
getDocumentModDate o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"mod-date"

-- | Set the value of the “@mod-date@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' document [ #modDate 'Data.GI.Base.Attributes.:=' value ]
-- @
setDocumentModDate :: (MonadIO m, IsDocument o) => o -> Int32 -> m ()
setDocumentModDate :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> Int32 -> m ()
setDocumentModDate o
obj Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"mod-date" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@mod-date@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDocumentModDate :: (IsDocument o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructDocumentModDate :: forall o (m :: * -> *).
(IsDocument o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructDocumentModDate Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"mod-date" Int32
val

#if defined(ENABLE_OVERLOADING)
data DocumentModDatePropertyInfo
instance AttrInfo DocumentModDatePropertyInfo where
    type AttrAllowedOps DocumentModDatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DocumentModDatePropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentModDatePropertyInfo = (~) Int32
    type AttrTransferTypeConstraint DocumentModDatePropertyInfo = (~) Int32
    type AttrTransferType DocumentModDatePropertyInfo = Int32
    type AttrGetType DocumentModDatePropertyInfo = Int32
    type AttrLabel DocumentModDatePropertyInfo = "mod-date"
    type AttrOrigin DocumentModDatePropertyInfo = Document
    attrGet = getDocumentModDate
    attrSet = setDocumentModDate
    attrTransfer _ v = do
        return v
    attrConstruct = constructDocumentModDate
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.modDate"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:modDate"
        })
#endif

-- VVV Prop "mod-datetime"
   -- Type: TInterface (Name {namespace = "GLib", name = "DateTime"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@mod-datetime@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #modDatetime
-- @
getDocumentModDatetime :: (MonadIO m, IsDocument o) => o -> m (Maybe GLib.DateTime.DateTime)
getDocumentModDatetime :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m (Maybe DateTime)
getDocumentModDatetime o
obj = IO (Maybe DateTime) -> m (Maybe DateTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe DateTime) -> m (Maybe DateTime))
-> IO (Maybe DateTime) -> m (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr DateTime -> DateTime)
-> IO (Maybe DateTime)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"mod-datetime" ManagedPtr DateTime -> DateTime
GLib.DateTime.DateTime

-- | Set the value of the “@mod-datetime@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' document [ #modDatetime 'Data.GI.Base.Attributes.:=' value ]
-- @
setDocumentModDatetime :: (MonadIO m, IsDocument o) => o -> GLib.DateTime.DateTime -> m ()
setDocumentModDatetime :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> DateTime -> m ()
setDocumentModDatetime o
obj DateTime
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe DateTime -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"mod-datetime" (DateTime -> Maybe DateTime
forall a. a -> Maybe a
Just DateTime
val)

-- | Construct a `GValueConstruct` with valid value for the “@mod-datetime@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDocumentModDatetime :: (IsDocument o, MIO.MonadIO m) => GLib.DateTime.DateTime -> m (GValueConstruct o)
constructDocumentModDatetime :: forall o (m :: * -> *).
(IsDocument o, MonadIO m) =>
DateTime -> m (GValueConstruct o)
constructDocumentModDatetime DateTime
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe DateTime -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"mod-datetime" (DateTime -> Maybe DateTime
forall a. a -> Maybe a
P.Just DateTime
val)

-- | Set the value of the “@mod-datetime@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #modDatetime
-- @
clearDocumentModDatetime :: (MonadIO m, IsDocument o) => o -> m ()
clearDocumentModDatetime :: forall (m :: * -> *) o. (MonadIO m, IsDocument o) => o -> m ()
clearDocumentModDatetime o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe DateTime -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"mod-datetime" (Maybe DateTime
forall a. Maybe a
Nothing :: Maybe GLib.DateTime.DateTime)

#if defined(ENABLE_OVERLOADING)
data DocumentModDatetimePropertyInfo
instance AttrInfo DocumentModDatetimePropertyInfo where
    type AttrAllowedOps DocumentModDatetimePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DocumentModDatetimePropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentModDatetimePropertyInfo = (~) GLib.DateTime.DateTime
    type AttrTransferTypeConstraint DocumentModDatetimePropertyInfo = (~) GLib.DateTime.DateTime
    type AttrTransferType DocumentModDatetimePropertyInfo = GLib.DateTime.DateTime
    type AttrGetType DocumentModDatetimePropertyInfo = (Maybe GLib.DateTime.DateTime)
    type AttrLabel DocumentModDatetimePropertyInfo = "mod-datetime"
    type AttrOrigin DocumentModDatetimePropertyInfo = Document
    attrGet = getDocumentModDatetime
    attrSet = setDocumentModDatetime
    attrTransfer _ v = do
        return v
    attrConstruct = constructDocumentModDatetime
    attrClear = clearDocumentModDatetime
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.modDatetime"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:modDatetime"
        })
#endif

-- VVV Prop "page-layout"
   -- Type: TInterface (Name {namespace = "Poppler", name = "PageLayout"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@page-layout@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #pageLayout
-- @
getDocumentPageLayout :: (MonadIO m, IsDocument o) => o -> m Poppler.Enums.PageLayout
getDocumentPageLayout :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m PageLayout
getDocumentPageLayout o
obj = IO PageLayout -> m PageLayout
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO PageLayout -> m PageLayout) -> IO PageLayout -> m PageLayout
forall a b. (a -> b) -> a -> b
$ o -> String -> IO PageLayout
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"page-layout"

#if defined(ENABLE_OVERLOADING)
data DocumentPageLayoutPropertyInfo
instance AttrInfo DocumentPageLayoutPropertyInfo where
    type AttrAllowedOps DocumentPageLayoutPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DocumentPageLayoutPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentPageLayoutPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DocumentPageLayoutPropertyInfo = (~) ()
    type AttrTransferType DocumentPageLayoutPropertyInfo = ()
    type AttrGetType DocumentPageLayoutPropertyInfo = Poppler.Enums.PageLayout
    type AttrLabel DocumentPageLayoutPropertyInfo = "page-layout"
    type AttrOrigin DocumentPageLayoutPropertyInfo = Document
    attrGet = getDocumentPageLayout
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.pageLayout"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:pageLayout"
        })
#endif

-- VVV Prop "page-mode"
   -- Type: TInterface (Name {namespace = "Poppler", name = "PageMode"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@page-mode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #pageMode
-- @
getDocumentPageMode :: (MonadIO m, IsDocument o) => o -> m Poppler.Enums.PageMode
getDocumentPageMode :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m PageMode
getDocumentPageMode o
obj = IO PageMode -> m PageMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO PageMode -> m PageMode) -> IO PageMode -> m PageMode
forall a b. (a -> b) -> a -> b
$ o -> String -> IO PageMode
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"page-mode"

#if defined(ENABLE_OVERLOADING)
data DocumentPageModePropertyInfo
instance AttrInfo DocumentPageModePropertyInfo where
    type AttrAllowedOps DocumentPageModePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DocumentPageModePropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentPageModePropertyInfo = (~) ()
    type AttrTransferTypeConstraint DocumentPageModePropertyInfo = (~) ()
    type AttrTransferType DocumentPageModePropertyInfo = ()
    type AttrGetType DocumentPageModePropertyInfo = Poppler.Enums.PageMode
    type AttrLabel DocumentPageModePropertyInfo = "page-mode"
    type AttrOrigin DocumentPageModePropertyInfo = Document
    attrGet = getDocumentPageMode
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.pageMode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:pageMode"
        })
#endif

-- VVV Prop "permissions"
   -- Type: TInterface (Name {namespace = "Poppler", name = "Permissions"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@permissions@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #permissions
-- @
getDocumentPermissions :: (MonadIO m, IsDocument o) => o -> m [Poppler.Flags.Permissions]
getDocumentPermissions :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m [Permissions]
getDocumentPermissions o
obj = IO [Permissions] -> m [Permissions]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [Permissions] -> m [Permissions])
-> IO [Permissions] -> m [Permissions]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [Permissions]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"permissions"

#if defined(ENABLE_OVERLOADING)
data DocumentPermissionsPropertyInfo
instance AttrInfo DocumentPermissionsPropertyInfo where
    type AttrAllowedOps DocumentPermissionsPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DocumentPermissionsPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentPermissionsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DocumentPermissionsPropertyInfo = (~) ()
    type AttrTransferType DocumentPermissionsPropertyInfo = ()
    type AttrGetType DocumentPermissionsPropertyInfo = [Poppler.Flags.Permissions]
    type AttrLabel DocumentPermissionsPropertyInfo = "permissions"
    type AttrOrigin DocumentPermissionsPropertyInfo = Document
    attrGet = getDocumentPermissions
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.permissions"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:permissions"
        })
#endif

-- VVV Prop "print-duplex"
   -- Type: TInterface (Name {namespace = "Poppler", name = "PrintDuplex"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@print-duplex@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #printDuplex
-- @
getDocumentPrintDuplex :: (MonadIO m, IsDocument o) => o -> m Poppler.Enums.PrintDuplex
getDocumentPrintDuplex :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m PrintDuplex
getDocumentPrintDuplex o
obj = IO PrintDuplex -> m PrintDuplex
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO PrintDuplex -> m PrintDuplex)
-> IO PrintDuplex -> m PrintDuplex
forall a b. (a -> b) -> a -> b
$ o -> String -> IO PrintDuplex
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"print-duplex"

#if defined(ENABLE_OVERLOADING)
data DocumentPrintDuplexPropertyInfo
instance AttrInfo DocumentPrintDuplexPropertyInfo where
    type AttrAllowedOps DocumentPrintDuplexPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DocumentPrintDuplexPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentPrintDuplexPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DocumentPrintDuplexPropertyInfo = (~) ()
    type AttrTransferType DocumentPrintDuplexPropertyInfo = ()
    type AttrGetType DocumentPrintDuplexPropertyInfo = Poppler.Enums.PrintDuplex
    type AttrLabel DocumentPrintDuplexPropertyInfo = "print-duplex"
    type AttrOrigin DocumentPrintDuplexPropertyInfo = Document
    attrGet = getDocumentPrintDuplex
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.printDuplex"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:printDuplex"
        })
#endif

-- VVV Prop "print-n-copies"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@print-n-copies@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #printNCopies
-- @
getDocumentPrintNCopies :: (MonadIO m, IsDocument o) => o -> m Int32
getDocumentPrintNCopies :: forall (m :: * -> *) o. (MonadIO m, IsDocument o) => o -> m Int32
getDocumentPrintNCopies o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"print-n-copies"

#if defined(ENABLE_OVERLOADING)
data DocumentPrintNCopiesPropertyInfo
instance AttrInfo DocumentPrintNCopiesPropertyInfo where
    type AttrAllowedOps DocumentPrintNCopiesPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DocumentPrintNCopiesPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentPrintNCopiesPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DocumentPrintNCopiesPropertyInfo = (~) ()
    type AttrTransferType DocumentPrintNCopiesPropertyInfo = ()
    type AttrGetType DocumentPrintNCopiesPropertyInfo = Int32
    type AttrLabel DocumentPrintNCopiesPropertyInfo = "print-n-copies"
    type AttrOrigin DocumentPrintNCopiesPropertyInfo = Document
    attrGet = getDocumentPrintNCopies
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.printNCopies"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:printNCopies"
        })
#endif

-- VVV Prop "print-scaling"
   -- Type: TInterface (Name {namespace = "Poppler", name = "PrintScaling"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@print-scaling@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #printScaling
-- @
getDocumentPrintScaling :: (MonadIO m, IsDocument o) => o -> m Poppler.Enums.PrintScaling
getDocumentPrintScaling :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m PrintScaling
getDocumentPrintScaling o
obj = IO PrintScaling -> m PrintScaling
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO PrintScaling -> m PrintScaling)
-> IO PrintScaling -> m PrintScaling
forall a b. (a -> b) -> a -> b
$ o -> String -> IO PrintScaling
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"print-scaling"

#if defined(ENABLE_OVERLOADING)
data DocumentPrintScalingPropertyInfo
instance AttrInfo DocumentPrintScalingPropertyInfo where
    type AttrAllowedOps DocumentPrintScalingPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DocumentPrintScalingPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentPrintScalingPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DocumentPrintScalingPropertyInfo = (~) ()
    type AttrTransferType DocumentPrintScalingPropertyInfo = ()
    type AttrGetType DocumentPrintScalingPropertyInfo = Poppler.Enums.PrintScaling
    type AttrLabel DocumentPrintScalingPropertyInfo = "print-scaling"
    type AttrOrigin DocumentPrintScalingPropertyInfo = Document
    attrGet = getDocumentPrintScaling
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.printScaling"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:printScaling"
        })
#endif

-- VVV Prop "producer"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just False)

-- | Get the value of the “@producer@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #producer
-- @
getDocumentProducer :: (MonadIO m, IsDocument o) => o -> m (Maybe T.Text)
getDocumentProducer :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m (Maybe Text)
getDocumentProducer o
obj = IO (Maybe Text) -> m (Maybe Text)
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
"producer"

-- | Set the value of the “@producer@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' document [ #producer 'Data.GI.Base.Attributes.:=' value ]
-- @
setDocumentProducer :: (MonadIO m, IsDocument o) => o -> T.Text -> m ()
setDocumentProducer :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> Text -> m ()
setDocumentProducer o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"producer" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@producer@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDocumentProducer :: (IsDocument o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDocumentProducer :: forall o (m :: * -> *).
(IsDocument o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDocumentProducer Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"producer" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DocumentProducerPropertyInfo
instance AttrInfo DocumentProducerPropertyInfo where
    type AttrAllowedOps DocumentProducerPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DocumentProducerPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentProducerPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DocumentProducerPropertyInfo = (~) T.Text
    type AttrTransferType DocumentProducerPropertyInfo = T.Text
    type AttrGetType DocumentProducerPropertyInfo = (Maybe T.Text)
    type AttrLabel DocumentProducerPropertyInfo = "producer"
    type AttrOrigin DocumentProducerPropertyInfo = Document
    attrGet = getDocumentProducer
    attrSet = setDocumentProducer
    attrTransfer _ v = do
        return v
    attrConstruct = constructDocumentProducer
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.producer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:producer"
        })
#endif

-- VVV Prop "subject"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just False)

-- | Get the value of the “@subject@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #subject
-- @
getDocumentSubject :: (MonadIO m, IsDocument o) => o -> m (Maybe T.Text)
getDocumentSubject :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m (Maybe Text)
getDocumentSubject o
obj = IO (Maybe Text) -> m (Maybe Text)
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
"subject"

-- | Set the value of the “@subject@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' document [ #subject 'Data.GI.Base.Attributes.:=' value ]
-- @
setDocumentSubject :: (MonadIO m, IsDocument o) => o -> T.Text -> m ()
setDocumentSubject :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> Text -> m ()
setDocumentSubject o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"subject" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@subject@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDocumentSubject :: (IsDocument o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDocumentSubject :: forall o (m :: * -> *).
(IsDocument o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDocumentSubject Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"subject" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DocumentSubjectPropertyInfo
instance AttrInfo DocumentSubjectPropertyInfo where
    type AttrAllowedOps DocumentSubjectPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DocumentSubjectPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentSubjectPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DocumentSubjectPropertyInfo = (~) T.Text
    type AttrTransferType DocumentSubjectPropertyInfo = T.Text
    type AttrGetType DocumentSubjectPropertyInfo = (Maybe T.Text)
    type AttrLabel DocumentSubjectPropertyInfo = "subject"
    type AttrOrigin DocumentSubjectPropertyInfo = Document
    attrGet = getDocumentSubject
    attrSet = setDocumentSubject
    attrTransfer _ v = do
        return v
    attrConstruct = constructDocumentSubject
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.subject"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:subject"
        })
#endif

-- VVV Prop "subtype"
   -- Type: TInterface (Name {namespace = "Poppler", name = "PDFSubtype"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@subtype@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #subtype
-- @
getDocumentSubtype :: (MonadIO m, IsDocument o) => o -> m Poppler.Enums.PDFSubtype
getDocumentSubtype :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m PDFSubtype
getDocumentSubtype o
obj = IO PDFSubtype -> m PDFSubtype
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO PDFSubtype -> m PDFSubtype) -> IO PDFSubtype -> m PDFSubtype
forall a b. (a -> b) -> a -> b
$ o -> String -> IO PDFSubtype
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"subtype"

#if defined(ENABLE_OVERLOADING)
data DocumentSubtypePropertyInfo
instance AttrInfo DocumentSubtypePropertyInfo where
    type AttrAllowedOps DocumentSubtypePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DocumentSubtypePropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentSubtypePropertyInfo = (~) ()
    type AttrTransferTypeConstraint DocumentSubtypePropertyInfo = (~) ()
    type AttrTransferType DocumentSubtypePropertyInfo = ()
    type AttrGetType DocumentSubtypePropertyInfo = Poppler.Enums.PDFSubtype
    type AttrLabel DocumentSubtypePropertyInfo = "subtype"
    type AttrOrigin DocumentSubtypePropertyInfo = Document
    attrGet = getDocumentSubtype
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.subtype"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:subtype"
        })
#endif

-- VVV Prop "subtype-conformance"
   -- Type: TInterface (Name {namespace = "Poppler", name = "PDFConformance"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@subtype-conformance@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #subtypeConformance
-- @
getDocumentSubtypeConformance :: (MonadIO m, IsDocument o) => o -> m Poppler.Enums.PDFConformance
getDocumentSubtypeConformance :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m PDFConformance
getDocumentSubtypeConformance o
obj = IO PDFConformance -> m PDFConformance
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO PDFConformance -> m PDFConformance)
-> IO PDFConformance -> m PDFConformance
forall a b. (a -> b) -> a -> b
$ o -> String -> IO PDFConformance
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"subtype-conformance"

#if defined(ENABLE_OVERLOADING)
data DocumentSubtypeConformancePropertyInfo
instance AttrInfo DocumentSubtypeConformancePropertyInfo where
    type AttrAllowedOps DocumentSubtypeConformancePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DocumentSubtypeConformancePropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentSubtypeConformancePropertyInfo = (~) ()
    type AttrTransferTypeConstraint DocumentSubtypeConformancePropertyInfo = (~) ()
    type AttrTransferType DocumentSubtypeConformancePropertyInfo = ()
    type AttrGetType DocumentSubtypeConformancePropertyInfo = Poppler.Enums.PDFConformance
    type AttrLabel DocumentSubtypeConformancePropertyInfo = "subtype-conformance"
    type AttrOrigin DocumentSubtypeConformancePropertyInfo = Document
    attrGet = getDocumentSubtypeConformance
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.subtypeConformance"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:subtypeConformance"
        })
#endif

-- VVV Prop "subtype-part"
   -- Type: TInterface (Name {namespace = "Poppler", name = "PDFPart"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@subtype-part@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #subtypePart
-- @
getDocumentSubtypePart :: (MonadIO m, IsDocument o) => o -> m Poppler.Enums.PDFPart
getDocumentSubtypePart :: forall (m :: * -> *) o. (MonadIO m, IsDocument o) => o -> m PDFPart
getDocumentSubtypePart o
obj = IO PDFPart -> m PDFPart
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO PDFPart -> m PDFPart) -> IO PDFPart -> m PDFPart
forall a b. (a -> b) -> a -> b
$ o -> String -> IO PDFPart
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"subtype-part"

#if defined(ENABLE_OVERLOADING)
data DocumentSubtypePartPropertyInfo
instance AttrInfo DocumentSubtypePartPropertyInfo where
    type AttrAllowedOps DocumentSubtypePartPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DocumentSubtypePartPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentSubtypePartPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DocumentSubtypePartPropertyInfo = (~) ()
    type AttrTransferType DocumentSubtypePartPropertyInfo = ()
    type AttrGetType DocumentSubtypePartPropertyInfo = Poppler.Enums.PDFPart
    type AttrLabel DocumentSubtypePartPropertyInfo = "subtype-part"
    type AttrOrigin DocumentSubtypePartPropertyInfo = Document
    attrGet = getDocumentSubtypePart
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.subtypePart"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:subtypePart"
        })
#endif

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

-- | Get the value of the “@subtype-string@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #subtypeString
-- @
getDocumentSubtypeString :: (MonadIO m, IsDocument o) => o -> m (Maybe T.Text)
getDocumentSubtypeString :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m (Maybe Text)
getDocumentSubtypeString o
obj = IO (Maybe Text) -> m (Maybe Text)
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
"subtype-string"

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

-- VVV Prop "title"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just False)

-- | Get the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #title
-- @
getDocumentTitle :: (MonadIO m, IsDocument o) => o -> m (Maybe T.Text)
getDocumentTitle :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m (Maybe Text)
getDocumentTitle o
obj = IO (Maybe Text) -> m (Maybe Text)
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
"title"

-- | Set the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' document [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setDocumentTitle :: (MonadIO m, IsDocument o) => o -> T.Text -> m ()
setDocumentTitle :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> Text -> m ()
setDocumentTitle o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"title" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@title@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDocumentTitle :: (IsDocument o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDocumentTitle :: forall o (m :: * -> *).
(IsDocument o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDocumentTitle Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"title" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DocumentTitlePropertyInfo
instance AttrInfo DocumentTitlePropertyInfo where
    type AttrAllowedOps DocumentTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DocumentTitlePropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DocumentTitlePropertyInfo = (~) T.Text
    type AttrTransferType DocumentTitlePropertyInfo = T.Text
    type AttrGetType DocumentTitlePropertyInfo = (Maybe T.Text)
    type AttrLabel DocumentTitlePropertyInfo = "title"
    type AttrOrigin DocumentTitlePropertyInfo = Document
    attrGet = getDocumentTitle
    attrSet = setDocumentTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructDocumentTitle
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:title"
        })
#endif

-- VVV Prop "viewer-preferences"
   -- Type: TInterface (Name {namespace = "Poppler", name = "ViewerPreferences"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@viewer-preferences@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' document #viewerPreferences
-- @
getDocumentViewerPreferences :: (MonadIO m, IsDocument o) => o -> m [Poppler.Flags.ViewerPreferences]
getDocumentViewerPreferences :: forall (m :: * -> *) o.
(MonadIO m, IsDocument o) =>
o -> m [ViewerPreferences]
getDocumentViewerPreferences o
obj = IO [ViewerPreferences] -> m [ViewerPreferences]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [ViewerPreferences] -> m [ViewerPreferences])
-> IO [ViewerPreferences] -> m [ViewerPreferences]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [ViewerPreferences]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"viewer-preferences"

#if defined(ENABLE_OVERLOADING)
data DocumentViewerPreferencesPropertyInfo
instance AttrInfo DocumentViewerPreferencesPropertyInfo where
    type AttrAllowedOps DocumentViewerPreferencesPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DocumentViewerPreferencesPropertyInfo = IsDocument
    type AttrSetTypeConstraint DocumentViewerPreferencesPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DocumentViewerPreferencesPropertyInfo = (~) ()
    type AttrTransferType DocumentViewerPreferencesPropertyInfo = ()
    type AttrGetType DocumentViewerPreferencesPropertyInfo = [Poppler.Flags.ViewerPreferences]
    type AttrLabel DocumentViewerPreferencesPropertyInfo = "viewer-preferences"
    type AttrOrigin DocumentViewerPreferencesPropertyInfo = Document
    attrGet = getDocumentViewerPreferences
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.Document.viewerPreferences"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.26/docs/GI-Poppler-Objects-Document.html#g:attr:viewerPreferences"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Document
type instance O.AttributeList Document = DocumentAttributeList
type DocumentAttributeList = ('[ '("author", DocumentAuthorPropertyInfo), '("creationDate", DocumentCreationDatePropertyInfo), '("creationDatetime", DocumentCreationDatetimePropertyInfo), '("creator", DocumentCreatorPropertyInfo), '("format", DocumentFormatPropertyInfo), '("formatMajor", DocumentFormatMajorPropertyInfo), '("formatMinor", DocumentFormatMinorPropertyInfo), '("keywords", DocumentKeywordsPropertyInfo), '("linearized", DocumentLinearizedPropertyInfo), '("metadata", DocumentMetadataPropertyInfo), '("modDate", DocumentModDatePropertyInfo), '("modDatetime", DocumentModDatetimePropertyInfo), '("pageLayout", DocumentPageLayoutPropertyInfo), '("pageMode", DocumentPageModePropertyInfo), '("permissions", DocumentPermissionsPropertyInfo), '("printDuplex", DocumentPrintDuplexPropertyInfo), '("printNCopies", DocumentPrintNCopiesPropertyInfo), '("printScaling", DocumentPrintScalingPropertyInfo), '("producer", DocumentProducerPropertyInfo), '("subject", DocumentSubjectPropertyInfo), '("subtype", DocumentSubtypePropertyInfo), '("subtypeConformance", DocumentSubtypeConformancePropertyInfo), '("subtypePart", DocumentSubtypePartPropertyInfo), '("subtypeString", DocumentSubtypeStringPropertyInfo), '("title", DocumentTitlePropertyInfo), '("viewerPreferences", DocumentViewerPreferencesPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
documentAuthor :: AttrLabelProxy "author"
documentAuthor = AttrLabelProxy

documentCreationDate :: AttrLabelProxy "creationDate"
documentCreationDate = AttrLabelProxy

documentCreationDatetime :: AttrLabelProxy "creationDatetime"
documentCreationDatetime = AttrLabelProxy

documentCreator :: AttrLabelProxy "creator"
documentCreator = AttrLabelProxy

documentFormat :: AttrLabelProxy "format"
documentFormat = AttrLabelProxy

documentFormatMajor :: AttrLabelProxy "formatMajor"
documentFormatMajor = AttrLabelProxy

documentFormatMinor :: AttrLabelProxy "formatMinor"
documentFormatMinor = AttrLabelProxy

documentKeywords :: AttrLabelProxy "keywords"
documentKeywords = AttrLabelProxy

documentLinearized :: AttrLabelProxy "linearized"
documentLinearized = AttrLabelProxy

documentMetadata :: AttrLabelProxy "metadata"
documentMetadata = AttrLabelProxy

documentModDate :: AttrLabelProxy "modDate"
documentModDate = AttrLabelProxy

documentModDatetime :: AttrLabelProxy "modDatetime"
documentModDatetime = AttrLabelProxy

documentPageLayout :: AttrLabelProxy "pageLayout"
documentPageLayout = AttrLabelProxy

documentPageMode :: AttrLabelProxy "pageMode"
documentPageMode = AttrLabelProxy

documentPermissions :: AttrLabelProxy "permissions"
documentPermissions = AttrLabelProxy

documentPrintDuplex :: AttrLabelProxy "printDuplex"
documentPrintDuplex = AttrLabelProxy

documentPrintNCopies :: AttrLabelProxy "printNCopies"
documentPrintNCopies = AttrLabelProxy

documentPrintScaling :: AttrLabelProxy "printScaling"
documentPrintScaling = AttrLabelProxy

documentProducer :: AttrLabelProxy "producer"
documentProducer = AttrLabelProxy

documentSubject :: AttrLabelProxy "subject"
documentSubject = AttrLabelProxy

documentSubtype :: AttrLabelProxy "subtype"
documentSubtype = AttrLabelProxy

documentSubtypeConformance :: AttrLabelProxy "subtypeConformance"
documentSubtypeConformance = AttrLabelProxy

documentSubtypePart :: AttrLabelProxy "subtypePart"
documentSubtypePart = AttrLabelProxy

documentSubtypeString :: AttrLabelProxy "subtypeString"
documentSubtypeString = AttrLabelProxy

documentTitle :: AttrLabelProxy "title"
documentTitle = AttrLabelProxy

documentViewerPreferences :: AttrLabelProxy "viewerPreferences"
documentViewerPreferences = AttrLabelProxy

#endif

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

#endif

-- method Document::new_from_bytes
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "bytes"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GBytes" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "password"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "password to unlock the file with, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "Document" })
-- throws : True
-- Skip return : False

foreign import ccall "poppler_document_new_from_bytes" poppler_document_new_from_bytes :: 
    Ptr GLib.Bytes.Bytes ->                 -- bytes : TInterface (Name {namespace = "GLib", name = "Bytes"})
    CString ->                              -- password : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Document)

-- | Creates a new t'GI.Poppler.Objects.Document.Document' from /@bytes@/. The returned document
-- will hold a reference to /@bytes@/.
-- 
-- On error,  'P.Nothing' is returned, with /@error@/ set. Possible errors include
-- those in the @/POPPLER_ERROR/@ and @/G_FILE_ERROR/@ domains.
-- 
-- /Since: 0.82/
documentNewFromBytes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GLib.Bytes.Bytes
    -- ^ /@bytes@/: a t'GI.GLib.Structs.Bytes.Bytes'
    -> Maybe (T.Text)
    -- ^ /@password@/: password to unlock the file with, or 'P.Nothing'
    -> m Document
    -- ^ __Returns:__ a newly created t'GI.Poppler.Objects.Document.Document', or 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/
documentNewFromBytes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Bytes -> Maybe Text -> m Document
documentNewFromBytes Bytes
bytes Maybe Text
password = IO Document -> m Document
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Document -> m Document) -> IO Document -> m Document
forall a b. (a -> b) -> a -> b
$ do
    Ptr Bytes
bytes' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
bytes
    Ptr CChar
maybePassword <- case Maybe Text
password of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPassword -> do
            Ptr CChar
jPassword' <- Text -> IO (Ptr CChar)
textToCString Text
jPassword
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPassword'
    IO Document -> IO () -> IO Document
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Document
result <- (Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document))
-> (Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document)
forall a b. (a -> b) -> a -> b
$ Ptr Bytes -> Ptr CChar -> Ptr (Ptr GError) -> IO (Ptr Document)
poppler_document_new_from_bytes Ptr Bytes
bytes' Ptr CChar
maybePassword
        Text -> Ptr Document -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentNewFromBytes" Ptr Document
result
        Document
result' <- ((ManagedPtr Document -> Document) -> Ptr Document -> IO Document
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Document -> Document
Document) Ptr Document
result
        Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
bytes
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePassword
        Document -> IO Document
forall (m :: * -> *) a. Monad m => a -> m a
return Document
result'
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePassword
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Document::new_from_data
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 1 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pdf data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of #data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "password"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "password to unlock the file with, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of #data"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "Document" })
-- throws : True
-- Skip return : False

foreign import ccall "poppler_document_new_from_data" poppler_document_new_from_data :: 
    Ptr Word8 ->                            -- data : TCArray False (-1) 1 (TBasicType TUInt8)
    Int32 ->                                -- length : TBasicType TInt
    CString ->                              -- password : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Document)

{-# DEPRECATED documentNewFromData ["(Since version 0.82)","This requires directly managing /@length@/ and /@data@/.","Use 'GI.Poppler.Objects.Document.documentNewFromBytes' instead."] #-}
-- | Creates a new t'GI.Poppler.Objects.Document.Document'.  If 'P.Nothing' is returned, then /@error@/ will be
-- set. Possible errors include those in the @/POPPLER_ERROR/@ and @/G_FILE_ERROR/@
-- domains.
-- 
-- Note that /@data@/ is not copied nor is a new reference to it created.
-- It must remain valid and cannot be destroyed as long as the returned
-- document exists.
documentNewFromData ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ByteString
    -- ^ /@data@/: the pdf data
    -> Maybe (T.Text)
    -- ^ /@password@/: password to unlock the file with, or 'P.Nothing'
    -> m Document
    -- ^ __Returns:__ A newly created t'GI.Poppler.Objects.Document.Document', or 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/
documentNewFromData :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ByteString -> Maybe Text -> m Document
documentNewFromData ByteString
data_ Maybe Text
password = IO Document -> m Document
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Document -> m Document) -> IO Document -> m Document
forall a b. (a -> b) -> a -> b
$ do
    let length_ :: Int32
length_ = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    Ptr CChar
maybePassword <- case Maybe Text
password of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPassword -> do
            Ptr CChar
jPassword' <- Text -> IO (Ptr CChar)
textToCString Text
jPassword
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPassword'
    IO Document -> IO () -> IO Document
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Document
result <- (Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document))
-> (Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document)
forall a b. (a -> b) -> a -> b
$ Ptr Word8
-> Int32 -> Ptr CChar -> Ptr (Ptr GError) -> IO (Ptr Document)
poppler_document_new_from_data Ptr Word8
data_' Int32
length_ Ptr CChar
maybePassword
        Text -> Ptr Document -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentNewFromData" Ptr Document
result
        Document
result' <- ((ManagedPtr Document -> Document) -> Ptr Document -> IO Document
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Document -> Document
Document) Ptr Document
result
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePassword
        Document -> IO Document
forall (m :: * -> *) a. Monad m => a -> m a
return Document
result'
     ) (do
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePassword
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Document::new_from_file
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "uri of the file to load"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "password"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "password to unlock the file with, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "Document" })
-- throws : True
-- Skip return : False

foreign import ccall "poppler_document_new_from_file" poppler_document_new_from_file :: 
    CString ->                              -- uri : TBasicType TUTF8
    CString ->                              -- password : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Document)

-- | Creates a new t'GI.Poppler.Objects.Document.Document'.  If 'P.Nothing' is returned, then /@error@/ will be
-- set. Possible errors include those in the @/POPPLER_ERROR/@ and @/G_FILE_ERROR/@
-- domains.
documentNewFromFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@uri@/: uri of the file to load
    -> Maybe (T.Text)
    -- ^ /@password@/: password to unlock the file with, or 'P.Nothing'
    -> m Document
    -- ^ __Returns:__ A newly created t'GI.Poppler.Objects.Document.Document', or 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/
documentNewFromFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe Text -> m Document
documentNewFromFile Text
uri Maybe Text
password = IO Document -> m Document
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Document -> m Document) -> IO Document -> m Document
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
uri' <- Text -> IO (Ptr CChar)
textToCString Text
uri
    Ptr CChar
maybePassword <- case Maybe Text
password of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPassword -> do
            Ptr CChar
jPassword' <- Text -> IO (Ptr CChar)
textToCString Text
jPassword
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPassword'
    IO Document -> IO () -> IO Document
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Document
result <- (Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document))
-> (Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document)
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> Ptr CChar -> Ptr (Ptr GError) -> IO (Ptr Document)
poppler_document_new_from_file Ptr CChar
uri' Ptr CChar
maybePassword
        Text -> Ptr Document -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentNewFromFile" Ptr Document
result
        Document
result' <- ((ManagedPtr Document -> Document) -> Ptr Document -> IO Document
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Document -> Document
Document) Ptr Document
result
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePassword
        Document -> IO Document
forall (m :: * -> *) a. Monad m => a -> m a
return Document
result'
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePassword
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Document::new_from_gfile
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile to load" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "password"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "password to unlock the file with, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "Document" })
-- throws : True
-- Skip return : False

foreign import ccall "poppler_document_new_from_gfile" poppler_document_new_from_gfile :: 
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- password : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Document)

-- | Creates a new t'GI.Poppler.Objects.Document.Document' reading the PDF contents from /@file@/.
-- Possible errors include those in the @/POPPLER_ERROR/@ and @/G_FILE_ERROR/@
-- domains.
-- 
-- /Since: 0.22/
documentNewFromGfile ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File' to load
    -> Maybe (T.Text)
    -- ^ /@password@/: password to unlock the file with, or 'P.Nothing'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m Document
    -- ^ __Returns:__ a new t'GI.Poppler.Objects.Document.Document', or 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/
documentNewFromGfile :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe Text -> Maybe b -> m Document
documentNewFromGfile a
file Maybe Text
password Maybe b
cancellable = IO Document -> m Document
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Document -> m Document) -> IO Document -> m Document
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr CChar
maybePassword <- case Maybe Text
password of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPassword -> do
            Ptr CChar
jPassword' <- Text -> IO (Ptr CChar)
textToCString Text
jPassword
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPassword'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Document -> IO () -> IO Document
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Document
result <- (Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document))
-> (Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr CChar
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr Document)
poppler_document_new_from_gfile Ptr File
file' Ptr CChar
maybePassword Ptr Cancellable
maybeCancellable
        Text -> Ptr Document -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentNewFromGfile" Ptr Document
result
        Document
result' <- ((ManagedPtr Document -> Document) -> Ptr Document -> IO Document
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Document -> Document
Document) Ptr Document
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePassword
        Document -> IO Document
forall (m :: * -> *) a. Monad m => a -> m a
return Document
result'
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePassword
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Document::new_from_stream
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GInputStream to read from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the stream length, or -1 if not known"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "password"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "password to unlock the file with, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "Document" })
-- throws : True
-- Skip return : False

foreign import ccall "poppler_document_new_from_stream" poppler_document_new_from_stream :: 
    Ptr Gio.InputStream.InputStream ->      -- stream : TInterface (Name {namespace = "Gio", name = "InputStream"})
    Int64 ->                                -- length : TBasicType TInt64
    CString ->                              -- password : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Document)

-- | Creates a new t'GI.Poppler.Objects.Document.Document' reading the PDF contents from /@stream@/.
-- Note that the given t'GI.Gio.Objects.InputStream.InputStream' must be seekable or 'GI.Gio.Enums.IOErrorEnumNotSupported'
-- will be returned.
-- Possible errors include those in the @/POPPLER_ERROR/@, @/G_FILE_ERROR/@
-- and @/G_IO_ERROR/@ domains.
-- 
-- /Since: 0.22/
documentNewFromStream ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.InputStream.IsInputStream a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@stream@/: a t'GI.Gio.Objects.InputStream.InputStream' to read from
    -> Int64
    -- ^ /@length@/: the stream length, or -1 if not known
    -> Maybe (T.Text)
    -- ^ /@password@/: password to unlock the file with, or 'P.Nothing'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m Document
    -- ^ __Returns:__ a new t'GI.Poppler.Objects.Document.Document', or 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/
documentNewFromStream :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsInputStream a, IsCancellable b) =>
a -> Int64 -> Maybe Text -> Maybe b -> m Document
documentNewFromStream a
stream Int64
length_ Maybe Text
password Maybe b
cancellable = IO Document -> m Document
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Document -> m Document) -> IO Document -> m Document
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputStream
stream' <- a -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stream
    Ptr CChar
maybePassword <- case Maybe Text
password of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jPassword -> do
            Ptr CChar
jPassword' <- Text -> IO (Ptr CChar)
textToCString Text
jPassword
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jPassword'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Document -> IO () -> IO Document
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Document
result <- (Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document))
-> (Ptr (Ptr GError) -> IO (Ptr Document)) -> IO (Ptr Document)
forall a b. (a -> b) -> a -> b
$ Ptr InputStream
-> Int64
-> Ptr CChar
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr Document)
poppler_document_new_from_stream Ptr InputStream
stream' Int64
length_ Ptr CChar
maybePassword Ptr Cancellable
maybeCancellable
        Text -> Ptr Document -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentNewFromStream" Ptr Document
result
        Document
result' <- ((ManagedPtr Document -> Document) -> Ptr Document -> IO Document
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Document -> Document
Document) Ptr Document
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stream
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePassword
        Document -> IO Document
forall (m :: * -> *) a. Monad m => a -> m a
return Document
result'
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybePassword
     )

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "poppler_document_create_dests_tree" poppler_document_create_dests_tree :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO (Ptr GLib.Tree.Tree)

-- | Creates a balanced binary tree of all named destinations in /@document@/
-- 
-- The tree key is strings in the form returned by
-- 'GI.Poppler.Functions.namedDestToBytestring' which constains a destination name.
-- The tree value is the t'GI.Poppler.Structs.Dest.Dest' which contains a named destination.
-- The return value must be freed with 'GI.GLib.Structs.Tree.treeDestroy'.
-- 
-- /Since: 0.78/
documentCreateDestsTree ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m (Maybe GLib.Tree.Tree)
    -- ^ __Returns:__ the t'GI.GLib.Structs.Tree.Tree', or 'P.Nothing'
documentCreateDestsTree :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m (Maybe Tree)
documentCreateDestsTree a
document = IO (Maybe Tree) -> m (Maybe Tree)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Tree) -> m (Maybe Tree))
-> IO (Maybe Tree) -> m (Maybe Tree)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr Tree
result <- Ptr Document -> IO (Ptr Tree)
poppler_document_create_dests_tree Ptr Document
document'
    Maybe Tree
maybeResult <- Ptr Tree -> (Ptr Tree -> IO Tree) -> IO (Maybe Tree)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Tree
result ((Ptr Tree -> IO Tree) -> IO (Maybe Tree))
-> (Ptr Tree -> IO Tree) -> IO (Maybe Tree)
forall a b. (a -> b) -> a -> b
$ \Ptr Tree
result' -> do
        Tree
result'' <- ((ManagedPtr Tree -> Tree) -> Ptr Tree -> IO Tree
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Tree -> Tree
GLib.Tree.Tree) Ptr Tree
result'
        Tree -> IO Tree
forall (m :: * -> *) a. Monad m => a -> m a
return Tree
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Maybe Tree -> IO (Maybe Tree)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Tree
maybeResult

#if defined(ENABLE_OVERLOADING)
data DocumentCreateDestsTreeMethodInfo
instance (signature ~ (m (Maybe GLib.Tree.Tree)), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentCreateDestsTreeMethodInfo a signature where
    overloadedMethod = documentCreateDestsTree

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


#endif

-- method Document::find_dest
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "link_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a named destination"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Poppler" , name = "Dest" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_find_dest" poppler_document_find_dest :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    CString ->                              -- link_name : TBasicType TUTF8
    IO (Ptr Poppler.Dest.Dest)

-- | Creates a t'GI.Poppler.Structs.Dest.Dest' for the named destination /@linkName@/ in /@document@/.
-- 
-- Note that named destinations are bytestrings, not string. That means that
-- unless /@linkName@/ was returned by a poppler function (e.g. is
-- t'GI.Poppler.Structs.Dest.Dest'.@/named_dest/@), it needs to be converted to string
-- using 'GI.Poppler.Functions.namedDestFromBytestring' before being passed to this
-- function.
-- 
-- The returned value must be freed with 'GI.Poppler.Structs.Dest.destFree'.
documentFindDest ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> T.Text
    -- ^ /@linkName@/: a named destination
    -> m Poppler.Dest.Dest
    -- ^ __Returns:__ a new t'GI.Poppler.Structs.Dest.Dest' destination, or 'P.Nothing' if
    --   /@linkName@/ is not a destination.
documentFindDest :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Text -> m Dest
documentFindDest a
document Text
linkName = IO Dest -> m Dest
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Dest -> m Dest) -> IO Dest -> m Dest
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
linkName' <- Text -> IO (Ptr CChar)
textToCString Text
linkName
    Ptr Dest
result <- Ptr Document -> Ptr CChar -> IO (Ptr Dest)
poppler_document_find_dest Ptr Document
document' Ptr CChar
linkName'
    Text -> Ptr Dest -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentFindDest" Ptr Dest
result
    Dest
result' <- ((ManagedPtr Dest -> Dest) -> Ptr Dest -> IO Dest
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Dest -> Dest
Poppler.Dest.Dest) Ptr Dest
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
linkName'
    Dest -> IO Dest
forall (m :: * -> *) a. Monad m => a -> m a
return Dest
result'

#if defined(ENABLE_OVERLOADING)
data DocumentFindDestMethodInfo
instance (signature ~ (T.Text -> m Poppler.Dest.Dest), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentFindDestMethodInfo a signature where
    overloadedMethod = documentFindDest

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


#endif

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

foreign import ccall "poppler_document_get_attachments" poppler_document_get_attachments :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO (Ptr (GList (Ptr Poppler.Attachment.Attachment)))

-- | Returns a t'GI.GLib.Structs.List.List' containing t'GI.Poppler.Objects.Attachment.Attachment's.  These attachments
-- are unowned, and must be unreffed, and the list must be freed with
-- @/g_list_free()/@.
documentGetAttachments ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m [Poppler.Attachment.Attachment]
    -- ^ __Returns:__ a list of available attachments.
documentGetAttachments :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m [Attachment]
documentGetAttachments a
document = IO [Attachment] -> m [Attachment]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Attachment] -> m [Attachment])
-> IO [Attachment] -> m [Attachment]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr (GList (Ptr Attachment))
result <- Ptr Document -> IO (Ptr (GList (Ptr Attachment)))
poppler_document_get_attachments Ptr Document
document'
    [Ptr Attachment]
result' <- Ptr (GList (Ptr Attachment)) -> IO [Ptr Attachment]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Attachment))
result
    [Attachment]
result'' <- (Ptr Attachment -> IO Attachment)
-> [Ptr Attachment] -> IO [Attachment]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Attachment -> Attachment)
-> Ptr Attachment -> IO Attachment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Attachment -> Attachment
Poppler.Attachment.Attachment) [Ptr Attachment]
result'
    Ptr (GList (Ptr Attachment)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Attachment))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    [Attachment] -> IO [Attachment]
forall (m :: * -> *) a. Monad m => a -> m a
return [Attachment]
result''

#if defined(ENABLE_OVERLOADING)
data DocumentGetAttachmentsMethodInfo
instance (signature ~ (m [Poppler.Attachment.Attachment]), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetAttachmentsMethodInfo a signature where
    overloadedMethod = documentGetAttachments

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


#endif

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

foreign import ccall "poppler_document_get_author" poppler_document_get_author :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CString

-- | Returns the author of the document
-- 
-- /Since: 0.16/
documentGetAuthor ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string containing the author
    --               of /@document@/, or 'P.Nothing'
documentGetAuthor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Text
documentGetAuthor a
document = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
result <- Ptr Document -> IO (Ptr CChar)
poppler_document_get_author Ptr Document
document'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentGetAuthor" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetAuthorMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetAuthorMethodInfo a signature where
    overloadedMethod = documentGetAuthor

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


#endif

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

foreign import ccall "poppler_document_get_creation_date" poppler_document_get_creation_date :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CLong

-- | Returns the date the document was created as seconds since the Epoch
-- 
-- /Since: 0.16/
documentGetCreationDate ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m CLong
    -- ^ __Returns:__ the date the document was created, or -1
documentGetCreationDate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m CLong
documentGetCreationDate a
document = IO CLong -> m CLong
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CLong -> m CLong) -> IO CLong -> m CLong
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    CLong
result <- Ptr Document -> IO CLong
poppler_document_get_creation_date Ptr Document
document'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    CLong -> IO CLong
forall (m :: * -> *) a. Monad m => a -> m a
return CLong
result

#if defined(ENABLE_OVERLOADING)
data DocumentGetCreationDateMethodInfo
instance (signature ~ (m CLong), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetCreationDateMethodInfo a signature where
    overloadedMethod = documentGetCreationDate

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


#endif

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

foreign import ccall "poppler_document_get_creation_date_time" poppler_document_get_creation_date_time :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO (Ptr GLib.DateTime.DateTime)

-- | Returns the date the document was created as a t'GI.GLib.Structs.DateTime.DateTime'
-- 
-- /Since: 20.09.0/
documentGetCreationDateTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m (Maybe GLib.DateTime.DateTime)
    -- ^ __Returns:__ the date the document was created, or 'P.Nothing'
documentGetCreationDateTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m (Maybe DateTime)
documentGetCreationDateTime a
document = IO (Maybe DateTime) -> m (Maybe DateTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DateTime) -> m (Maybe DateTime))
-> IO (Maybe DateTime) -> m (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr DateTime
result <- Ptr Document -> IO (Ptr DateTime)
poppler_document_get_creation_date_time Ptr Document
document'
    Maybe DateTime
maybeResult <- Ptr DateTime
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DateTime
result ((Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime))
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ \Ptr DateTime
result' -> do
        DateTime
result'' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
GLib.DateTime.DateTime) Ptr DateTime
result'
        DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Maybe DateTime -> IO (Maybe DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DateTime
maybeResult

#if defined(ENABLE_OVERLOADING)
data DocumentGetCreationDateTimeMethodInfo
instance (signature ~ (m (Maybe GLib.DateTime.DateTime)), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetCreationDateTimeMethodInfo a signature where
    overloadedMethod = documentGetCreationDateTime

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


#endif

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

foreign import ccall "poppler_document_get_creator" poppler_document_get_creator :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CString

-- | Returns the creator of the document. If the document was converted
-- from another format, the creator is the name of the product
-- that created the original document from which it was converted.
-- 
-- /Since: 0.16/
documentGetCreator ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string containing the creator
    --               of /@document@/, or 'P.Nothing'
documentGetCreator :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Text
documentGetCreator a
document = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
result <- Ptr Document -> IO (Ptr CChar)
poppler_document_get_creator Ptr Document
document'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentGetCreator" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetCreatorMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetCreatorMethodInfo a signature where
    overloadedMethod = documentGetCreator

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


#endif

-- method Document::get_form_field
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an id of a #PopplerFormField"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Poppler" , name = "FormField" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_get_form_field" poppler_document_get_form_field :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    Int32 ->                                -- id : TBasicType TInt
    IO (Ptr Poppler.FormField.FormField)

-- | Returns the t'GI.Poppler.Objects.FormField.FormField' for the given /@id@/. It must be freed with
-- 'GI.GObject.Objects.Object.objectUnref'
documentGetFormField ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: a t'GI.Poppler.Objects.Document.Document'
    -> Int32
    -- ^ /@id@/: an id of a t'GI.Poppler.Objects.FormField.FormField'
    -> m Poppler.FormField.FormField
    -- ^ __Returns:__ a new t'GI.Poppler.Objects.FormField.FormField' or 'P.Nothing' if
    -- not found
documentGetFormField :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Int32 -> m FormField
documentGetFormField a
document Int32
id = IO FormField -> m FormField
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FormField -> m FormField) -> IO FormField -> m FormField
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr FormField
result <- Ptr Document -> Int32 -> IO (Ptr FormField)
poppler_document_get_form_field Ptr Document
document' Int32
id
    Text -> Ptr FormField -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentGetFormField" Ptr FormField
result
    FormField
result' <- ((ManagedPtr FormField -> FormField)
-> Ptr FormField -> IO FormField
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FormField -> FormField
Poppler.FormField.FormField) Ptr FormField
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    FormField -> IO FormField
forall (m :: * -> *) a. Monad m => a -> m a
return FormField
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetFormFieldMethodInfo
instance (signature ~ (Int32 -> m Poppler.FormField.FormField), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetFormFieldMethodInfo a signature where
    overloadedMethod = documentGetFormField

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


#endif

-- method Document::get_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "permanent_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store an allocated string, use g_free() to free the returned string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "update_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store an allocated string, use g_free() to free the returned string"
--                 , 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_document_get_id" poppler_document_get_id :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    Ptr CString ->                          -- permanent_id : TBasicType TUTF8
    Ptr CString ->                          -- update_id : TBasicType TUTF8
    IO CInt

-- | Returns the PDF file identifier represented as two byte string arrays of size 32.
-- /@permanentId@/ is the permanent identifier that is built based on the file
-- contents at the time it was originally created, so that this identifer
-- never changes. /@updateId@/ is the update identifier that is built based on
-- the file contents at the time it was last updated.
-- 
-- Note that returned strings are not null-terminated, they have a fixed
-- size of 32 bytes.
-- 
-- /Since: 0.16/
documentGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m ((Bool, T.Text, T.Text))
    -- ^ __Returns:__ 'P.True' if the /@document@/ contains an id, 'P.False' otherwise
documentGetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m (Bool, Text, Text)
documentGetId a
document = IO (Bool, Text, Text) -> m (Bool, Text, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Text, Text) -> m (Bool, Text, Text))
-> IO (Bool, Text, Text) -> m (Bool, Text, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr (Ptr CChar)
permanentId <- IO (Ptr (Ptr CChar))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr (Ptr CChar)
updateId <- IO (Ptr (Ptr CChar))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    CInt
result <- Ptr Document -> Ptr (Ptr CChar) -> Ptr (Ptr CChar) -> IO CInt
poppler_document_get_id Ptr Document
document' Ptr (Ptr CChar)
permanentId Ptr (Ptr CChar)
updateId
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr CChar
permanentId' <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
permanentId
    Text
permanentId'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
permanentId'
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
permanentId'
    Ptr CChar
updateId' <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
updateId
    Text
updateId'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
updateId'
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
updateId'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
permanentId
    Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
updateId
    (Bool, Text, Text) -> IO (Bool, Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Text
permanentId'', Text
updateId'')

#if defined(ENABLE_OVERLOADING)
data DocumentGetIdMethodInfo
instance (signature ~ (m ((Bool, T.Text, T.Text))), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetIdMethodInfo a signature where
    overloadedMethod = documentGetId

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


#endif

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

foreign import ccall "poppler_document_get_keywords" poppler_document_get_keywords :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CString

-- | Returns the keywords associated to the document
-- 
-- /Since: 0.16/
documentGetKeywords ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string containing keywords associated
    --               to /@document@/, or 'P.Nothing'
documentGetKeywords :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Text
documentGetKeywords a
document = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
result <- Ptr Document -> IO (Ptr CChar)
poppler_document_get_keywords Ptr Document
document'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentGetKeywords" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetKeywordsMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetKeywordsMethodInfo a signature where
    overloadedMethod = documentGetKeywords

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


#endif

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

foreign import ccall "poppler_document_get_metadata" poppler_document_get_metadata :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CString

-- | Returns the XML metadata string of the document
-- 
-- /Since: 0.16/
documentGetMetadata ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string containing the XML
    --               metadata, or 'P.Nothing'
documentGetMetadata :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Text
documentGetMetadata a
document = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
result <- Ptr Document -> IO (Ptr CChar)
poppler_document_get_metadata Ptr Document
document'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentGetMetadata" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetMetadataMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetMetadataMethodInfo a signature where
    overloadedMethod = documentGetMetadata

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


#endif

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

foreign import ccall "poppler_document_get_modification_date" poppler_document_get_modification_date :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CLong

-- | Returns the date the document was most recently modified as seconds since the Epoch
-- 
-- /Since: 0.16/
documentGetModificationDate ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m CLong
    -- ^ __Returns:__ the date the document was most recently modified, or -1
documentGetModificationDate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m CLong
documentGetModificationDate a
document = IO CLong -> m CLong
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CLong -> m CLong) -> IO CLong -> m CLong
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    CLong
result <- Ptr Document -> IO CLong
poppler_document_get_modification_date Ptr Document
document'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    CLong -> IO CLong
forall (m :: * -> *) a. Monad m => a -> m a
return CLong
result

#if defined(ENABLE_OVERLOADING)
data DocumentGetModificationDateMethodInfo
instance (signature ~ (m CLong), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetModificationDateMethodInfo a signature where
    overloadedMethod = documentGetModificationDate

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


#endif

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

foreign import ccall "poppler_document_get_modification_date_time" poppler_document_get_modification_date_time :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO (Ptr GLib.DateTime.DateTime)

-- | Returns the date the document was most recently modified as a t'GI.GLib.Structs.DateTime.DateTime'
-- 
-- /Since: 20.09.0/
documentGetModificationDateTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m (Maybe GLib.DateTime.DateTime)
    -- ^ __Returns:__ the date the document was modified, or 'P.Nothing'
documentGetModificationDateTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m (Maybe DateTime)
documentGetModificationDateTime a
document = IO (Maybe DateTime) -> m (Maybe DateTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DateTime) -> m (Maybe DateTime))
-> IO (Maybe DateTime) -> m (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr DateTime
result <- Ptr Document -> IO (Ptr DateTime)
poppler_document_get_modification_date_time Ptr Document
document'
    Maybe DateTime
maybeResult <- Ptr DateTime
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DateTime
result ((Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime))
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ \Ptr DateTime
result' -> do
        DateTime
result'' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
GLib.DateTime.DateTime) Ptr DateTime
result'
        DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Maybe DateTime -> IO (Maybe DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DateTime
maybeResult

#if defined(ENABLE_OVERLOADING)
data DocumentGetModificationDateTimeMethodInfo
instance (signature ~ (m (Maybe GLib.DateTime.DateTime)), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetModificationDateTimeMethodInfo a signature where
    overloadedMethod = documentGetModificationDateTime

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


#endif

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

foreign import ccall "poppler_document_get_n_attachments" poppler_document_get_n_attachments :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO Word32

-- | Returns the number of attachments in a loaded document.
-- See also 'GI.Poppler.Objects.Document.documentGetAttachments'
-- 
-- /Since: 0.18/
documentGetNAttachments ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m Word32
    -- ^ __Returns:__ Number of attachments
documentGetNAttachments :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Word32
documentGetNAttachments a
document = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Word32
result <- Ptr Document -> IO Word32
poppler_document_get_n_attachments Ptr Document
document'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data DocumentGetNAttachmentsMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetNAttachmentsMethodInfo a signature where
    overloadedMethod = documentGetNAttachments

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


#endif

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

foreign import ccall "poppler_document_get_n_pages" poppler_document_get_n_pages :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO Int32

-- | Returns the number of pages in a loaded document.
documentGetNPages ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m Int32
    -- ^ __Returns:__ Number of pages
documentGetNPages :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Int32
documentGetNPages a
document = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Int32
result <- Ptr Document -> IO Int32
poppler_document_get_n_pages Ptr Document
document'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DocumentGetNPagesMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetNPagesMethodInfo a signature where
    overloadedMethod = documentGetNPages

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


#endif

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

foreign import ccall "poppler_document_get_page" poppler_document_get_page :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    Int32 ->                                -- index : TBasicType TInt
    IO (Ptr Poppler.Page.Page)

-- | Returns the t'GI.Poppler.Objects.Page.Page' indexed at /@index@/.  This object is owned by the
-- caller.
documentGetPage ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> Int32
    -- ^ /@index@/: a page index
    -> m Poppler.Page.Page
    -- ^ __Returns:__ The t'GI.Poppler.Objects.Page.Page' at /@index@/
documentGetPage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Int32 -> m Page
documentGetPage a
document Int32
index = IO Page -> m Page
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Page -> m Page) -> IO Page -> m Page
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr Page
result <- Ptr Document -> Int32 -> IO (Ptr Page)
poppler_document_get_page Ptr Document
document' Int32
index
    Text -> Ptr Page -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentGetPage" Ptr Page
result
    Page
result' <- ((ManagedPtr Page -> Page) -> Ptr Page -> IO Page
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Page -> Page
Poppler.Page.Page) Ptr Page
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Page -> IO Page
forall (m :: * -> *) a. Monad m => a -> m a
return Page
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetPageMethodInfo
instance (signature ~ (Int32 -> m Poppler.Page.Page), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPageMethodInfo a signature where
    overloadedMethod = documentGetPage

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


#endif

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

foreign import ccall "poppler_document_get_page_by_label" poppler_document_get_page_by_label :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    CString ->                              -- label : TBasicType TUTF8
    IO (Ptr Poppler.Page.Page)

-- | Returns the t'GI.Poppler.Objects.Page.Page' reference by /@label@/.  This object is owned by the
-- caller.  /@label@/ is a human-readable string representation of the page number,
-- and can be document specific.  Typically, it is a value such as \"iii\" or \"3\".
-- 
-- By default, \"1\" refers to the first page.
documentGetPageByLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> T.Text
    -- ^ /@label@/: a page label
    -> m Poppler.Page.Page
    -- ^ __Returns:__ The t'GI.Poppler.Objects.Page.Page' referenced by /@label@/
documentGetPageByLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Text -> m Page
documentGetPageByLabel a
document Text
label = IO Page -> m Page
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Page -> m Page) -> IO Page -> m Page
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
label' <- Text -> IO (Ptr CChar)
textToCString Text
label
    Ptr Page
result <- Ptr Document -> Ptr CChar -> IO (Ptr Page)
poppler_document_get_page_by_label Ptr Document
document' Ptr CChar
label'
    Text -> Ptr Page -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentGetPageByLabel" Ptr Page
result
    Page
result' <- ((ManagedPtr Page -> Page) -> Ptr Page -> IO Page
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Page -> Page
Poppler.Page.Page) Ptr Page
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
label'
    Page -> IO Page
forall (m :: * -> *) a. Monad m => a -> m a
return Page
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetPageByLabelMethodInfo
instance (signature ~ (T.Text -> m Poppler.Page.Page), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPageByLabelMethodInfo a signature where
    overloadedMethod = documentGetPageByLabel

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


#endif

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

foreign import ccall "poppler_document_get_page_layout" poppler_document_get_page_layout :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CUInt

-- | Returns the page layout that should be used when the document is opened
-- 
-- /Since: 0.16/
documentGetPageLayout ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m Poppler.Enums.PageLayout
    -- ^ __Returns:__ a t'GI.Poppler.Enums.PageLayout' that should be used when the document is opened
documentGetPageLayout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m PageLayout
documentGetPageLayout a
document = IO PageLayout -> m PageLayout
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PageLayout -> m PageLayout) -> IO PageLayout -> m PageLayout
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    CUInt
result <- Ptr Document -> IO CUInt
poppler_document_get_page_layout Ptr Document
document'
    let result' :: PageLayout
result' = (Int -> PageLayout
forall a. Enum a => Int -> a
toEnum (Int -> PageLayout) -> (CUInt -> Int) -> CUInt -> PageLayout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    PageLayout -> IO PageLayout
forall (m :: * -> *) a. Monad m => a -> m a
return PageLayout
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetPageLayoutMethodInfo
instance (signature ~ (m Poppler.Enums.PageLayout), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPageLayoutMethodInfo a signature where
    overloadedMethod = documentGetPageLayout

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


#endif

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

foreign import ccall "poppler_document_get_page_mode" poppler_document_get_page_mode :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CUInt

-- | Returns a t'GI.Poppler.Enums.PageMode' representing how the document should
-- be initially displayed when opened.
-- 
-- /Since: 0.16/
documentGetPageMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m Poppler.Enums.PageMode
    -- ^ __Returns:__ a t'GI.Poppler.Enums.PageMode' that should be used when document is opened
documentGetPageMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m PageMode
documentGetPageMode a
document = IO PageMode -> m PageMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PageMode -> m PageMode) -> IO PageMode -> m PageMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    CUInt
result <- Ptr Document -> IO CUInt
poppler_document_get_page_mode Ptr Document
document'
    let result' :: PageMode
result' = (Int -> PageMode
forall a. Enum a => Int -> a
toEnum (Int -> PageMode) -> (CUInt -> Int) -> CUInt -> PageMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    PageMode -> IO PageMode
forall (m :: * -> *) a. Monad m => a -> m a
return PageMode
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetPageModeMethodInfo
instance (signature ~ (m Poppler.Enums.PageMode), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPageModeMethodInfo a signature where
    overloadedMethod = documentGetPageMode

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


#endif

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

foreign import ccall "poppler_document_get_pdf_conformance" poppler_document_get_pdf_conformance :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CUInt

-- | Returns the conformance level of the /@document@/ as t'GI.Poppler.Enums.PDFConformance'.
-- 
-- /Since: 0.70/
documentGetPdfConformance ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m Poppler.Enums.PDFConformance
    -- ^ __Returns:__ the document\'s subtype conformance level
documentGetPdfConformance :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m PDFConformance
documentGetPdfConformance a
document = IO PDFConformance -> m PDFConformance
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PDFConformance -> m PDFConformance)
-> IO PDFConformance -> m PDFConformance
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    CUInt
result <- Ptr Document -> IO CUInt
poppler_document_get_pdf_conformance Ptr Document
document'
    let result' :: PDFConformance
result' = (Int -> PDFConformance
forall a. Enum a => Int -> a
toEnum (Int -> PDFConformance)
-> (CUInt -> Int) -> CUInt -> PDFConformance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    PDFConformance -> IO PDFConformance
forall (m :: * -> *) a. Monad m => a -> m a
return PDFConformance
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetPdfConformanceMethodInfo
instance (signature ~ (m Poppler.Enums.PDFConformance), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPdfConformanceMethodInfo a signature where
    overloadedMethod = documentGetPdfConformance

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


#endif

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

foreign import ccall "poppler_document_get_pdf_part" poppler_document_get_pdf_part :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CUInt

-- | Returns the part of the conforming standard that the /@document@/ adheres to
-- as a t'GI.Poppler.Enums.PDFSubtype'.
-- 
-- /Since: 0.70/
documentGetPdfPart ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m Poppler.Enums.PDFPart
    -- ^ __Returns:__ the document\'s subtype part
documentGetPdfPart :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m PDFPart
documentGetPdfPart a
document = IO PDFPart -> m PDFPart
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PDFPart -> m PDFPart) -> IO PDFPart -> m PDFPart
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    CUInt
result <- Ptr Document -> IO CUInt
poppler_document_get_pdf_part Ptr Document
document'
    let result' :: PDFPart
result' = (Int -> PDFPart
forall a. Enum a => Int -> a
toEnum (Int -> PDFPart) -> (CUInt -> Int) -> CUInt -> PDFPart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    PDFPart -> IO PDFPart
forall (m :: * -> *) a. Monad m => a -> m a
return PDFPart
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetPdfPartMethodInfo
instance (signature ~ (m Poppler.Enums.PDFPart), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPdfPartMethodInfo a signature where
    overloadedMethod = documentGetPdfPart

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


#endif

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

foreign import ccall "poppler_document_get_pdf_subtype" poppler_document_get_pdf_subtype :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CUInt

-- | Returns the subtype of /@document@/ as a t'GI.Poppler.Enums.PDFSubtype'.
-- 
-- /Since: 0.70/
documentGetPdfSubtype ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m Poppler.Enums.PDFSubtype
    -- ^ __Returns:__ the document\'s subtype
documentGetPdfSubtype :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m PDFSubtype
documentGetPdfSubtype a
document = IO PDFSubtype -> m PDFSubtype
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PDFSubtype -> m PDFSubtype) -> IO PDFSubtype -> m PDFSubtype
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    CUInt
result <- Ptr Document -> IO CUInt
poppler_document_get_pdf_subtype Ptr Document
document'
    let result' :: PDFSubtype
result' = (Int -> PDFSubtype
forall a. Enum a => Int -> a
toEnum (Int -> PDFSubtype) -> (CUInt -> Int) -> CUInt -> PDFSubtype
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    PDFSubtype -> IO PDFSubtype
forall (m :: * -> *) a. Monad m => a -> m a
return PDFSubtype
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetPdfSubtypeMethodInfo
instance (signature ~ (m Poppler.Enums.PDFSubtype), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPdfSubtypeMethodInfo a signature where
    overloadedMethod = documentGetPdfSubtype

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


#endif

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

foreign import ccall "poppler_document_get_pdf_subtype_string" poppler_document_get_pdf_subtype_string :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CString

-- | Returns the PDF subtype version of /@document@/ as a string.
-- 
-- /Since: 0.70/
documentGetPdfSubtypeString ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a newly allocated string containing
    -- the PDF subtype version of /@document@/, or 'P.Nothing'
documentGetPdfSubtypeString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m (Maybe Text)
documentGetPdfSubtypeString a
document = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
result <- Ptr Document -> IO (Ptr CChar)
poppler_document_get_pdf_subtype_string Ptr Document
document'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data DocumentGetPdfSubtypeStringMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPdfSubtypeStringMethodInfo a signature where
    overloadedMethod = documentGetPdfSubtypeString

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


#endif

-- method Document::get_pdf_version
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "major_version"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the PDF major version number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "minor_version"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the PDF minor version number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_get_pdf_version" poppler_document_get_pdf_version :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    Ptr Word32 ->                           -- major_version : TBasicType TUInt
    Ptr Word32 ->                           -- minor_version : TBasicType TUInt
    IO ()

-- | Updates values referenced by /@majorVersion@/ & /@minorVersion@/ with the
-- major and minor PDF versions of /@document@/.
-- 
-- /Since: 0.16/
documentGetPdfVersion ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m ((Word32, Word32))
documentGetPdfVersion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m (Word32, Word32)
documentGetPdfVersion a
document = IO (Word32, Word32) -> m (Word32, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word32, Word32) -> m (Word32, Word32))
-> IO (Word32, Word32) -> m (Word32, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr Word32
majorVersion <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
minorVersion <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Document -> Ptr Word32 -> Ptr Word32 -> IO ()
poppler_document_get_pdf_version Ptr Document
document' Ptr Word32
majorVersion Ptr Word32
minorVersion
    Word32
majorVersion' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
majorVersion
    Word32
minorVersion' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
minorVersion
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
majorVersion
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
minorVersion
    (Word32, Word32) -> IO (Word32, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
majorVersion', Word32
minorVersion')

#if defined(ENABLE_OVERLOADING)
data DocumentGetPdfVersionMethodInfo
instance (signature ~ (m ((Word32, Word32))), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPdfVersionMethodInfo a signature where
    overloadedMethod = documentGetPdfVersion

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


#endif

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

foreign import ccall "poppler_document_get_pdf_version_string" poppler_document_get_pdf_version_string :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CString

-- | Returns the PDF version of /@document@/ as a string (e.g. PDF-1.6)
-- 
-- /Since: 0.16/
documentGetPdfVersionString ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string containing the PDF version
    --               of /@document@/, or 'P.Nothing'
documentGetPdfVersionString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Text
documentGetPdfVersionString a
document = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
result <- Ptr Document -> IO (Ptr CChar)
poppler_document_get_pdf_version_string Ptr Document
document'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentGetPdfVersionString" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetPdfVersionStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPdfVersionStringMethodInfo a signature where
    overloadedMethod = documentGetPdfVersionString

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


#endif

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

foreign import ccall "poppler_document_get_permissions" poppler_document_get_permissions :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CUInt

-- | Returns the flags specifying which operations are permitted when the document is opened.
-- 
-- /Since: 0.16/
documentGetPermissions ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m [Poppler.Flags.Permissions]
    -- ^ __Returns:__ a set of flags from  t'GI.Poppler.Flags.Permissions' enumeration
documentGetPermissions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m [Permissions]
documentGetPermissions a
document = IO [Permissions] -> m [Permissions]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Permissions] -> m [Permissions])
-> IO [Permissions] -> m [Permissions]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    CUInt
result <- Ptr Document -> IO CUInt
poppler_document_get_permissions Ptr Document
document'
    let result' :: [Permissions]
result' = CUInt -> [Permissions]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    [Permissions] -> IO [Permissions]
forall (m :: * -> *) a. Monad m => a -> m a
return [Permissions]
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetPermissionsMethodInfo
instance (signature ~ (m [Poppler.Flags.Permissions]), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPermissionsMethodInfo a signature where
    overloadedMethod = documentGetPermissions

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


#endif

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

foreign import ccall "poppler_document_get_print_duplex" poppler_document_get_print_duplex :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CUInt

-- | Returns the duplex mode value suggested for printing by author of the document.
-- Value POPPLER_PRINT_DUPLEX_NONE means that the document does not specify this
-- preference.
-- 
-- /Since: 0.80/
documentGetPrintDuplex ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m Poppler.Enums.PrintDuplex
    -- ^ __Returns:__ a t'GI.Poppler.Enums.PrintDuplex' that should be used when document is printed
documentGetPrintDuplex :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m PrintDuplex
documentGetPrintDuplex a
document = IO PrintDuplex -> m PrintDuplex
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PrintDuplex -> m PrintDuplex)
-> IO PrintDuplex -> m PrintDuplex
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    CUInt
result <- Ptr Document -> IO CUInt
poppler_document_get_print_duplex Ptr Document
document'
    let result' :: PrintDuplex
result' = (Int -> PrintDuplex
forall a. Enum a => Int -> a
toEnum (Int -> PrintDuplex) -> (CUInt -> Int) -> CUInt -> PrintDuplex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    PrintDuplex -> IO PrintDuplex
forall (m :: * -> *) a. Monad m => a -> m a
return PrintDuplex
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetPrintDuplexMethodInfo
instance (signature ~ (m Poppler.Enums.PrintDuplex), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPrintDuplexMethodInfo a signature where
    overloadedMethod = documentGetPrintDuplex

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


#endif

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

foreign import ccall "poppler_document_get_print_n_copies" poppler_document_get_print_n_copies :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO Int32

-- | Returns the suggested number of copies to be printed.
-- This preference should be applied only if returned value
-- is greater than 1 since value 1 usually means that
-- the document does not specify it.
-- 
-- /Since: 0.80/
documentGetPrintNCopies ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m Int32
    -- ^ __Returns:__ Number of copies
documentGetPrintNCopies :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Int32
documentGetPrintNCopies a
document = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Int32
result <- Ptr Document -> IO Int32
poppler_document_get_print_n_copies Ptr Document
document'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data DocumentGetPrintNCopiesMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPrintNCopiesMethodInfo a signature where
    overloadedMethod = documentGetPrintNCopies

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


#endif

-- method Document::get_print_page_ranges
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_ranges"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for number of ranges"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_ranges"
--              , argType = TBasicType TInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "return location for number of ranges"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just
--               (TCArray
--                  False
--                  (-1)
--                  1
--                  (TInterface Name { namespace = "Poppler" , name = "PageRange" }))
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_get_print_page_ranges" poppler_document_get_print_page_ranges :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    Ptr Int32 ->                            -- n_ranges : TBasicType TInt
    IO (Ptr Poppler.PageRange.PageRange)

-- | Returns the suggested page ranges to print in the form of array
-- of t'GI.Poppler.Structs.PageRange.PageRange's and number of ranges.
-- 'P.Nothing' pointer means that the document does not specify page ranges
-- for printing.
-- 
-- /Since: 0.80/
documentGetPrintPageRanges ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m [Poppler.PageRange.PageRange]
    -- ^ __Returns:__ an array
    --          of t'GI.Poppler.Structs.PageRange.PageRange's or 'P.Nothing'. Free the array when
    --          it is no longer needed.
documentGetPrintPageRanges :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m [PageRange]
documentGetPrintPageRanges a
document = IO [PageRange] -> m [PageRange]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [PageRange] -> m [PageRange])
-> IO [PageRange] -> m [PageRange]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr Int32
nRanges <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr PageRange
result <- Ptr Document -> Ptr Int32 -> IO (Ptr PageRange)
poppler_document_get_print_page_ranges Ptr Document
document' Ptr Int32
nRanges
    Int32
nRanges' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
nRanges
    Text -> Ptr PageRange -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentGetPrintPageRanges" Ptr PageRange
result
    [Ptr PageRange]
result' <- (Int -> Int32 -> Ptr PageRange -> IO [Ptr PageRange]
forall a b. Integral a => Int -> a -> Ptr b -> IO [Ptr b]
unpackBlockArrayWithLength Int
8 Int32
nRanges') Ptr PageRange
result
    [PageRange]
result'' <- (Ptr PageRange -> IO PageRange)
-> [Ptr PageRange] -> IO [PageRange]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr PageRange -> PageRange)
-> Ptr PageRange -> IO PageRange
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr PageRange -> PageRange
Poppler.PageRange.PageRange) [Ptr PageRange]
result'
    Ptr PageRange -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr PageRange
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
nRanges
    [PageRange] -> IO [PageRange]
forall (m :: * -> *) a. Monad m => a -> m a
return [PageRange]
result''

#if defined(ENABLE_OVERLOADING)
data DocumentGetPrintPageRangesMethodInfo
instance (signature ~ (m [Poppler.PageRange.PageRange]), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPrintPageRangesMethodInfo a signature where
    overloadedMethod = documentGetPrintPageRanges

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


#endif

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

foreign import ccall "poppler_document_get_print_scaling" poppler_document_get_print_scaling :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CUInt

-- | Returns the print scaling value suggested by author of the document.
-- 
-- /Since: 0.73/
documentGetPrintScaling ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m Poppler.Enums.PrintScaling
    -- ^ __Returns:__ a t'GI.Poppler.Enums.PrintScaling' that should be used when document is printed
documentGetPrintScaling :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m PrintScaling
documentGetPrintScaling a
document = IO PrintScaling -> m PrintScaling
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PrintScaling -> m PrintScaling)
-> IO PrintScaling -> m PrintScaling
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    CUInt
result <- Ptr Document -> IO CUInt
poppler_document_get_print_scaling Ptr Document
document'
    let result' :: PrintScaling
result' = (Int -> PrintScaling
forall a. Enum a => Int -> a
toEnum (Int -> PrintScaling) -> (CUInt -> Int) -> CUInt -> PrintScaling
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    PrintScaling -> IO PrintScaling
forall (m :: * -> *) a. Monad m => a -> m a
return PrintScaling
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetPrintScalingMethodInfo
instance (signature ~ (m Poppler.Enums.PrintScaling), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetPrintScalingMethodInfo a signature where
    overloadedMethod = documentGetPrintScaling

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


#endif

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

foreign import ccall "poppler_document_get_producer" poppler_document_get_producer :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CString

-- | Returns the producer of the document. If the document was converted
-- from another format, the producer is the name of the product
-- that converted it to PDF
-- 
-- /Since: 0.16/
documentGetProducer ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string containing the producer
    --               of /@document@/, or 'P.Nothing'
documentGetProducer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Text
documentGetProducer a
document = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
result <- Ptr Document -> IO (Ptr CChar)
poppler_document_get_producer Ptr Document
document'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentGetProducer" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetProducerMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetProducerMethodInfo a signature where
    overloadedMethod = documentGetProducer

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


#endif

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

foreign import ccall "poppler_document_get_subject" poppler_document_get_subject :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CString

-- | Returns the subject of the document
-- 
-- /Since: 0.16/
documentGetSubject ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string containing the subject
    --               of /@document@/, or 'P.Nothing'
documentGetSubject :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Text
documentGetSubject a
document = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
result <- Ptr Document -> IO (Ptr CChar)
poppler_document_get_subject Ptr Document
document'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentGetSubject" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetSubjectMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetSubjectMethodInfo a signature where
    overloadedMethod = documentGetSubject

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


#endif

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

foreign import ccall "poppler_document_get_title" poppler_document_get_title :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CString

-- | Returns the document\'s title
-- 
-- /Since: 0.16/
documentGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string containing the title
    --               of /@document@/, or 'P.Nothing'
documentGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Text
documentGetTitle a
document = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
result <- Ptr Document -> IO (Ptr CChar)
poppler_document_get_title Ptr Document
document'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"documentGetTitle" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DocumentGetTitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentGetTitleMethodInfo a signature where
    overloadedMethod = documentGetTitle

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


#endif

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

foreign import ccall "poppler_document_has_attachments" poppler_document_has_attachments :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CInt

-- | Returns 'P.True' of /@document@/ has any attachments.
documentHasAttachments ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m Bool
    -- ^ __Returns:__ 'P.True', if /@document@/ has attachments.
documentHasAttachments :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Bool
documentHasAttachments a
document = IO Bool -> m Bool
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 Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    CInt
result <- Ptr Document -> IO CInt
poppler_document_has_attachments Ptr Document
document'
    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
document
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DocumentHasAttachmentsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentHasAttachmentsMethodInfo a signature where
    overloadedMethod = documentHasAttachments

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


#endif

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

foreign import ccall "poppler_document_has_javascript" poppler_document_has_javascript :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CInt

-- | Returns whether /@document@/ has any javascript in it.
-- 
-- /Since: 0.90/
documentHasJavascript ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m Bool
documentHasJavascript :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Bool
documentHasJavascript a
document = IO Bool -> m Bool
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 Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    CInt
result <- Ptr Document -> IO CInt
poppler_document_has_javascript Ptr Document
document'
    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
document
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DocumentHasJavascriptMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentHasJavascriptMethodInfo a signature where
    overloadedMethod = documentHasJavascript

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


#endif

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

foreign import ccall "poppler_document_is_linearized" poppler_document_is_linearized :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    IO CInt

-- | Returns whether /@document@/ is linearized or not. Linearization of PDF
-- enables efficient incremental access of the PDF file in a network environment.
-- 
-- /Since: 0.16/
documentIsLinearized ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@document@/ is linearized, 'P.False' otherwise
documentIsLinearized :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> m Bool
documentIsLinearized a
document = IO Bool -> m Bool
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 Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    CInt
result <- Ptr Document -> IO CInt
poppler_document_is_linearized Ptr Document
document'
    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
document
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DocumentIsLinearizedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentIsLinearizedMethodInfo a signature where
    overloadedMethod = documentIsLinearized

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


#endif

-- method Document::save
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "uri of file to save"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "poppler_document_save" poppler_document_save :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    CString ->                              -- uri : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Saves /@document@/. Any change made in the document such as
-- form fields filled, annotations added or modified
-- will be saved.
-- If /@error@/ is set, 'P.False' will be returned. Possible errors
-- include those in the @/G_FILE_ERROR/@ domain.
documentSave ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: a t'GI.Poppler.Objects.Document.Document'
    -> T.Text
    -- ^ /@uri@/: uri of file to save
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
documentSave :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Text -> m ()
documentSave a
document Text
uri = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
uri' <- Text -> IO (Ptr CChar)
textToCString Text
uri
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Document -> Ptr CChar -> Ptr (Ptr GError) -> IO CInt
poppler_document_save Ptr Document
document' Ptr CChar
uri'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
     )

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

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


#endif

-- method Document::save_a_copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "uri of file to save"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "poppler_document_save_a_copy" poppler_document_save_a_copy :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    CString ->                              -- uri : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Saves a copy of the original /@document@/.
-- Any change made in the document such as
-- form fields filled by the user will not be saved.
-- If /@error@/ is set, 'P.False' will be returned. Possible errors
-- include those in the @/G_FILE_ERROR/@ domain.
documentSaveACopy ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: a t'GI.Poppler.Objects.Document.Document'
    -> T.Text
    -- ^ /@uri@/: uri of file to save
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
documentSaveACopy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Text -> m ()
documentSaveACopy a
document Text
uri = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
uri' <- Text -> IO (Ptr CChar)
textToCString Text
uri
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Document -> Ptr CChar -> Ptr (Ptr GError) -> IO CInt
poppler_document_save_a_copy Ptr Document
document' Ptr CChar
uri'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
uri'
     )

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

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


#endif

-- method Document::set_author
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "author"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A new author" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_set_author" poppler_document_set_author :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    CString ->                              -- author : TBasicType TUTF8
    IO ()

-- | Sets the document\'s author. If /@author@/ is 'P.Nothing', Author
-- entry is removed from the document\'s Info dictionary.
-- 
-- /Since: 0.46/
documentSetAuthor ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> T.Text
    -- ^ /@author@/: A new author
    -> m ()
documentSetAuthor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Text -> m ()
documentSetAuthor a
document Text
author = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
author' <- Text -> IO (Ptr CChar)
textToCString Text
author
    Ptr Document -> Ptr CChar -> IO ()
poppler_document_set_author Ptr Document
document' Ptr CChar
author'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
author'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Document::set_creation_date
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "creation_date"
--           , argType = TBasicType TLong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A new creation date"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_set_creation_date" poppler_document_set_creation_date :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    CLong ->                                -- creation_date : TBasicType TLong
    IO ()

-- | Sets the document\'s creation date. If /@creationDate@/ is -1, CreationDate
-- entry is removed from the document\'s Info dictionary.
-- 
-- /Since: 0.46/
documentSetCreationDate ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> CLong
    -- ^ /@creationDate@/: A new creation date
    -> m ()
documentSetCreationDate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> CLong -> m ()
documentSetCreationDate a
document CLong
creationDate = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr Document -> CLong -> IO ()
poppler_document_set_creation_date Ptr Document
document' CLong
creationDate
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DocumentSetCreationDateMethodInfo
instance (signature ~ (CLong -> m ()), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentSetCreationDateMethodInfo a signature where
    overloadedMethod = documentSetCreationDate

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


#endif

-- method Document::set_creation_date_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "creation_datetime"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A new creation #GDateTime"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_set_creation_date_time" poppler_document_set_creation_date_time :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    Ptr GLib.DateTime.DateTime ->           -- creation_datetime : TInterface (Name {namespace = "GLib", name = "DateTime"})
    IO ()

-- | Sets the document\'s creation date. If /@creationDatetime@/ is 'P.Nothing',
-- CreationDate entry is removed from the document\'s Info dictionary.
-- 
-- /Since: 20.09.0/
documentSetCreationDateTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> Maybe (GLib.DateTime.DateTime)
    -- ^ /@creationDatetime@/: A new creation t'GI.GLib.Structs.DateTime.DateTime'
    -> m ()
documentSetCreationDateTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Maybe DateTime -> m ()
documentSetCreationDateTime a
document Maybe DateTime
creationDatetime = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr DateTime
maybeCreationDatetime <- case Maybe DateTime
creationDatetime of
        Maybe DateTime
Nothing -> Ptr DateTime -> IO (Ptr DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DateTime
forall a. Ptr a
nullPtr
        Just DateTime
jCreationDatetime -> do
            Ptr DateTime
jCreationDatetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
jCreationDatetime
            Ptr DateTime -> IO (Ptr DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DateTime
jCreationDatetime'
    Ptr Document -> Ptr DateTime -> IO ()
poppler_document_set_creation_date_time Ptr Document
document' Ptr DateTime
maybeCreationDatetime
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Maybe DateTime -> (DateTime -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe DateTime
creationDatetime DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DocumentSetCreationDateTimeMethodInfo
instance (signature ~ (Maybe (GLib.DateTime.DateTime) -> m ()), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentSetCreationDateTimeMethodInfo a signature where
    overloadedMethod = documentSetCreationDateTime

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


#endif

-- method Document::set_creator
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "creator"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A new creator" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_set_creator" poppler_document_set_creator :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    CString ->                              -- creator : TBasicType TUTF8
    IO ()

-- | Sets the document\'s creator. If /@creator@/ is 'P.Nothing', Creator
-- entry is removed from the document\'s Info dictionary.
-- 
-- /Since: 0.46/
documentSetCreator ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> T.Text
    -- ^ /@creator@/: A new creator
    -> m ()
documentSetCreator :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Text -> m ()
documentSetCreator a
document Text
creator = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
creator' <- Text -> IO (Ptr CChar)
textToCString Text
creator
    Ptr Document -> Ptr CChar -> IO ()
poppler_document_set_creator Ptr Document
document' Ptr CChar
creator'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
creator'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Document::set_keywords
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keywords"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "New keywords" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_set_keywords" poppler_document_set_keywords :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    CString ->                              -- keywords : TBasicType TUTF8
    IO ()

-- | Sets the document\'s keywords. If /@keywords@/ is 'P.Nothing',
-- Keywords entry is removed from the document\'s Info dictionary.
-- 
-- /Since: 0.46/
documentSetKeywords ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> T.Text
    -- ^ /@keywords@/: New keywords
    -> m ()
documentSetKeywords :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Text -> m ()
documentSetKeywords a
document Text
keywords = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
keywords' <- Text -> IO (Ptr CChar)
textToCString Text
keywords
    Ptr Document -> Ptr CChar -> IO ()
poppler_document_set_keywords Ptr Document
document' Ptr CChar
keywords'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
keywords'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Document::set_modification_date
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modification_date"
--           , argType = TBasicType TLong
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A new modification date"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_set_modification_date" poppler_document_set_modification_date :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    CLong ->                                -- modification_date : TBasicType TLong
    IO ()

-- | Sets the document\'s modification date. If /@modificationDate@/ is -1, ModDate
-- entry is removed from the document\'s Info dictionary.
-- 
-- /Since: 0.46/
documentSetModificationDate ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> CLong
    -- ^ /@modificationDate@/: A new modification date
    -> m ()
documentSetModificationDate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> CLong -> m ()
documentSetModificationDate a
document CLong
modificationDate = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr Document -> CLong -> IO ()
poppler_document_set_modification_date Ptr Document
document' CLong
modificationDate
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DocumentSetModificationDateMethodInfo
instance (signature ~ (CLong -> m ()), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentSetModificationDateMethodInfo a signature where
    overloadedMethod = documentSetModificationDate

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


#endif

-- method Document::set_modification_date_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modification_datetime"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A new modification #GDateTime"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_set_modification_date_time" poppler_document_set_modification_date_time :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    Ptr GLib.DateTime.DateTime ->           -- modification_datetime : TInterface (Name {namespace = "GLib", name = "DateTime"})
    IO ()

-- | Sets the document\'s modification date. If /@modificationDatetime@/ is 'P.Nothing',
-- ModDate entry is removed from the document\'s Info dictionary.
-- 
-- /Since: 20.09.0/
documentSetModificationDateTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> Maybe (GLib.DateTime.DateTime)
    -- ^ /@modificationDatetime@/: A new modification t'GI.GLib.Structs.DateTime.DateTime'
    -> m ()
documentSetModificationDateTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Maybe DateTime -> m ()
documentSetModificationDateTime a
document Maybe DateTime
modificationDatetime = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr DateTime
maybeModificationDatetime <- case Maybe DateTime
modificationDatetime of
        Maybe DateTime
Nothing -> Ptr DateTime -> IO (Ptr DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DateTime
forall a. Ptr a
nullPtr
        Just DateTime
jModificationDatetime -> do
            Ptr DateTime
jModificationDatetime' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
jModificationDatetime
            Ptr DateTime -> IO (Ptr DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DateTime
jModificationDatetime'
    Ptr Document -> Ptr DateTime -> IO ()
poppler_document_set_modification_date_time Ptr Document
document' Ptr DateTime
maybeModificationDatetime
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Maybe DateTime -> (DateTime -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe DateTime
modificationDatetime DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DocumentSetModificationDateTimeMethodInfo
instance (signature ~ (Maybe (GLib.DateTime.DateTime) -> m ()), MonadIO m, IsDocument a) => O.OverloadedMethod DocumentSetModificationDateTimeMethodInfo a signature where
    overloadedMethod = documentSetModificationDateTime

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


#endif

-- method Document::set_producer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "producer"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A new producer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_set_producer" poppler_document_set_producer :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    CString ->                              -- producer : TBasicType TUTF8
    IO ()

-- | Sets the document\'s producer. If /@producer@/ is 'P.Nothing',
-- Producer entry is removed from the document\'s Info dictionary.
-- 
-- /Since: 0.46/
documentSetProducer ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> T.Text
    -- ^ /@producer@/: A new producer
    -> m ()
documentSetProducer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Text -> m ()
documentSetProducer a
document Text
producer = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
producer' <- Text -> IO (Ptr CChar)
textToCString Text
producer
    Ptr Document -> Ptr CChar -> IO ()
poppler_document_set_producer Ptr Document
document' Ptr CChar
producer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
producer'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Document::set_subject
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "subject"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A new subject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_set_subject" poppler_document_set_subject :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    CString ->                              -- subject : TBasicType TUTF8
    IO ()

-- | Sets the document\'s subject. If /@subject@/ is 'P.Nothing', Subject
-- entry is removed from the document\'s Info dictionary.
-- 
-- /Since: 0.46/
documentSetSubject ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> T.Text
    -- ^ /@subject@/: A new subject
    -> m ()
documentSetSubject :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Text -> m ()
documentSetSubject a
document Text
subject = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
subject' <- Text -> IO (Ptr CChar)
textToCString Text
subject
    Ptr Document -> Ptr CChar -> IO ()
poppler_document_set_subject Ptr Document
document' Ptr CChar
subject'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
subject'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Document::set_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "document"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Document" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #PopplerDocument" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A new title" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_document_set_title" poppler_document_set_title :: 
    Ptr Document ->                         -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    CString ->                              -- title : TBasicType TUTF8
    IO ()

-- | Sets the document\'s title. If /@title@/ is 'P.Nothing', Title entry
-- is removed from the document\'s Info dictionary.
-- 
-- /Since: 0.46/
documentSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> T.Text
    -- ^ /@title@/: A new title
    -> m ()
documentSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Text -> m ()
documentSetTitle a
document Text
title = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Document
document' <- a -> IO (Ptr Document)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
document
    Ptr CChar
title' <- Text -> IO (Ptr CChar)
textToCString Text
title
    Ptr Document -> Ptr CChar -> IO ()
poppler_document_set_title Ptr Document
document' Ptr CChar
title'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
title'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif