{-# LANGUAGE TypeApplications #-}


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

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

module GI.Poppler.Objects.Document
    ( 

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


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

#if defined(ENABLE_OVERLOADING)
    ResolveDocumentMethod                   ,
#endif


-- ** 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                 ,


-- ** 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             ,


-- ** 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                  ,


-- ** 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                  ,


-- ** isLinearized #method:isLinearized#

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


-- ** 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                 ,


-- ** 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             ,


-- ** 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                 ,


-- ** 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                      ,


-- ** 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                  ,


-- ** 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import 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

-- | Memory-managed wrapper type.
newtype Document = Document (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)
foreign import ccall "poppler_document_get_type"
    c_poppler_document_get_type :: IO GType

instance GObject Document where
    gobjectType :: IO GType
gobjectType = IO GType
c_poppler_document_get_type
    

-- | Convert 'Document' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Document where
    toGValue :: Document -> IO GValue
toGValue o :: Document
o = do
        GType
gtype <- IO GType
c_poppler_document_get_type
        Document -> (Ptr Document -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Document
o (GType
-> (GValue -> Ptr Document -> IO ()) -> Ptr Document -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Document -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Document
fromGValue gv :: GValue
gv = do
        Ptr Document
ptr <- GValue -> IO (Ptr Document)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Document)
        (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
        
    

-- | Type class for types which can be safely cast to `Document`, for instance with `toDocument`.
class (GObject o, O.IsDescendantOf Document o) => IsDocument o
instance (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 :: (MonadIO m, IsDocument o) => o -> m Document
toDocument :: o -> m Document
toDocument = IO Document -> m Document
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Document -> Document
Document

-- | A convenience alias for `Nothing` :: `Maybe` `Document`.
noDocument :: Maybe Document
noDocument :: Maybe Document
noDocument = Maybe Document
forall a. Maybe a
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 "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 "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 "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 "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 "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 "setCreator" o = DocumentSetCreatorMethodInfo
    ResolveDocumentMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDocumentMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDocumentMethod "setKeywords" o = DocumentSetKeywordsMethodInfo
    ResolveDocumentMethod "setModificationDate" o = DocumentSetModificationDateMethodInfo
    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.MethodInfo 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

#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 :: o -> m (Maybe Text)
getDocumentAuthor obj :: o
obj = 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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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 :: o -> Text -> m ()
setDocumentAuthor obj :: o
obj val :: Text
val = 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "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) => T.Text -> IO (GValueConstruct o)
constructDocumentAuthor :: Text -> IO (GValueConstruct o)
constructDocumentAuthor val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "author" (Text -> Maybe Text
forall a. a -> Maybe a
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
#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 :: o -> m Int32
getDocumentCreationDate obj :: o
obj = 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
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj "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 :: o -> Int32 -> m ()
setDocumentCreationDate obj :: o
obj val :: Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj "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) => Int32 -> IO (GValueConstruct o)
constructDocumentCreationDate :: Int32 -> IO (GValueConstruct o)
constructDocumentCreationDate val :: Int32
val = String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 "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
#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 :: o -> m (Maybe Text)
getDocumentCreator obj :: o
obj = 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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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 :: o -> Text -> m ()
setDocumentCreator obj :: o
obj val :: Text
val = 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "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) => T.Text -> IO (GValueConstruct o)
constructDocumentCreator :: Text -> IO (GValueConstruct o)
constructDocumentCreator val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "creator" (Text -> Maybe Text
forall a. a -> Maybe a
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
#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 :: o -> m (Maybe Text)
getDocumentFormat obj :: o
obj = 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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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
#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 :: o -> m Word32
getDocumentFormatMajor obj :: o
obj = 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
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj "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
#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 :: o -> m Word32
getDocumentFormatMinor obj :: o
obj = 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
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj "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
#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 :: o -> m (Maybe Text)
getDocumentKeywords obj :: o
obj = 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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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 :: o -> Text -> m ()
setDocumentKeywords obj :: o
obj val :: Text
val = 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "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) => T.Text -> IO (GValueConstruct o)
constructDocumentKeywords :: Text -> IO (GValueConstruct o)
constructDocumentKeywords val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "keywords" (Text -> Maybe Text
forall a. a -> Maybe a
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
#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 :: o -> m Bool
getDocumentLinearized obj :: o
obj = 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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "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
#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 :: o -> m (Maybe Text)
getDocumentMetadata obj :: o
obj = 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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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
#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 :: o -> m Int32
getDocumentModDate obj :: o
obj = 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
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj "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 :: o -> Int32 -> m ()
setDocumentModDate obj :: o
obj val :: Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj "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) => Int32 -> IO (GValueConstruct o)
constructDocumentModDate :: Int32 -> IO (GValueConstruct o)
constructDocumentModDate val :: Int32
val = String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 "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
#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 :: o -> m PageLayout
getDocumentPageLayout obj :: o
obj = 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
$ o -> String -> IO PageLayout
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "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
#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 :: o -> m PageMode
getDocumentPageMode obj :: o
obj = 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
$ o -> String -> IO PageMode
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "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
#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 :: o -> m [Permissions]
getDocumentPermissions obj :: o
obj = 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
$ o -> String -> IO [Permissions]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj "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
#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 :: o -> m PrintScaling
getDocumentPrintScaling obj :: o
obj = 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
$ o -> String -> IO PrintScaling
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "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
#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 :: o -> m (Maybe Text)
getDocumentProducer obj :: o
obj = 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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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 :: o -> Text -> m ()
setDocumentProducer obj :: o
obj val :: Text
val = 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "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) => T.Text -> IO (GValueConstruct o)
constructDocumentProducer :: Text -> IO (GValueConstruct o)
constructDocumentProducer val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "producer" (Text -> Maybe Text
forall a. a -> Maybe a
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
#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 :: o -> m (Maybe Text)
getDocumentSubject obj :: o
obj = 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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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 :: o -> Text -> m ()
setDocumentSubject obj :: o
obj val :: Text
val = 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "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) => T.Text -> IO (GValueConstruct o)
constructDocumentSubject :: Text -> IO (GValueConstruct o)
constructDocumentSubject val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "subject" (Text -> Maybe Text
forall a. a -> Maybe a
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
#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 :: o -> m PDFSubtype
getDocumentSubtype obj :: o
obj = 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
$ o -> String -> IO PDFSubtype
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "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
#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 :: o -> m PDFConformance
getDocumentSubtypeConformance obj :: o
obj = 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
$ o -> String -> IO PDFConformance
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "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
#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 :: o -> m PDFPart
getDocumentSubtypePart obj :: o
obj = 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
$ o -> String -> IO PDFPart
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "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
#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 :: o -> m (Maybe Text)
getDocumentSubtypeString obj :: o
obj = 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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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
#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 :: o -> m (Maybe Text)
getDocumentTitle obj :: o
obj = 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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "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 :: o -> Text -> m ()
setDocumentTitle obj :: o
obj val :: Text
val = 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj "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) => T.Text -> IO (GValueConstruct o)
constructDocumentTitle :: Text -> IO (GValueConstruct o)
constructDocumentTitle val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "title" (Text -> Maybe Text
forall a. a -> Maybe a
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
#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 :: o -> m [ViewerPreferences]
getDocumentViewerPreferences obj :: o
obj = IO [ViewerPreferences] -> m [ViewerPreferences]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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 "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
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Document
type instance O.AttributeList Document = DocumentAttributeList
type DocumentAttributeList = ('[ '("author", DocumentAuthorPropertyInfo), '("creationDate", DocumentCreationDatePropertyInfo), '("creator", DocumentCreatorPropertyInfo), '("format", DocumentFormatPropertyInfo), '("formatMajor", DocumentFormatMajorPropertyInfo), '("formatMinor", DocumentFormatMinorPropertyInfo), '("keywords", DocumentKeywordsPropertyInfo), '("linearized", DocumentLinearizedPropertyInfo), '("metadata", DocumentMetadataPropertyInfo), '("modDate", DocumentModDatePropertyInfo), '("pageLayout", DocumentPageLayoutPropertyInfo), '("pageMode", DocumentPageModePropertyInfo), '("permissions", DocumentPermissionsPropertyInfo), '("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

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

documentPageLayout :: AttrLabelProxy "pageLayout"
documentPageLayout = AttrLabelProxy

documentPageMode :: AttrLabelProxy "pageMode"
documentPageMode = AttrLabelProxy

documentPermissions :: AttrLabelProxy "permissions"
documentPermissions = 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_data
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "data"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the pdf data contained in a char array"
--                 , 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: []
-- 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 :: 
    CString ->                              -- data : TBasicType TUTF8
    Int32 ->                                -- length : TBasicType TInt
    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.
documentNewFromData ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@data@/: the pdf data contained in a char array
    -> Int32
    -- ^ /@length@/: the length of @/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 :: Text -> Int32 -> Maybe Text -> m Document
documentNewFromData data_ :: Text
data_ length_ :: Int32
length_ password :: 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
    CString
data_' <- Text -> IO CString
textToCString Text
data_
    CString
maybePassword <- case Maybe Text
password of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jPassword :: Text
jPassword -> do
            CString
jPassword' <- Text -> IO CString
textToCString Text
jPassword
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
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
$ CString
-> Int32 -> CString -> Ptr (Ptr GError) -> IO (Ptr Document)
poppler_document_new_from_data CString
data_' Int32
length_ CString
maybePassword
        Text -> Ptr Document -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "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
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
data_'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePassword
        Document -> IO Document
forall (m :: * -> *) a. Monad m => a -> m a
return Document
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
data_'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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 :: Text -> Maybe Text -> m Document
documentNewFromFile uri :: Text
uri password :: 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
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    CString
maybePassword <- case Maybe Text
password of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jPassword :: Text
jPassword -> do
            CString
jPassword' <- Text -> IO CString
textToCString Text
jPassword
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
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
$ CString -> CString -> Ptr (Ptr GError) -> IO (Ptr Document)
poppler_document_new_from_file CString
uri' CString
maybePassword
        Text -> Ptr Document -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "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
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePassword
        Document -> IO Document
forall (m :: * -> *) a. Monad m => a -> m a
return Document
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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 :: a -> Maybe Text -> Maybe b -> m Document
documentNewFromGfile file :: a
file password :: Maybe Text
password cancellable :: 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
    CString
maybePassword <- case Maybe Text
password of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jPassword :: Text
jPassword -> do
            CString
jPassword' <- Text -> IO CString
textToCString Text
jPassword
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPassword'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr Document)
poppler_document_new_from_gfile Ptr File
file' CString
maybePassword Ptr Cancellable
maybeCancellable
        Text -> Ptr Document -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "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
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePassword
        Document -> IO Document
forall (m :: * -> *) a. Monad m => a -> m a
return Document
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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/@ and @/G_FILE_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 :: a -> Int64 -> Maybe Text -> Maybe b -> m Document
documentNewFromStream stream :: a
stream length_ :: Int64
length_ password :: Maybe Text
password cancellable :: 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
    CString
maybePassword <- case Maybe Text
password of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jPassword :: Text
jPassword -> do
            CString
jPassword' <- Text -> IO CString
textToCString Text
jPassword
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPassword'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr Document)
poppler_document_new_from_stream Ptr InputStream
stream' Int64
length_ CString
maybePassword Ptr Cancellable
maybeCancellable
        Text -> Ptr Document -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "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
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePassword
        Document -> IO Document
forall (m :: * -> *) a. Monad m => a -> m a
return Document
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePassword
     )

#if defined(ENABLE_OVERLOADING)
#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 :: a -> Text -> m Dest
documentFindDest document :: a
document linkName :: 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
    CString
linkName' <- Text -> IO CString
textToCString Text
linkName
    Ptr Dest
result <- Ptr Document -> CString -> IO (Ptr Dest)
poppler_document_find_dest Ptr Document
document' CString
linkName'
    Text -> Ptr Dest -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "documentFindDest" Ptr Dest
result
    Dest
result' <- ((ManagedPtr Dest -> Dest) -> Ptr Dest -> IO Dest
forall a.
(HasCallStack, BoxedObject 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
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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.MethodInfo DocumentFindDestMethodInfo a signature where
    overloadedMethod = 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 :: a -> m [Attachment]
documentGetAttachments document :: 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.MethodInfo DocumentGetAttachmentsMethodInfo a signature where
    overloadedMethod = 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 :: a -> m Text
documentGetAuthor document :: 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
    CString
result <- Ptr Document -> IO CString
poppler_document_get_author Ptr Document
document'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "documentGetAuthor" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
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.MethodInfo DocumentGetAuthorMethodInfo a signature where
    overloadedMethod = 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 :: a -> m CLong
documentGetCreationDate document :: 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.MethodInfo DocumentGetCreationDateMethodInfo a signature where
    overloadedMethod = documentGetCreationDate

#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 :: a -> m Text
documentGetCreator document :: 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
    CString
result <- Ptr Document -> IO CString
poppler_document_get_creator Ptr Document
document'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "documentGetCreator" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
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.MethodInfo DocumentGetCreatorMethodInfo a signature where
    overloadedMethod = 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 :: a -> Int32 -> m FormField
documentGetFormField document :: a
document id :: 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 "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.MethodInfo DocumentGetFormFieldMethodInfo a signature where
    overloadedMethod = 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 :: a -> m (Bool, Text, Text)
documentGetId document :: 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 CString
permanentId <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    Ptr CString
updateId <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    CInt
result <- Ptr Document -> Ptr CString -> Ptr CString -> IO CInt
poppler_document_get_id Ptr Document
document' Ptr CString
permanentId Ptr CString
updateId
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    CString
permanentId' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
permanentId
    Text
permanentId'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
permanentId'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
permanentId'
    CString
updateId' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
updateId
    Text
updateId'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
updateId'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
updateId'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
permanentId
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
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.MethodInfo DocumentGetIdMethodInfo a signature where
    overloadedMethod = 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 :: a -> m Text
documentGetKeywords document :: 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
    CString
result <- Ptr Document -> IO CString
poppler_document_get_keywords Ptr Document
document'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "documentGetKeywords" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
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.MethodInfo DocumentGetKeywordsMethodInfo a signature where
    overloadedMethod = 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 :: a -> m Text
documentGetMetadata document :: 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
    CString
result <- Ptr Document -> IO CString
poppler_document_get_metadata Ptr Document
document'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "documentGetMetadata" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
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.MethodInfo DocumentGetMetadataMethodInfo a signature where
    overloadedMethod = 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 :: a -> m CLong
documentGetModificationDate document :: 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.MethodInfo DocumentGetModificationDateMethodInfo a signature where
    overloadedMethod = documentGetModificationDate

#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 :: a -> m Word32
documentGetNAttachments document :: 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.MethodInfo DocumentGetNAttachmentsMethodInfo a signature where
    overloadedMethod = 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 :: a -> m Int32
documentGetNPages document :: 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.MethodInfo DocumentGetNPagesMethodInfo a signature where
    overloadedMethod = 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 :: a -> Int32 -> m Page
documentGetPage document :: a
document index :: 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 "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.MethodInfo DocumentGetPageMethodInfo a signature where
    overloadedMethod = 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 :: a -> Text -> m Page
documentGetPageByLabel document :: a
document label :: 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
    CString
label' <- Text -> IO CString
textToCString Text
label
    Ptr Page
result <- Ptr Document -> CString -> IO (Ptr Page)
poppler_document_get_page_by_label Ptr Document
document' CString
label'
    Text -> Ptr Page -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "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
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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.MethodInfo DocumentGetPageByLabelMethodInfo a signature where
    overloadedMethod = 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 :: a -> m PageLayout
documentGetPageLayout document :: 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.MethodInfo DocumentGetPageLayoutMethodInfo a signature where
    overloadedMethod = 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 :: a -> m PageMode
documentGetPageMode document :: 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.MethodInfo DocumentGetPageModeMethodInfo a signature where
    overloadedMethod = 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 :: a -> m PDFConformance
documentGetPdfConformance document :: 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.MethodInfo DocumentGetPdfConformanceMethodInfo a signature where
    overloadedMethod = 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 :: a -> m PDFPart
documentGetPdfPart document :: 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.MethodInfo DocumentGetPdfPartMethodInfo a signature where
    overloadedMethod = 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 :: a -> m PDFSubtype
documentGetPdfSubtype document :: 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.MethodInfo DocumentGetPdfSubtypeMethodInfo a signature where
    overloadedMethod = 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 :: a -> m (Maybe Text)
documentGetPdfSubtypeString document :: 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
    CString
result <- Ptr Document -> IO CString
poppler_document_get_pdf_subtype_string Ptr Document
document'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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.MethodInfo DocumentGetPdfSubtypeStringMethodInfo a signature where
    overloadedMethod = 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 = False
--           , 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 = False
--           , 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 ()

-- | /No description available in the introspection data./
-- 
-- /Since: 0.16/
documentGetPdfVersion ::
    (B.CallStack.HasCallStack, MonadIO m, IsDocument a) =>
    a
    -- ^ /@document@/: A t'GI.Poppler.Objects.Document.Document'
    -> m ((Word32, Word32))
documentGetPdfVersion :: a -> m (Word32, Word32)
documentGetPdfVersion document :: 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.MethodInfo DocumentGetPdfVersionMethodInfo a signature where
    overloadedMethod = 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 :: a -> m Text
documentGetPdfVersionString document :: 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
    CString
result <- Ptr Document -> IO CString
poppler_document_get_pdf_version_string Ptr Document
document'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "documentGetPdfVersionString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
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.MethodInfo DocumentGetPdfVersionStringMethodInfo a signature where
    overloadedMethod = 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 :: a -> m [Permissions]
documentGetPermissions document :: 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.MethodInfo DocumentGetPermissionsMethodInfo a signature where
    overloadedMethod = documentGetPermissions

#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 :: a -> m PrintScaling
documentGetPrintScaling document :: 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.MethodInfo DocumentGetPrintScalingMethodInfo a signature where
    overloadedMethod = 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 :: a -> m Text
documentGetProducer document :: 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
    CString
result <- Ptr Document -> IO CString
poppler_document_get_producer Ptr Document
document'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "documentGetProducer" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
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.MethodInfo DocumentGetProducerMethodInfo a signature where
    overloadedMethod = 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 :: a -> m Text
documentGetSubject document :: 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
    CString
result <- Ptr Document -> IO CString
poppler_document_get_subject Ptr Document
document'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "documentGetSubject" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
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.MethodInfo DocumentGetSubjectMethodInfo a signature where
    overloadedMethod = 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 :: a -> m Text
documentGetTitle document :: 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
    CString
result <- Ptr Document -> IO CString
poppler_document_get_title Ptr Document
document'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "documentGetTitle" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
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.MethodInfo DocumentGetTitleMethodInfo a signature where
    overloadedMethod = 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 :: a -> m Bool
documentHasAttachments document :: 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
/= 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.MethodInfo DocumentHasAttachmentsMethodInfo a signature where
    overloadedMethod = documentHasAttachments

#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 :: a -> m Bool
documentIsLinearized document :: 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
/= 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.MethodInfo DocumentIsLinearizedMethodInfo a signature where
    overloadedMethod = 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 :: a -> Text -> m ()
documentSave document :: a
document uri :: 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
    CString
uri' <- Text -> IO CString
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 -> CString -> Ptr (Ptr GError) -> IO CInt
poppler_document_save Ptr Document
document' CString
uri'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
     )

#if defined(ENABLE_OVERLOADING)
data DocumentSaveMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsDocument a) => O.MethodInfo DocumentSaveMethodInfo a signature where
    overloadedMethod = 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 :: a -> Text -> m ()
documentSaveACopy document :: a
document uri :: 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
    CString
uri' <- Text -> IO CString
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 -> CString -> Ptr (Ptr GError) -> IO CInt
poppler_document_save_a_copy Ptr Document
document' CString
uri'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
     )

#if defined(ENABLE_OVERLOADING)
data DocumentSaveACopyMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsDocument a) => O.MethodInfo DocumentSaveACopyMethodInfo a signature where
    overloadedMethod = 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 :: a -> Text -> m ()
documentSetAuthor document :: a
document author :: 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
    CString
author' <- Text -> IO CString
textToCString Text
author
    Ptr Document -> CString -> IO ()
poppler_document_set_author Ptr Document
document' CString
author'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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.MethodInfo DocumentSetAuthorMethodInfo a signature where
    overloadedMethod = 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 :: a -> CLong -> m ()
documentSetCreationDate document :: a
document creationDate :: 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.MethodInfo DocumentSetCreationDateMethodInfo a signature where
    overloadedMethod = documentSetCreationDate

#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 :: a -> Text -> m ()
documentSetCreator document :: a
document creator :: 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
    CString
creator' <- Text -> IO CString
textToCString Text
creator
    Ptr Document -> CString -> IO ()
poppler_document_set_creator Ptr Document
document' CString
creator'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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.MethodInfo DocumentSetCreatorMethodInfo a signature where
    overloadedMethod = 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 :: a -> Text -> m ()
documentSetKeywords document :: a
document keywords :: 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
    CString
keywords' <- Text -> IO CString
textToCString Text
keywords
    Ptr Document -> CString -> IO ()
poppler_document_set_keywords Ptr Document
document' CString
keywords'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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.MethodInfo DocumentSetKeywordsMethodInfo a signature where
    overloadedMethod = 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 :: a -> CLong -> m ()
documentSetModificationDate document :: a
document modificationDate :: 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.MethodInfo DocumentSetModificationDateMethodInfo a signature where
    overloadedMethod = documentSetModificationDate

#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 :: a -> Text -> m ()
documentSetProducer document :: a
document producer :: 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
    CString
producer' <- Text -> IO CString
textToCString Text
producer
    Ptr Document -> CString -> IO ()
poppler_document_set_producer Ptr Document
document' CString
producer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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.MethodInfo DocumentSetProducerMethodInfo a signature where
    overloadedMethod = 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 :: a -> Text -> m ()
documentSetSubject document :: a
document subject :: 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
    CString
subject' <- Text -> IO CString
textToCString Text
subject
    Ptr Document -> CString -> IO ()
poppler_document_set_subject Ptr Document
document' CString
subject'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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.MethodInfo DocumentSetSubjectMethodInfo a signature where
    overloadedMethod = 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 :: a -> Text -> m ()
documentSetTitle document :: a
document title :: 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
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr Document -> CString -> IO ()
poppler_document_set_title Ptr Document
document' CString
title'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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.MethodInfo DocumentSetTitleMethodInfo a signature where
    overloadedMethod = documentSetTitle

#endif