{-# LANGUAGE TypeApplications #-}


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

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

module GI.Poppler.Objects.PSFile
    ( 

-- * Exported types
    PSFile(..)                              ,
    IsPSFile                                ,
    toPSFile                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [free]("GI.Poppler.Objects.PSFile#g:method:free"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDuplex]("GI.Poppler.Objects.PSFile#g:method:setDuplex"), [setPaperSize]("GI.Poppler.Objects.PSFile#g:method:setPaperSize"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolvePSFileMethod                     ,
#endif

-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    PSFileFreeMethodInfo                    ,
#endif
    pSFileFree                              ,


-- ** new #method:new#

    pSFileNew                               ,


-- ** newFd #method:newFd#

    pSFileNewFd                             ,


-- ** setDuplex #method:setDuplex#

#if defined(ENABLE_OVERLOADING)
    PSFileSetDuplexMethodInfo               ,
#endif
    pSFileSetDuplex                         ,


-- ** setPaperSize #method:setPaperSize#

#if defined(ENABLE_OVERLOADING)
    PSFileSetPaperSizeMethodInfo            ,
#endif
    pSFileSetPaperSize                      ,




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.Region as Cairo.Region
import qualified GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.DateTime as GLib.DateTime
import qualified GI.GLib.Structs.String as GLib.String
import qualified GI.GLib.Structs.Tree as GLib.Tree
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
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 qualified GI.Poppler.Callbacks as Poppler.Callbacks
import {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums
import {-# SOURCE #-} qualified GI.Poppler.Flags as Poppler.Flags
import {-# SOURCE #-} qualified GI.Poppler.Objects.Annot as Poppler.Annot
import {-# SOURCE #-} qualified GI.Poppler.Objects.Attachment as Poppler.Attachment
import {-# SOURCE #-} qualified GI.Poppler.Objects.Document as Poppler.Document
import {-# SOURCE #-} qualified GI.Poppler.Objects.FormField as Poppler.FormField
import {-# SOURCE #-} qualified GI.Poppler.Objects.Layer as Poppler.Layer
import {-# SOURCE #-} qualified GI.Poppler.Objects.Media as Poppler.Media
import {-# SOURCE #-} qualified GI.Poppler.Objects.Movie as Poppler.Movie
import {-# SOURCE #-} qualified GI.Poppler.Objects.Page as Poppler.Page
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionAny as Poppler.ActionAny
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionGotoDest as Poppler.ActionGotoDest
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionGotoRemote as Poppler.ActionGotoRemote
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionJavascript as Poppler.ActionJavascript
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionLaunch as Poppler.ActionLaunch
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionLayer as Poppler.ActionLayer
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionMovie as Poppler.ActionMovie
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionNamed as Poppler.ActionNamed
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionOCGState as Poppler.ActionOCGState
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionRendition as Poppler.ActionRendition
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionResetForm as Poppler.ActionResetForm
import {-# SOURCE #-} qualified GI.Poppler.Structs.ActionUri as Poppler.ActionUri
import {-# SOURCE #-} qualified GI.Poppler.Structs.AnnotMapping as Poppler.AnnotMapping
import {-# SOURCE #-} qualified GI.Poppler.Structs.CertificateInfo as Poppler.CertificateInfo
import {-# SOURCE #-} qualified GI.Poppler.Structs.Color as Poppler.Color
import {-# SOURCE #-} qualified GI.Poppler.Structs.Dest as Poppler.Dest
import {-# SOURCE #-} qualified GI.Poppler.Structs.FormFieldMapping as Poppler.FormFieldMapping
import {-# SOURCE #-} qualified GI.Poppler.Structs.ImageMapping as Poppler.ImageMapping
import {-# SOURCE #-} qualified GI.Poppler.Structs.LinkMapping as Poppler.LinkMapping
import {-# SOURCE #-} qualified GI.Poppler.Structs.PageRange as Poppler.PageRange
import {-# SOURCE #-} qualified GI.Poppler.Structs.PageTransition as Poppler.PageTransition
import {-# SOURCE #-} qualified GI.Poppler.Structs.Rectangle as Poppler.Rectangle
import {-# SOURCE #-} qualified GI.Poppler.Structs.SignatureInfo as Poppler.SignatureInfo
import {-# SOURCE #-} qualified GI.Poppler.Structs.SigningData as Poppler.SigningData
import {-# SOURCE #-} qualified GI.Poppler.Structs.TextAttributes as Poppler.TextAttributes
import {-# SOURCE #-} qualified GI.Poppler.Unions.Action as Poppler.Action

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Poppler.Objects.Document as Poppler.Document

#endif

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

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

foreign import ccall "poppler_ps_file_get_type"
    c_poppler_ps_file_get_type :: IO B.Types.GType

instance B.Types.TypedObject PSFile where
    glibType :: IO GType
glibType = IO GType
c_poppler_ps_file_get_type

instance B.Types.GObject PSFile

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePSFileMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePSFileMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePSFileMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePSFileMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePSFileMethod "free" o = PSFileFreeMethodInfo
    ResolvePSFileMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePSFileMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePSFileMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePSFileMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePSFileMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePSFileMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePSFileMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePSFileMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePSFileMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePSFileMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePSFileMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePSFileMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePSFileMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePSFileMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePSFileMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePSFileMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePSFileMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePSFileMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePSFileMethod "setDuplex" o = PSFileSetDuplexMethodInfo
    ResolvePSFileMethod "setPaperSize" o = PSFileSetPaperSizeMethodInfo
    ResolvePSFileMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePSFileMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method PSFile::new
-- method type : Constructor
-- 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the path of the output filename"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "first_page"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first page to print"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_pages"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of pages to print"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Poppler" , name = "PSFile" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_ps_file_new" poppler_ps_file_new :: 
    Ptr Poppler.Document.Document ->        -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    CString ->                              -- filename : TBasicType TUTF8
    Int32 ->                                -- first_page : TBasicType TInt
    Int32 ->                                -- n_pages : TBasicType TInt
    IO (Ptr PSFile)

-- | Create a new postscript file to render to
pSFileNew ::
    (B.CallStack.HasCallStack, MonadIO m, Poppler.Document.IsDocument a) =>
    a
    -- ^ /@document@/: a t'GI.Poppler.Objects.Document.Document'
    -> T.Text
    -- ^ /@filename@/: the path of the output filename
    -> Int32
    -- ^ /@firstPage@/: the first page to print
    -> Int32
    -- ^ /@nPages@/: the number of pages to print
    -> m PSFile
    -- ^ __Returns:__ a PopplerPSFile
pSFileNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Text -> Int32 -> Int32 -> m PSFile
pSFileNew a
document Text
filename Int32
firstPage Int32
nPages = IO PSFile -> m PSFile
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PSFile -> m PSFile) -> IO PSFile -> m PSFile
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
filename' <- Text -> IO CString
textToCString Text
filename
    Ptr PSFile
result <- Ptr Document -> CString -> Int32 -> Int32 -> IO (Ptr PSFile)
poppler_ps_file_new Ptr Document
document' CString
filename' Int32
firstPage Int32
nPages
    Text -> Ptr PSFile -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pSFileNew" Ptr PSFile
result
    PSFile
result' <- ((ManagedPtr PSFile -> PSFile) -> Ptr PSFile -> IO PSFile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PSFile -> PSFile
PSFile) Ptr PSFile
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    PSFile -> IO PSFile
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PSFile
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method PSFile::new_fd
-- method type : Constructor
-- 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a valid file descriptor open for writing"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "first_page"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first page to print"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_pages"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of pages to print"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Poppler" , name = "PSFile" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_ps_file_new_fd" poppler_ps_file_new_fd :: 
    Ptr Poppler.Document.Document ->        -- document : TInterface (Name {namespace = "Poppler", name = "Document"})
    Int32 ->                                -- fd : TBasicType TInt
    Int32 ->                                -- first_page : TBasicType TInt
    Int32 ->                                -- n_pages : TBasicType TInt
    IO (Ptr PSFile)

-- | Create a new postscript file to render to.
-- Note that this function takes ownership of /@fd@/; you must not operate on it
-- again, nor close it.
-- 
-- /Since: 21.12.0/
pSFileNewFd ::
    (B.CallStack.HasCallStack, MonadIO m, Poppler.Document.IsDocument a) =>
    a
    -- ^ /@document@/: a t'GI.Poppler.Objects.Document.Document'
    -> Int32
    -- ^ /@fd@/: a valid file descriptor open for writing
    -> Int32
    -- ^ /@firstPage@/: the first page to print
    -> Int32
    -- ^ /@nPages@/: the number of pages to print
    -> m PSFile
    -- ^ __Returns:__ a t'GI.Poppler.Objects.PSFile.PSFile'
pSFileNewFd :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDocument a) =>
a -> Int32 -> Int32 -> Int32 -> m PSFile
pSFileNewFd a
document Int32
fd Int32
firstPage Int32
nPages = IO PSFile -> m PSFile
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PSFile -> m PSFile) -> IO PSFile -> m PSFile
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 PSFile
result <- Ptr Document -> Int32 -> Int32 -> Int32 -> IO (Ptr PSFile)
poppler_ps_file_new_fd Ptr Document
document' Int32
fd Int32
firstPage Int32
nPages
    Text -> Ptr PSFile -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pSFileNewFd" Ptr PSFile
result
    PSFile
result' <- ((ManagedPtr PSFile -> PSFile) -> Ptr PSFile -> IO PSFile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PSFile -> PSFile
PSFile) Ptr PSFile
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
document
    PSFile -> IO PSFile
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PSFile
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

-- | Frees /@psFile@/
pSFileFree ::
    (B.CallStack.HasCallStack, MonadIO m, IsPSFile a) =>
    a
    -- ^ /@psFile@/: a PopplerPSFile
    -> m ()
pSFileFree :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPSFile a) =>
a -> m ()
pSFileFree a
psFile = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PSFile
psFile' <- a -> IO (Ptr PSFile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
psFile
    Ptr PSFile -> IO ()
poppler_ps_file_free Ptr PSFile
psFile'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
psFile
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PSFileFreeMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPSFile a) => O.OverloadedMethod PSFileFreeMethodInfo a signature where
    overloadedMethod = pSFileFree

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


#endif

-- method PSFile::set_duplex
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "ps_file"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "PSFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a PopplerPSFile which was not yet printed to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duplex"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether to force duplex printing (on printers which support this)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_ps_file_set_duplex" poppler_ps_file_set_duplex :: 
    Ptr PSFile ->                           -- ps_file : TInterface (Name {namespace = "Poppler", name = "PSFile"})
    CInt ->                                 -- duplex : TBasicType TBoolean
    IO ()

-- | Enable or disable Duplex printing.
pSFileSetDuplex ::
    (B.CallStack.HasCallStack, MonadIO m, IsPSFile a) =>
    a
    -- ^ /@psFile@/: a PopplerPSFile which was not yet printed to
    -> Bool
    -- ^ /@duplex@/: whether to force duplex printing (on printers which support this)
    -> m ()
pSFileSetDuplex :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPSFile a) =>
a -> Bool -> m ()
pSFileSetDuplex a
psFile Bool
duplex = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PSFile
psFile' <- a -> IO (Ptr PSFile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
psFile
    let duplex' :: CInt
duplex' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
duplex
    Ptr PSFile -> CInt -> IO ()
poppler_ps_file_set_duplex Ptr PSFile
psFile' CInt
duplex'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
psFile
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PSFileSetDuplexMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsPSFile a) => O.OverloadedMethod PSFileSetDuplexMethodInfo a signature where
    overloadedMethod = pSFileSetDuplex

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


#endif

-- method PSFile::set_paper_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "ps_file"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "PSFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a PopplerPSFile which was not yet printed to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the paper width in 1/72 inch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the paper height in 1/72 inch"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Set the output paper size. These values will end up in the
-- DocumentMedia, the BoundingBox DSC comments and other places in the
-- generated PostScript.
pSFileSetPaperSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsPSFile a) =>
    a
    -- ^ /@psFile@/: a PopplerPSFile which was not yet printed to.
    -> Double
    -- ^ /@width@/: the paper width in 1\/72 inch
    -> Double
    -- ^ /@height@/: the paper height in 1\/72 inch
    -> m ()
pSFileSetPaperSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPSFile a) =>
a -> Double -> Double -> m ()
pSFileSetPaperSize a
psFile Double
width Double
height = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PSFile
psFile' <- a -> IO (Ptr PSFile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
psFile
    let width' :: CDouble
width' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
width
    let height' :: CDouble
height' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
height
    Ptr PSFile -> CDouble -> CDouble -> IO ()
poppler_ps_file_set_paper_size Ptr PSFile
psFile' CDouble
width' CDouble
height'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
psFile
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PSFileSetPaperSizeMethodInfo
instance (signature ~ (Double -> Double -> m ()), MonadIO m, IsPSFile a) => O.OverloadedMethod PSFileSetPaperSizeMethodInfo a signature where
    overloadedMethod = pSFileSetPaperSize

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


#endif