{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GtkPrintJob@ object represents a job that is sent to a printer.
-- 
-- You only need to deal directly with print jobs if you use the
-- non-portable t'GI.Gtk.Objects.PrintUnixDialog.PrintUnixDialog' API.
-- 
-- Use 'GI.Gtk.Objects.PrintJob.printJobGetSurface' to obtain the cairo surface
-- onto which the pages must be drawn. Use 'GI.Gtk.Objects.PrintJob.printJobSend'
-- to send the finished job to the printer. If you don’t use cairo
-- @GtkPrintJob@ also supports printing of manually generated PostScript,
-- via 'GI.Gtk.Objects.PrintJob.printJobSetSourceFile'.

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

module GI.Gtk.Objects.PrintJob
    ( 

-- * Exported types
    PrintJob(..)                            ,
    IsPrintJob                              ,
    toPrintJob                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [send]("GI.Gtk.Objects.PrintJob#g:method:send"), [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
-- [getCollate]("GI.Gtk.Objects.PrintJob#g:method:getCollate"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getNUp]("GI.Gtk.Objects.PrintJob#g:method:getNUp"), [getNUpLayout]("GI.Gtk.Objects.PrintJob#g:method:getNUpLayout"), [getNumCopies]("GI.Gtk.Objects.PrintJob#g:method:getNumCopies"), [getPageRanges]("GI.Gtk.Objects.PrintJob#g:method:getPageRanges"), [getPageSet]("GI.Gtk.Objects.PrintJob#g:method:getPageSet"), [getPages]("GI.Gtk.Objects.PrintJob#g:method:getPages"), [getPrinter]("GI.Gtk.Objects.PrintJob#g:method:getPrinter"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getReverse]("GI.Gtk.Objects.PrintJob#g:method:getReverse"), [getRotate]("GI.Gtk.Objects.PrintJob#g:method:getRotate"), [getScale]("GI.Gtk.Objects.PrintJob#g:method:getScale"), [getSettings]("GI.Gtk.Objects.PrintJob#g:method:getSettings"), [getStatus]("GI.Gtk.Objects.PrintJob#g:method:getStatus"), [getSurface]("GI.Gtk.Objects.PrintJob#g:method:getSurface"), [getTitle]("GI.Gtk.Objects.PrintJob#g:method:getTitle"), [getTrackPrintStatus]("GI.Gtk.Objects.PrintJob#g:method:getTrackPrintStatus").
-- 
-- ==== Setters
-- [setCollate]("GI.Gtk.Objects.PrintJob#g:method:setCollate"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setNUp]("GI.Gtk.Objects.PrintJob#g:method:setNUp"), [setNUpLayout]("GI.Gtk.Objects.PrintJob#g:method:setNUpLayout"), [setNumCopies]("GI.Gtk.Objects.PrintJob#g:method:setNumCopies"), [setPageRanges]("GI.Gtk.Objects.PrintJob#g:method:setPageRanges"), [setPageSet]("GI.Gtk.Objects.PrintJob#g:method:setPageSet"), [setPages]("GI.Gtk.Objects.PrintJob#g:method:setPages"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setReverse]("GI.Gtk.Objects.PrintJob#g:method:setReverse"), [setRotate]("GI.Gtk.Objects.PrintJob#g:method:setRotate"), [setScale]("GI.Gtk.Objects.PrintJob#g:method:setScale"), [setSourceFd]("GI.Gtk.Objects.PrintJob#g:method:setSourceFd"), [setSourceFile]("GI.Gtk.Objects.PrintJob#g:method:setSourceFile"), [setTrackPrintStatus]("GI.Gtk.Objects.PrintJob#g:method:setTrackPrintStatus").

#if defined(ENABLE_OVERLOADING)
    ResolvePrintJobMethod                   ,
#endif

-- ** getCollate #method:getCollate#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetCollateMethodInfo            ,
#endif
    printJobGetCollate                      ,


-- ** getNUp #method:getNUp#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetNUpMethodInfo                ,
#endif
    printJobGetNUp                          ,


-- ** getNUpLayout #method:getNUpLayout#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetNUpLayoutMethodInfo          ,
#endif
    printJobGetNUpLayout                    ,


-- ** getNumCopies #method:getNumCopies#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetNumCopiesMethodInfo          ,
#endif
    printJobGetNumCopies                    ,


-- ** getPageRanges #method:getPageRanges#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetPageRangesMethodInfo         ,
#endif
    printJobGetPageRanges                   ,


-- ** getPageSet #method:getPageSet#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetPageSetMethodInfo            ,
#endif
    printJobGetPageSet                      ,


-- ** getPages #method:getPages#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetPagesMethodInfo              ,
#endif
    printJobGetPages                        ,


-- ** getPrinter #method:getPrinter#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetPrinterMethodInfo            ,
#endif
    printJobGetPrinter                      ,


-- ** getReverse #method:getReverse#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetReverseMethodInfo            ,
#endif
    printJobGetReverse                      ,


-- ** getRotate #method:getRotate#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetRotateMethodInfo             ,
#endif
    printJobGetRotate                       ,


-- ** getScale #method:getScale#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetScaleMethodInfo              ,
#endif
    printJobGetScale                        ,


-- ** getSettings #method:getSettings#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetSettingsMethodInfo           ,
#endif
    printJobGetSettings                     ,


-- ** getStatus #method:getStatus#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetStatusMethodInfo             ,
#endif
    printJobGetStatus                       ,


-- ** getSurface #method:getSurface#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetSurfaceMethodInfo            ,
#endif
    printJobGetSurface                      ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetTitleMethodInfo              ,
#endif
    printJobGetTitle                        ,


-- ** getTrackPrintStatus #method:getTrackPrintStatus#

#if defined(ENABLE_OVERLOADING)
    PrintJobGetTrackPrintStatusMethodInfo   ,
#endif
    printJobGetTrackPrintStatus             ,


-- ** new #method:new#

    printJobNew                             ,


-- ** send #method:send#

#if defined(ENABLE_OVERLOADING)
    PrintJobSendMethodInfo                  ,
#endif
    printJobSend                            ,


-- ** setCollate #method:setCollate#

#if defined(ENABLE_OVERLOADING)
    PrintJobSetCollateMethodInfo            ,
#endif
    printJobSetCollate                      ,


-- ** setNUp #method:setNUp#

#if defined(ENABLE_OVERLOADING)
    PrintJobSetNUpMethodInfo                ,
#endif
    printJobSetNUp                          ,


-- ** setNUpLayout #method:setNUpLayout#

#if defined(ENABLE_OVERLOADING)
    PrintJobSetNUpLayoutMethodInfo          ,
#endif
    printJobSetNUpLayout                    ,


-- ** setNumCopies #method:setNumCopies#

#if defined(ENABLE_OVERLOADING)
    PrintJobSetNumCopiesMethodInfo          ,
#endif
    printJobSetNumCopies                    ,


-- ** setPageRanges #method:setPageRanges#

#if defined(ENABLE_OVERLOADING)
    PrintJobSetPageRangesMethodInfo         ,
#endif
    printJobSetPageRanges                   ,


-- ** setPageSet #method:setPageSet#

#if defined(ENABLE_OVERLOADING)
    PrintJobSetPageSetMethodInfo            ,
#endif
    printJobSetPageSet                      ,


-- ** setPages #method:setPages#

#if defined(ENABLE_OVERLOADING)
    PrintJobSetPagesMethodInfo              ,
#endif
    printJobSetPages                        ,


-- ** setReverse #method:setReverse#

#if defined(ENABLE_OVERLOADING)
    PrintJobSetReverseMethodInfo            ,
#endif
    printJobSetReverse                      ,


-- ** setRotate #method:setRotate#

#if defined(ENABLE_OVERLOADING)
    PrintJobSetRotateMethodInfo             ,
#endif
    printJobSetRotate                       ,


-- ** setScale #method:setScale#

#if defined(ENABLE_OVERLOADING)
    PrintJobSetScaleMethodInfo              ,
#endif
    printJobSetScale                        ,


-- ** setSourceFd #method:setSourceFd#

#if defined(ENABLE_OVERLOADING)
    PrintJobSetSourceFdMethodInfo           ,
#endif
    printJobSetSourceFd                     ,


-- ** setSourceFile #method:setSourceFile#

#if defined(ENABLE_OVERLOADING)
    PrintJobSetSourceFileMethodInfo         ,
#endif
    printJobSetSourceFile                   ,


-- ** setTrackPrintStatus #method:setTrackPrintStatus#

#if defined(ENABLE_OVERLOADING)
    PrintJobSetTrackPrintStatusMethodInfo   ,
#endif
    printJobSetTrackPrintStatus             ,




 -- * Properties


-- ** pageSetup #attr:pageSetup#
-- | Page setup.

#if defined(ENABLE_OVERLOADING)
    PrintJobPageSetupPropertyInfo           ,
#endif
    constructPrintJobPageSetup              ,
    getPrintJobPageSetup                    ,
#if defined(ENABLE_OVERLOADING)
    printJobPageSetup                       ,
#endif


-- ** printer #attr:printer#
-- | The printer to send the job to.

#if defined(ENABLE_OVERLOADING)
    PrintJobPrinterPropertyInfo             ,
#endif
    constructPrintJobPrinter                ,
    getPrintJobPrinter                      ,
#if defined(ENABLE_OVERLOADING)
    printJobPrinter                         ,
#endif


-- ** settings #attr:settings#
-- | Printer settings.

#if defined(ENABLE_OVERLOADING)
    PrintJobSettingsPropertyInfo            ,
#endif
    constructPrintJobSettings               ,
    getPrintJobSettings                     ,
#if defined(ENABLE_OVERLOADING)
    printJobSettings                        ,
#endif


-- ** title #attr:title#
-- | The title of the print job.

#if defined(ENABLE_OVERLOADING)
    PrintJobTitlePropertyInfo               ,
#endif
    constructPrintJobTitle                  ,
    getPrintJobTitle                        ,
#if defined(ENABLE_OVERLOADING)
    printJobTitle                           ,
#endif


-- ** trackPrintStatus #attr:trackPrintStatus#
-- | 'P.True' if the print job will continue to emit status-changed
-- signals after the print data has been setn to the printer.

#if defined(ENABLE_OVERLOADING)
    PrintJobTrackPrintStatusPropertyInfo    ,
#endif
    constructPrintJobTrackPrintStatus       ,
    getPrintJobTrackPrintStatus             ,
#if defined(ENABLE_OVERLOADING)
    printJobTrackPrintStatus                ,
#endif
    setPrintJobTrackPrintStatus             ,




 -- * Signals


-- ** statusChanged #signal:statusChanged#

    PrintJobStatusChangedCallback           ,
#if defined(ENABLE_OVERLOADING)
    PrintJobStatusChangedSignalInfo         ,
#endif
    afterPrintJobStatusChanged              ,
    onPrintJobStatusChanged                 ,




    ) 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 GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Objects.PageSetup as Gtk.PageSetup
import {-# SOURCE #-} qualified GI.Gtk.Objects.PrintSettings as Gtk.PrintSettings
import {-# SOURCE #-} qualified GI.Gtk.Objects.Printer as Gtk.Printer
import {-# SOURCE #-} qualified GI.Gtk.Structs.PageRange as Gtk.PageRange

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

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

foreign import ccall "gtk_print_job_get_type"
    c_gtk_print_job_get_type :: IO B.Types.GType

instance B.Types.TypedObject PrintJob where
    glibType :: IO GType
glibType = IO GType
c_gtk_print_job_get_type

instance B.Types.GObject PrintJob

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePrintJobMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePrintJobMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePrintJobMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePrintJobMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePrintJobMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePrintJobMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePrintJobMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePrintJobMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePrintJobMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePrintJobMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePrintJobMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePrintJobMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePrintJobMethod "send" o = PrintJobSendMethodInfo
    ResolvePrintJobMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePrintJobMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePrintJobMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePrintJobMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePrintJobMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePrintJobMethod "getCollate" o = PrintJobGetCollateMethodInfo
    ResolvePrintJobMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePrintJobMethod "getNUp" o = PrintJobGetNUpMethodInfo
    ResolvePrintJobMethod "getNUpLayout" o = PrintJobGetNUpLayoutMethodInfo
    ResolvePrintJobMethod "getNumCopies" o = PrintJobGetNumCopiesMethodInfo
    ResolvePrintJobMethod "getPageRanges" o = PrintJobGetPageRangesMethodInfo
    ResolvePrintJobMethod "getPageSet" o = PrintJobGetPageSetMethodInfo
    ResolvePrintJobMethod "getPages" o = PrintJobGetPagesMethodInfo
    ResolvePrintJobMethod "getPrinter" o = PrintJobGetPrinterMethodInfo
    ResolvePrintJobMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePrintJobMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePrintJobMethod "getReverse" o = PrintJobGetReverseMethodInfo
    ResolvePrintJobMethod "getRotate" o = PrintJobGetRotateMethodInfo
    ResolvePrintJobMethod "getScale" o = PrintJobGetScaleMethodInfo
    ResolvePrintJobMethod "getSettings" o = PrintJobGetSettingsMethodInfo
    ResolvePrintJobMethod "getStatus" o = PrintJobGetStatusMethodInfo
    ResolvePrintJobMethod "getSurface" o = PrintJobGetSurfaceMethodInfo
    ResolvePrintJobMethod "getTitle" o = PrintJobGetTitleMethodInfo
    ResolvePrintJobMethod "getTrackPrintStatus" o = PrintJobGetTrackPrintStatusMethodInfo
    ResolvePrintJobMethod "setCollate" o = PrintJobSetCollateMethodInfo
    ResolvePrintJobMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePrintJobMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePrintJobMethod "setNUp" o = PrintJobSetNUpMethodInfo
    ResolvePrintJobMethod "setNUpLayout" o = PrintJobSetNUpLayoutMethodInfo
    ResolvePrintJobMethod "setNumCopies" o = PrintJobSetNumCopiesMethodInfo
    ResolvePrintJobMethod "setPageRanges" o = PrintJobSetPageRangesMethodInfo
    ResolvePrintJobMethod "setPageSet" o = PrintJobSetPageSetMethodInfo
    ResolvePrintJobMethod "setPages" o = PrintJobSetPagesMethodInfo
    ResolvePrintJobMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePrintJobMethod "setReverse" o = PrintJobSetReverseMethodInfo
    ResolvePrintJobMethod "setRotate" o = PrintJobSetRotateMethodInfo
    ResolvePrintJobMethod "setScale" o = PrintJobSetScaleMethodInfo
    ResolvePrintJobMethod "setSourceFd" o = PrintJobSetSourceFdMethodInfo
    ResolvePrintJobMethod "setSourceFile" o = PrintJobSetSourceFileMethodInfo
    ResolvePrintJobMethod "setTrackPrintStatus" o = PrintJobSetTrackPrintStatusMethodInfo
    ResolvePrintJobMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal PrintJob::status-changed
-- | Emitted when the status of a job changes.
-- 
-- The signal handler can use 'GI.Gtk.Objects.PrintJob.printJobGetStatus'
-- to obtain the new status.
type PrintJobStatusChangedCallback =
    IO ()

type C_PrintJobStatusChangedCallback =
    Ptr PrintJob ->                         -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_PrintJobStatusChangedCallback`.
foreign import ccall "wrapper"
    mk_PrintJobStatusChangedCallback :: C_PrintJobStatusChangedCallback -> IO (FunPtr C_PrintJobStatusChangedCallback)

wrap_PrintJobStatusChangedCallback :: 
    GObject a => (a -> PrintJobStatusChangedCallback) ->
    C_PrintJobStatusChangedCallback
wrap_PrintJobStatusChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PrintJobStatusChangedCallback
wrap_PrintJobStatusChangedCallback a -> IO ()
gi'cb Ptr PrintJob
gi'selfPtr Ptr ()
_ = do
    Ptr PrintJob -> (PrintJob -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr PrintJob
gi'selfPtr ((PrintJob -> IO ()) -> IO ()) -> (PrintJob -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PrintJob
gi'self -> a -> IO ()
gi'cb (PrintJob -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PrintJob
gi'self) 


-- | Connect a signal handler for the [statusChanged](#signal:statusChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' printJob #statusChanged callback
-- @
-- 
-- 
onPrintJobStatusChanged :: (IsPrintJob a, MonadIO m) => a -> ((?self :: a) => PrintJobStatusChangedCallback) -> m SignalHandlerId
onPrintJobStatusChanged :: forall a (m :: * -> *).
(IsPrintJob a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPrintJobStatusChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PrintJobStatusChangedCallback
wrapped' = (a -> IO ()) -> C_PrintJobStatusChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PrintJobStatusChangedCallback
wrap_PrintJobStatusChangedCallback a -> IO ()
wrapped
    FunPtr C_PrintJobStatusChangedCallback
wrapped'' <- C_PrintJobStatusChangedCallback
-> IO (FunPtr C_PrintJobStatusChangedCallback)
mk_PrintJobStatusChangedCallback C_PrintJobStatusChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_PrintJobStatusChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"status-changed" FunPtr C_PrintJobStatusChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [statusChanged](#signal:statusChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' printJob #statusChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPrintJobStatusChanged :: (IsPrintJob a, MonadIO m) => a -> ((?self :: a) => PrintJobStatusChangedCallback) -> m SignalHandlerId
afterPrintJobStatusChanged :: forall a (m :: * -> *).
(IsPrintJob a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPrintJobStatusChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PrintJobStatusChangedCallback
wrapped' = (a -> IO ()) -> C_PrintJobStatusChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PrintJobStatusChangedCallback
wrap_PrintJobStatusChangedCallback a -> IO ()
wrapped
    FunPtr C_PrintJobStatusChangedCallback
wrapped'' <- C_PrintJobStatusChangedCallback
-> IO (FunPtr C_PrintJobStatusChangedCallback)
mk_PrintJobStatusChangedCallback C_PrintJobStatusChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_PrintJobStatusChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"status-changed" FunPtr C_PrintJobStatusChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PrintJobStatusChangedSignalInfo
instance SignalInfo PrintJobStatusChangedSignalInfo where
    type HaskellCallbackType PrintJobStatusChangedSignalInfo = PrintJobStatusChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PrintJobStatusChangedCallback cb
        cb'' <- mk_PrintJobStatusChangedCallback cb'
        connectSignalFunPtr obj "status-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob::status-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#g:signal:statusChanged"})

#endif

-- VVV Prop "page-setup"
   -- Type: TInterface (Name {namespace = "Gtk", name = "PageSetup"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@page-setup@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' printJob #pageSetup
-- @
getPrintJobPageSetup :: (MonadIO m, IsPrintJob o) => o -> m (Maybe Gtk.PageSetup.PageSetup)
getPrintJobPageSetup :: forall (m :: * -> *) o.
(MonadIO m, IsPrintJob o) =>
o -> m (Maybe PageSetup)
getPrintJobPageSetup o
obj = IO (Maybe PageSetup) -> m (Maybe PageSetup)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe PageSetup) -> m (Maybe PageSetup))
-> IO (Maybe PageSetup) -> m (Maybe PageSetup)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr PageSetup -> PageSetup)
-> IO (Maybe PageSetup)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"page-setup" ManagedPtr PageSetup -> PageSetup
Gtk.PageSetup.PageSetup

-- | Construct a `GValueConstruct` with valid value for the “@page-setup@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPrintJobPageSetup :: (IsPrintJob o, MIO.MonadIO m, Gtk.PageSetup.IsPageSetup a) => a -> m (GValueConstruct o)
constructPrintJobPageSetup :: forall o (m :: * -> *) a.
(IsPrintJob o, MonadIO m, IsPageSetup a) =>
a -> m (GValueConstruct o)
constructPrintJobPageSetup a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"page-setup" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data PrintJobPageSetupPropertyInfo
instance AttrInfo PrintJobPageSetupPropertyInfo where
    type AttrAllowedOps PrintJobPageSetupPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PrintJobPageSetupPropertyInfo = IsPrintJob
    type AttrSetTypeConstraint PrintJobPageSetupPropertyInfo = Gtk.PageSetup.IsPageSetup
    type AttrTransferTypeConstraint PrintJobPageSetupPropertyInfo = Gtk.PageSetup.IsPageSetup
    type AttrTransferType PrintJobPageSetupPropertyInfo = Gtk.PageSetup.PageSetup
    type AttrGetType PrintJobPageSetupPropertyInfo = (Maybe Gtk.PageSetup.PageSetup)
    type AttrLabel PrintJobPageSetupPropertyInfo = "page-setup"
    type AttrOrigin PrintJobPageSetupPropertyInfo = PrintJob
    attrGet = getPrintJobPageSetup
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gtk.PageSetup.PageSetup v
    attrConstruct = constructPrintJobPageSetup
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.pageSetup"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#g:attr:pageSetup"
        })
#endif

-- VVV Prop "printer"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Printer"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@printer@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' printJob #printer
-- @
getPrintJobPrinter :: (MonadIO m, IsPrintJob o) => o -> m Gtk.Printer.Printer
getPrintJobPrinter :: forall (m :: * -> *) o. (MonadIO m, IsPrintJob o) => o -> m Printer
getPrintJobPrinter o
obj = IO Printer -> m Printer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Printer -> m Printer) -> IO Printer -> m Printer
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Printer) -> IO Printer
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getPrintJobPrinter" (IO (Maybe Printer) -> IO Printer)
-> IO (Maybe Printer) -> IO Printer
forall a b. (a -> b) -> a -> b
$ o
-> String -> (ManagedPtr Printer -> Printer) -> IO (Maybe Printer)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"printer" ManagedPtr Printer -> Printer
Gtk.Printer.Printer

-- | Construct a `GValueConstruct` with valid value for the “@printer@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPrintJobPrinter :: (IsPrintJob o, MIO.MonadIO m, Gtk.Printer.IsPrinter a) => a -> m (GValueConstruct o)
constructPrintJobPrinter :: forall o (m :: * -> *) a.
(IsPrintJob o, MonadIO m, IsPrinter a) =>
a -> m (GValueConstruct o)
constructPrintJobPrinter a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"printer" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data PrintJobPrinterPropertyInfo
instance AttrInfo PrintJobPrinterPropertyInfo where
    type AttrAllowedOps PrintJobPrinterPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PrintJobPrinterPropertyInfo = IsPrintJob
    type AttrSetTypeConstraint PrintJobPrinterPropertyInfo = Gtk.Printer.IsPrinter
    type AttrTransferTypeConstraint PrintJobPrinterPropertyInfo = Gtk.Printer.IsPrinter
    type AttrTransferType PrintJobPrinterPropertyInfo = Gtk.Printer.Printer
    type AttrGetType PrintJobPrinterPropertyInfo = Gtk.Printer.Printer
    type AttrLabel PrintJobPrinterPropertyInfo = "printer"
    type AttrOrigin PrintJobPrinterPropertyInfo = PrintJob
    attrGet = getPrintJobPrinter
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gtk.Printer.Printer v
    attrConstruct = constructPrintJobPrinter
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#g:attr:printer"
        })
#endif

-- VVV Prop "settings"
   -- Type: TInterface (Name {namespace = "Gtk", name = "PrintSettings"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@settings@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' printJob #settings
-- @
getPrintJobSettings :: (MonadIO m, IsPrintJob o) => o -> m Gtk.PrintSettings.PrintSettings
getPrintJobSettings :: forall (m :: * -> *) o.
(MonadIO m, IsPrintJob o) =>
o -> m PrintSettings
getPrintJobSettings o
obj = IO PrintSettings -> m PrintSettings
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO PrintSettings -> m PrintSettings)
-> IO PrintSettings -> m PrintSettings
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe PrintSettings) -> IO PrintSettings
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getPrintJobSettings" (IO (Maybe PrintSettings) -> IO PrintSettings)
-> IO (Maybe PrintSettings) -> IO PrintSettings
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr PrintSettings -> PrintSettings)
-> IO (Maybe PrintSettings)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"settings" ManagedPtr PrintSettings -> PrintSettings
Gtk.PrintSettings.PrintSettings

-- | Construct a `GValueConstruct` with valid value for the “@settings@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPrintJobSettings :: (IsPrintJob o, MIO.MonadIO m, Gtk.PrintSettings.IsPrintSettings a) => a -> m (GValueConstruct o)
constructPrintJobSettings :: forall o (m :: * -> *) a.
(IsPrintJob o, MonadIO m, IsPrintSettings a) =>
a -> m (GValueConstruct o)
constructPrintJobSettings a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"settings" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data PrintJobSettingsPropertyInfo
instance AttrInfo PrintJobSettingsPropertyInfo where
    type AttrAllowedOps PrintJobSettingsPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PrintJobSettingsPropertyInfo = IsPrintJob
    type AttrSetTypeConstraint PrintJobSettingsPropertyInfo = Gtk.PrintSettings.IsPrintSettings
    type AttrTransferTypeConstraint PrintJobSettingsPropertyInfo = Gtk.PrintSettings.IsPrintSettings
    type AttrTransferType PrintJobSettingsPropertyInfo = Gtk.PrintSettings.PrintSettings
    type AttrGetType PrintJobSettingsPropertyInfo = Gtk.PrintSettings.PrintSettings
    type AttrLabel PrintJobSettingsPropertyInfo = "settings"
    type AttrOrigin PrintJobSettingsPropertyInfo = PrintJob
    attrGet = getPrintJobSettings
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gtk.PrintSettings.PrintSettings v
    attrConstruct = constructPrintJobSettings
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.settings"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#g:attr:settings"
        })
#endif

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

-- | 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' printJob #title
-- @
getPrintJobTitle :: (MonadIO m, IsPrintJob o) => o -> m T.Text
getPrintJobTitle :: forall (m :: * -> *) o. (MonadIO m, IsPrintJob o) => o -> m Text
getPrintJobTitle o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getPrintJobTitle" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"title"

-- | 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`.
constructPrintJobTitle :: (IsPrintJob o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructPrintJobTitle :: forall o (m :: * -> *).
(IsPrintJob o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructPrintJobTitle Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"title" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data PrintJobTitlePropertyInfo
instance AttrInfo PrintJobTitlePropertyInfo where
    type AttrAllowedOps PrintJobTitlePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PrintJobTitlePropertyInfo = IsPrintJob
    type AttrSetTypeConstraint PrintJobTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint PrintJobTitlePropertyInfo = (~) T.Text
    type AttrTransferType PrintJobTitlePropertyInfo = T.Text
    type AttrGetType PrintJobTitlePropertyInfo = T.Text
    type AttrLabel PrintJobTitlePropertyInfo = "title"
    type AttrOrigin PrintJobTitlePropertyInfo = PrintJob
    attrGet = getPrintJobTitle
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPrintJobTitle
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#g:attr:title"
        })
#endif

-- VVV Prop "track-print-status"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@track-print-status@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' printJob [ #trackPrintStatus 'Data.GI.Base.Attributes.:=' value ]
-- @
setPrintJobTrackPrintStatus :: (MonadIO m, IsPrintJob o) => o -> Bool -> m ()
setPrintJobTrackPrintStatus :: forall (m :: * -> *) o.
(MonadIO m, IsPrintJob o) =>
o -> Bool -> m ()
setPrintJobTrackPrintStatus o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"track-print-status" Bool
val

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

#if defined(ENABLE_OVERLOADING)
data PrintJobTrackPrintStatusPropertyInfo
instance AttrInfo PrintJobTrackPrintStatusPropertyInfo where
    type AttrAllowedOps PrintJobTrackPrintStatusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PrintJobTrackPrintStatusPropertyInfo = IsPrintJob
    type AttrSetTypeConstraint PrintJobTrackPrintStatusPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PrintJobTrackPrintStatusPropertyInfo = (~) Bool
    type AttrTransferType PrintJobTrackPrintStatusPropertyInfo = Bool
    type AttrGetType PrintJobTrackPrintStatusPropertyInfo = Bool
    type AttrLabel PrintJobTrackPrintStatusPropertyInfo = "track-print-status"
    type AttrOrigin PrintJobTrackPrintStatusPropertyInfo = PrintJob
    attrGet = getPrintJobTrackPrintStatus
    attrSet = setPrintJobTrackPrintStatus
    attrTransfer _ v = do
        return v
    attrConstruct = constructPrintJobTrackPrintStatus
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.trackPrintStatus"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#g:attr:trackPrintStatus"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PrintJob
type instance O.AttributeList PrintJob = PrintJobAttributeList
type PrintJobAttributeList = ('[ '("pageSetup", PrintJobPageSetupPropertyInfo), '("printer", PrintJobPrinterPropertyInfo), '("settings", PrintJobSettingsPropertyInfo), '("title", PrintJobTitlePropertyInfo), '("trackPrintStatus", PrintJobTrackPrintStatusPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
printJobPageSetup :: AttrLabelProxy "pageSetup"
printJobPageSetup = AttrLabelProxy

printJobPrinter :: AttrLabelProxy "printer"
printJobPrinter = AttrLabelProxy

printJobSettings :: AttrLabelProxy "settings"
printJobSettings = AttrLabelProxy

printJobTitle :: AttrLabelProxy "title"
printJobTitle = AttrLabelProxy

printJobTrackPrintStatus :: AttrLabelProxy "trackPrintStatus"
printJobTrackPrintStatus = AttrLabelProxy

#endif

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

#endif

-- method PrintJob::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the job title" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "printer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Printer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrinter`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "settings"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintSettings" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintSettings`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_setup"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PageSetup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPageSetup`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "PrintJob" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_new" gtk_print_job_new :: 
    CString ->                              -- title : TBasicType TUTF8
    Ptr Gtk.Printer.Printer ->              -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    Ptr Gtk.PrintSettings.PrintSettings ->  -- settings : TInterface (Name {namespace = "Gtk", name = "PrintSettings"})
    Ptr Gtk.PageSetup.PageSetup ->          -- page_setup : TInterface (Name {namespace = "Gtk", name = "PageSetup"})
    IO (Ptr PrintJob)

-- | Creates a new @GtkPrintJob@.
printJobNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.Printer.IsPrinter a, Gtk.PrintSettings.IsPrintSettings b, Gtk.PageSetup.IsPageSetup c) =>
    T.Text
    -- ^ /@title@/: the job title
    -> a
    -- ^ /@printer@/: a @GtkPrinter@
    -> b
    -- ^ /@settings@/: a @GtkPrintSettings@
    -> c
    -- ^ /@pageSetup@/: a @GtkPageSetup@
    -> m PrintJob
    -- ^ __Returns:__ a new @GtkPrintJob@
printJobNew :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsPrinter a, IsPrintSettings b,
 IsPageSetup c) =>
Text -> a -> b -> c -> m PrintJob
printJobNew Text
title a
printer b
settings c
pageSetup = IO PrintJob -> m PrintJob
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PrintJob -> m PrintJob) -> IO PrintJob -> m PrintJob
forall a b. (a -> b) -> a -> b
$ do
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    Ptr PrintSettings
settings' <- b -> IO (Ptr PrintSettings)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
settings
    Ptr PageSetup
pageSetup' <- c -> IO (Ptr PageSetup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
pageSetup
    Ptr PrintJob
result <- CString
-> Ptr Printer
-> Ptr PrintSettings
-> Ptr PageSetup
-> IO (Ptr PrintJob)
gtk_print_job_new CString
title' Ptr Printer
printer' Ptr PrintSettings
settings' Ptr PageSetup
pageSetup'
    Text -> Ptr PrintJob -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printJobNew" Ptr PrintJob
result
    PrintJob
result' <- ((ManagedPtr PrintJob -> PrintJob) -> Ptr PrintJob -> IO PrintJob
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PrintJob -> PrintJob
PrintJob) Ptr PrintJob
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
settings
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
pageSetup
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    PrintJob -> IO PrintJob
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PrintJob
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method PrintJob::get_collate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , 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 "gtk_print_job_get_collate" gtk_print_job_get_collate :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO CInt

-- | Gets whether this job is printed collated.
printJobGetCollate ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Bool
    -- ^ __Returns:__ whether the job is printed collated
printJobGetCollate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m Bool
printJobGetCollate a
job = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    CInt
result <- Ptr PrintJob -> IO CInt
gtk_print_job_get_collate Ptr PrintJob
job'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PrintJobGetCollateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetCollateMethodInfo a signature where
    overloadedMethod = printJobGetCollate

instance O.OverloadedMethodInfo PrintJobGetCollateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetCollate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetCollate"
        })


#endif

-- method PrintJob::get_n_up
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , 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 "gtk_print_job_get_n_up" gtk_print_job_get_n_up :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO Word32

-- | Gets the n-up setting for this job.
printJobGetNUp ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Word32
    -- ^ __Returns:__ the n-up setting
printJobGetNUp :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m Word32
printJobGetNUp a
job = IO Word32 -> m Word32
forall a. IO a -> m a
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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    Word32
result <- Ptr PrintJob -> IO Word32
gtk_print_job_get_n_up Ptr PrintJob
job'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data PrintJobGetNUpMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetNUpMethodInfo a signature where
    overloadedMethod = printJobGetNUp

instance O.OverloadedMethodInfo PrintJobGetNUpMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetNUp",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetNUp"
        })


#endif

-- method PrintJob::get_n_up_layout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "NumberUpLayout" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_get_n_up_layout" gtk_print_job_get_n_up_layout :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO CUInt

-- | Gets the n-up layout setting for this job.
printJobGetNUpLayout ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Gtk.Enums.NumberUpLayout
    -- ^ __Returns:__ the n-up layout
printJobGetNUpLayout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m NumberUpLayout
printJobGetNUpLayout a
job = IO NumberUpLayout -> m NumberUpLayout
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NumberUpLayout -> m NumberUpLayout)
-> IO NumberUpLayout -> m NumberUpLayout
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    CUInt
result <- Ptr PrintJob -> IO CUInt
gtk_print_job_get_n_up_layout Ptr PrintJob
job'
    let result' :: NumberUpLayout
result' = (Int -> NumberUpLayout
forall a. Enum a => Int -> a
toEnum (Int -> NumberUpLayout)
-> (CUInt -> Int) -> CUInt -> NumberUpLayout
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
job
    NumberUpLayout -> IO NumberUpLayout
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NumberUpLayout
result'

#if defined(ENABLE_OVERLOADING)
data PrintJobGetNUpLayoutMethodInfo
instance (signature ~ (m Gtk.Enums.NumberUpLayout), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetNUpLayoutMethodInfo a signature where
    overloadedMethod = printJobGetNUpLayout

instance O.OverloadedMethodInfo PrintJobGetNUpLayoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetNUpLayout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetNUpLayout"
        })


#endif

-- method PrintJob::get_num_copies
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , 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 "gtk_print_job_get_num_copies" gtk_print_job_get_num_copies :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO Int32

-- | Gets the number of copies of this job.
printJobGetNumCopies ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Int32
    -- ^ __Returns:__ the number of copies
printJobGetNumCopies :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m Int32
printJobGetNumCopies a
job = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    Int32
result <- Ptr PrintJob -> IO Int32
gtk_print_job_get_num_copies Ptr PrintJob
job'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data PrintJobGetNumCopiesMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetNumCopiesMethodInfo a signature where
    overloadedMethod = printJobGetNumCopies

instance O.OverloadedMethodInfo PrintJobGetNumCopiesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetNumCopies",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetNumCopies"
        })


#endif

-- method PrintJob::get_page_ranges
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_ranges"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the number of ranges"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_ranges"
--              , argType = TBasicType TInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "return location for the number of ranges"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just
--               (TCArray
--                  False
--                  (-1)
--                  1
--                  (TInterface Name { namespace = "Gtk" , name = "PageRange" }))
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_get_page_ranges" gtk_print_job_get_page_ranges :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    Ptr Int32 ->                            -- n_ranges : TBasicType TInt
    IO (Ptr Gtk.PageRange.PageRange)

-- | Gets the page ranges for this job.
printJobGetPageRanges ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m [Gtk.PageRange.PageRange]
    -- ^ __Returns:__ a pointer to an
    --   array of @GtkPageRange@ structs
printJobGetPageRanges :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m [PageRange]
printJobGetPageRanges a
job = IO [PageRange] -> m [PageRange]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [PageRange] -> m [PageRange])
-> IO [PageRange] -> m [PageRange]
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    Ptr Int32
nRanges <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr PageRange
result <- Ptr PrintJob -> Ptr Int32 -> IO (Ptr PageRange)
gtk_print_job_get_page_ranges Ptr PrintJob
job' Ptr Int32
nRanges
    Int32
nRanges' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
nRanges
    Text -> Ptr PageRange -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printJobGetPageRanges" Ptr PageRange
result
    [Ptr PageRange]
result' <- (Int -> Int32 -> Ptr PageRange -> IO [Ptr PageRange]
forall a b. Integral a => Int -> a -> Ptr b -> IO [Ptr b]
unpackBlockArrayWithLength Int
8 Int32
nRanges') Ptr PageRange
result
    [PageRange]
result'' <- (Ptr PageRange -> IO PageRange)
-> [Ptr PageRange] -> IO [PageRange]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr PageRange -> PageRange)
-> Ptr PageRange -> IO PageRange
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr PageRange -> PageRange
Gtk.PageRange.PageRange) [Ptr PageRange]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
nRanges
    [PageRange] -> IO [PageRange]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PageRange]
result''

#if defined(ENABLE_OVERLOADING)
data PrintJobGetPageRangesMethodInfo
instance (signature ~ (m [Gtk.PageRange.PageRange]), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetPageRangesMethodInfo a signature where
    overloadedMethod = printJobGetPageRanges

instance O.OverloadedMethodInfo PrintJobGetPageRangesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetPageRanges",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetPageRanges"
        })


#endif

-- method PrintJob::get_page_set
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "PageSet" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_get_page_set" gtk_print_job_get_page_set :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO CUInt

-- | Gets the @GtkPageSet@ setting for this job.
printJobGetPageSet ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Gtk.Enums.PageSet
    -- ^ __Returns:__ the @GtkPageSet@ setting
printJobGetPageSet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m PageSet
printJobGetPageSet a
job = IO PageSet -> m PageSet
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PageSet -> m PageSet) -> IO PageSet -> m PageSet
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    CUInt
result <- Ptr PrintJob -> IO CUInt
gtk_print_job_get_page_set Ptr PrintJob
job'
    let result' :: PageSet
result' = (Int -> PageSet
forall a. Enum a => Int -> a
toEnum (Int -> PageSet) -> (CUInt -> Int) -> CUInt -> PageSet
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
job
    PageSet -> IO PageSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PageSet
result'

#if defined(ENABLE_OVERLOADING)
data PrintJobGetPageSetMethodInfo
instance (signature ~ (m Gtk.Enums.PageSet), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetPageSetMethodInfo a signature where
    overloadedMethod = printJobGetPageSet

instance O.OverloadedMethodInfo PrintJobGetPageSetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetPageSet",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetPageSet"
        })


#endif

-- method PrintJob::get_pages
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "PrintPages" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_get_pages" gtk_print_job_get_pages :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO CUInt

-- | Gets the @GtkPrintPages@ setting for this job.
printJobGetPages ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Gtk.Enums.PrintPages
    -- ^ __Returns:__ the @GtkPrintPages@ setting
printJobGetPages :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m PrintPages
printJobGetPages a
job = IO PrintPages -> m PrintPages
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PrintPages -> m PrintPages) -> IO PrintPages -> m PrintPages
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    CUInt
result <- Ptr PrintJob -> IO CUInt
gtk_print_job_get_pages Ptr PrintJob
job'
    let result' :: PrintPages
result' = (Int -> PrintPages
forall a. Enum a => Int -> a
toEnum (Int -> PrintPages) -> (CUInt -> Int) -> CUInt -> PrintPages
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
job
    PrintPages -> IO PrintPages
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PrintPages
result'

#if defined(ENABLE_OVERLOADING)
data PrintJobGetPagesMethodInfo
instance (signature ~ (m Gtk.Enums.PrintPages), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetPagesMethodInfo a signature where
    overloadedMethod = printJobGetPages

instance O.OverloadedMethodInfo PrintJobGetPagesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetPages",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetPages"
        })


#endif

-- method PrintJob::get_printer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Printer" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_get_printer" gtk_print_job_get_printer :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO (Ptr Gtk.Printer.Printer)

-- | Gets the @GtkPrinter@ of the print job.
printJobGetPrinter ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Gtk.Printer.Printer
    -- ^ __Returns:__ the printer of /@job@/
printJobGetPrinter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m Printer
printJobGetPrinter a
job = IO Printer -> m Printer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Printer -> m Printer) -> IO Printer -> m Printer
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    Ptr Printer
result <- Ptr PrintJob -> IO (Ptr Printer)
gtk_print_job_get_printer Ptr PrintJob
job'
    Text -> Ptr Printer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printJobGetPrinter" Ptr Printer
result
    Printer
result' <- ((ManagedPtr Printer -> Printer) -> Ptr Printer -> IO Printer
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Printer -> Printer
Gtk.Printer.Printer) Ptr Printer
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    Printer -> IO Printer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Printer
result'

#if defined(ENABLE_OVERLOADING)
data PrintJobGetPrinterMethodInfo
instance (signature ~ (m Gtk.Printer.Printer), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetPrinterMethodInfo a signature where
    overloadedMethod = printJobGetPrinter

instance O.OverloadedMethodInfo PrintJobGetPrinterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetPrinter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetPrinter"
        })


#endif

-- method PrintJob::get_reverse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , 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 "gtk_print_job_get_reverse" gtk_print_job_get_reverse :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO CInt

-- | Gets whether this job is printed reversed.
printJobGetReverse ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Bool
    -- ^ __Returns:__ whether the job is printed reversed.
printJobGetReverse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m Bool
printJobGetReverse a
job = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    CInt
result <- Ptr PrintJob -> IO CInt
gtk_print_job_get_reverse Ptr PrintJob
job'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PrintJobGetReverseMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetReverseMethodInfo a signature where
    overloadedMethod = printJobGetReverse

instance O.OverloadedMethodInfo PrintJobGetReverseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetReverse",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetReverse"
        })


#endif

-- method PrintJob::get_rotate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , 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 "gtk_print_job_get_rotate" gtk_print_job_get_rotate :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO CInt

-- | Gets whether the job is printed rotated.
printJobGetRotate ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Bool
    -- ^ __Returns:__ whether the job is printed rotated
printJobGetRotate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m Bool
printJobGetRotate a
job = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    CInt
result <- Ptr PrintJob -> IO CInt
gtk_print_job_get_rotate Ptr PrintJob
job'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PrintJobGetRotateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetRotateMethodInfo a signature where
    overloadedMethod = printJobGetRotate

instance O.OverloadedMethodInfo PrintJobGetRotateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetRotate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetRotate"
        })


#endif

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

foreign import ccall "gtk_print_job_get_scale" gtk_print_job_get_scale :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO CDouble

-- | Gets the scale for this job.
printJobGetScale ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Double
    -- ^ __Returns:__ the scale
printJobGetScale :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m Double
printJobGetScale a
job = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    CDouble
result <- Ptr PrintJob -> IO CDouble
gtk_print_job_get_scale Ptr PrintJob
job'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data PrintJobGetScaleMethodInfo
instance (signature ~ (m Double), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetScaleMethodInfo a signature where
    overloadedMethod = printJobGetScale

instance O.OverloadedMethodInfo PrintJobGetScaleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetScale",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetScale"
        })


#endif

-- method PrintJob::get_settings
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "PrintSettings" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_get_settings" gtk_print_job_get_settings :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO (Ptr Gtk.PrintSettings.PrintSettings)

-- | Gets the @GtkPrintSettings@ of the print job.
printJobGetSettings ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Gtk.PrintSettings.PrintSettings
    -- ^ __Returns:__ the settings of /@job@/
printJobGetSettings :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m PrintSettings
printJobGetSettings a
job = IO PrintSettings -> m PrintSettings
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PrintSettings -> m PrintSettings)
-> IO PrintSettings -> m PrintSettings
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    Ptr PrintSettings
result <- Ptr PrintJob -> IO (Ptr PrintSettings)
gtk_print_job_get_settings Ptr PrintJob
job'
    Text -> Ptr PrintSettings -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printJobGetSettings" Ptr PrintSettings
result
    PrintSettings
result' <- ((ManagedPtr PrintSettings -> PrintSettings)
-> Ptr PrintSettings -> IO PrintSettings
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PrintSettings -> PrintSettings
Gtk.PrintSettings.PrintSettings) Ptr PrintSettings
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    PrintSettings -> IO PrintSettings
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PrintSettings
result'

#if defined(ENABLE_OVERLOADING)
data PrintJobGetSettingsMethodInfo
instance (signature ~ (m Gtk.PrintSettings.PrintSettings), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetSettingsMethodInfo a signature where
    overloadedMethod = printJobGetSettings

instance O.OverloadedMethodInfo PrintJobGetSettingsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetSettings",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetSettings"
        })


#endif

-- method PrintJob::get_status
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "PrintStatus" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_get_status" gtk_print_job_get_status :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO CUInt

-- | Gets the status of the print job.
printJobGetStatus ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Gtk.Enums.PrintStatus
    -- ^ __Returns:__ the status of /@job@/
printJobGetStatus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m PrintStatus
printJobGetStatus a
job = IO PrintStatus -> m PrintStatus
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PrintStatus -> m PrintStatus)
-> IO PrintStatus -> m PrintStatus
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    CUInt
result <- Ptr PrintJob -> IO CUInt
gtk_print_job_get_status Ptr PrintJob
job'
    let result' :: PrintStatus
result' = (Int -> PrintStatus
forall a. Enum a => Int -> a
toEnum (Int -> PrintStatus) -> (CUInt -> Int) -> CUInt -> PrintStatus
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
job
    PrintStatus -> IO PrintStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PrintStatus
result'

#if defined(ENABLE_OVERLOADING)
data PrintJobGetStatusMethodInfo
instance (signature ~ (m Gtk.Enums.PrintStatus), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetStatusMethodInfo a signature where
    overloadedMethod = printJobGetStatus

instance O.OverloadedMethodInfo PrintJobGetStatusMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetStatus",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetStatus"
        })


#endif

-- method PrintJob::get_surface
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "cairo" , name = "Surface" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_print_job_get_surface" gtk_print_job_get_surface :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Cairo.Surface.Surface)

-- | Gets a cairo surface onto which the pages of
-- the print job should be rendered.
printJobGetSurface ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Cairo.Surface.Surface
    -- ^ __Returns:__ the cairo surface of /@job@/ /(Can throw 'Data.GI.Base.GError.GError')/
printJobGetSurface :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m Surface
printJobGetSurface a
job = IO Surface -> m Surface
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Surface -> m Surface) -> IO Surface -> m Surface
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    IO Surface -> IO () -> IO Surface
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Surface
result <- (Ptr (Ptr GError) -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Surface)) -> IO (Ptr Surface))
-> (Ptr (Ptr GError) -> IO (Ptr Surface)) -> IO (Ptr Surface)
forall a b. (a -> b) -> a -> b
$ Ptr PrintJob -> Ptr (Ptr GError) -> IO (Ptr Surface)
gtk_print_job_get_surface Ptr PrintJob
job'
        Text -> Ptr Surface -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printJobGetSurface" Ptr Surface
result
        Surface
result' <- ((ManagedPtr Surface -> Surface) -> Ptr Surface -> IO Surface
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Surface -> Surface
Cairo.Surface.Surface) Ptr Surface
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
        Surface -> IO Surface
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Surface
result'
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data PrintJobGetSurfaceMethodInfo
instance (signature ~ (m Cairo.Surface.Surface), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetSurfaceMethodInfo a signature where
    overloadedMethod = printJobGetSurface

instance O.OverloadedMethodInfo PrintJobGetSurfaceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetSurface",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetSurface"
        })


#endif

-- method PrintJob::get_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , 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 "gtk_print_job_get_title" gtk_print_job_get_title :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO CString

-- | Gets the job title.
printJobGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m T.Text
    -- ^ __Returns:__ the title of /@job@/
printJobGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m Text
printJobGetTitle a
job = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    CString
result <- Ptr PrintJob -> IO CString
gtk_print_job_get_title Ptr PrintJob
job'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printJobGetTitle" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PrintJobGetTitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetTitleMethodInfo a signature where
    overloadedMethod = printJobGetTitle

instance O.OverloadedMethodInfo PrintJobGetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetTitle"
        })


#endif

-- method PrintJob::get_track_print_status
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , 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 "gtk_print_job_get_track_print_status" gtk_print_job_get_track_print_status :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    IO CInt

-- | Returns whether jobs will be tracked after printing.
-- 
-- For details, see 'GI.Gtk.Objects.PrintJob.printJobSetTrackPrintStatus'.
printJobGetTrackPrintStatus ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if print job status will be reported after printing
printJobGetTrackPrintStatus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> m Bool
printJobGetTrackPrintStatus a
job = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    CInt
result <- Ptr PrintJob -> IO CInt
gtk_print_job_get_track_print_status Ptr PrintJob
job'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PrintJobGetTrackPrintStatusMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobGetTrackPrintStatusMethodInfo a signature where
    overloadedMethod = printJobGetTrackPrintStatus

instance O.OverloadedMethodInfo PrintJobGetTrackPrintStatusMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobGetTrackPrintStatus",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobGetTrackPrintStatus"
        })


#endif

-- method PrintJob::send
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "PrintJobCompleteFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "function to call when the job completes or an error occurs"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data that gets passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dnotify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notify for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_send" gtk_print_job_send :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    FunPtr Gtk.Callbacks.C_PrintJobCompleteFunc -> -- callback : TInterface (Name {namespace = "Gtk", name = "PrintJobCompleteFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- dnotify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sends the print job off to the printer.
printJobSend ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> Gtk.Callbacks.PrintJobCompleteFunc
    -- ^ /@callback@/: function to call when the job completes or an error occurs
    -> m ()
printJobSend :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> PrintJobCompleteFunc -> m ()
printJobSend a
job PrintJobCompleteFunc
callback = 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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    FunPtr C_PrintJobCompleteFunc
callback' <- C_PrintJobCompleteFunc -> IO (FunPtr C_PrintJobCompleteFunc)
Gtk.Callbacks.mk_PrintJobCompleteFunc (Maybe (Ptr (FunPtr C_PrintJobCompleteFunc))
-> PrintJobCompleteFunc_WithClosures -> C_PrintJobCompleteFunc
Gtk.Callbacks.wrap_PrintJobCompleteFunc Maybe (Ptr (FunPtr C_PrintJobCompleteFunc))
forall a. Maybe a
Nothing (PrintJobCompleteFunc -> PrintJobCompleteFunc_WithClosures
Gtk.Callbacks.drop_closures_PrintJobCompleteFunc PrintJobCompleteFunc
callback))
    let userData :: Ptr ()
userData = FunPtr C_PrintJobCompleteFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PrintJobCompleteFunc
callback'
    let dnotify :: FunPtr (Ptr a -> IO ())
dnotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr PrintJob
-> FunPtr C_PrintJobCompleteFunc
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
gtk_print_job_send Ptr PrintJob
job' FunPtr C_PrintJobCompleteFunc
callback' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
dnotify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PrintJobSendMethodInfo
instance (signature ~ (Gtk.Callbacks.PrintJobCompleteFunc -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSendMethodInfo a signature where
    overloadedMethod = printJobSend

instance O.OverloadedMethodInfo PrintJobSendMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSend",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSend"
        })


#endif

-- method PrintJob::set_collate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "collate"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether the job is printed collated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_set_collate" gtk_print_job_set_collate :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    CInt ->                                 -- collate : TBasicType TBoolean
    IO ()

-- | Sets whether this job is printed collated.
printJobSetCollate ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> Bool
    -- ^ /@collate@/: whether the job is printed collated
    -> m ()
printJobSetCollate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> Bool -> m ()
printJobSetCollate a
job Bool
collate = 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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    let collate' :: CInt
collate' = (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
collate
    Ptr PrintJob -> CInt -> IO ()
gtk_print_job_set_collate Ptr PrintJob
job' CInt
collate'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PrintJobSetCollateMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSetCollateMethodInfo a signature where
    overloadedMethod = printJobSetCollate

instance O.OverloadedMethodInfo PrintJobSetCollateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSetCollate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSetCollate"
        })


#endif

-- method PrintJob::set_n_up
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_up"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the n-up value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_set_n_up" gtk_print_job_set_n_up :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    Word32 ->                               -- n_up : TBasicType TUInt
    IO ()

-- | Sets the n-up setting for this job.
printJobSetNUp ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> Word32
    -- ^ /@nUp@/: the n-up value
    -> m ()
printJobSetNUp :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> Word32 -> m ()
printJobSetNUp a
job Word32
nUp = 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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    Ptr PrintJob -> Word32 -> IO ()
gtk_print_job_set_n_up Ptr PrintJob
job' Word32
nUp
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PrintJobSetNUpMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSetNUpMethodInfo a signature where
    overloadedMethod = printJobSetNUp

instance O.OverloadedMethodInfo PrintJobSetNUpMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSetNUp",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSetNUp"
        })


#endif

-- method PrintJob::set_n_up_layout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "NumberUpLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the n-up layout setting"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_set_n_up_layout" gtk_print_job_set_n_up_layout :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    CUInt ->                                -- layout : TInterface (Name {namespace = "Gtk", name = "NumberUpLayout"})
    IO ()

-- | Sets the n-up layout setting for this job.
printJobSetNUpLayout ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> Gtk.Enums.NumberUpLayout
    -- ^ /@layout@/: the n-up layout setting
    -> m ()
printJobSetNUpLayout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> NumberUpLayout -> m ()
printJobSetNUpLayout a
job NumberUpLayout
layout = 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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    let layout' :: CUInt
layout' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (NumberUpLayout -> Int) -> NumberUpLayout -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumberUpLayout -> Int
forall a. Enum a => a -> Int
fromEnum) NumberUpLayout
layout
    Ptr PrintJob -> CUInt -> IO ()
gtk_print_job_set_n_up_layout Ptr PrintJob
job' CUInt
layout'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PrintJobSetNUpLayoutMethodInfo
instance (signature ~ (Gtk.Enums.NumberUpLayout -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSetNUpLayoutMethodInfo a signature where
    overloadedMethod = printJobSetNUpLayout

instance O.OverloadedMethodInfo PrintJobSetNUpLayoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSetNUpLayout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSetNUpLayout"
        })


#endif

-- method PrintJob::set_num_copies
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "num_copies"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of copies"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_set_num_copies" gtk_print_job_set_num_copies :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    Int32 ->                                -- num_copies : TBasicType TInt
    IO ()

-- | Sets the number of copies for this job.
printJobSetNumCopies ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> Int32
    -- ^ /@numCopies@/: the number of copies
    -> m ()
printJobSetNumCopies :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> Int32 -> m ()
printJobSetNumCopies a
job Int32
numCopies = 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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    Ptr PrintJob -> Int32 -> IO ()
gtk_print_job_set_num_copies Ptr PrintJob
job' Int32
numCopies
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PrintJobSetNumCopiesMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSetNumCopiesMethodInfo a signature where
    overloadedMethod = printJobSetNumCopies

instance O.OverloadedMethodInfo PrintJobSetNumCopiesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSetNumCopies",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSetNumCopies"
        })


#endif

-- method PrintJob::set_page_ranges
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ranges"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Gtk" , name = "PageRange" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "pointer to an array of\n   `GtkPageRange` structs"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "n_ranges"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of the @ranges array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_ranges"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of the @ranges array"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_set_page_ranges" gtk_print_job_set_page_ranges :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    Ptr Gtk.PageRange.PageRange ->          -- ranges : TCArray False (-1) 2 (TInterface (Name {namespace = "Gtk", name = "PageRange"}))
    Int32 ->                                -- n_ranges : TBasicType TInt
    IO ()

-- | Sets the page ranges for this job.
printJobSetPageRanges ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> [Gtk.PageRange.PageRange]
    -- ^ /@ranges@/: pointer to an array of
    --    @GtkPageRange@ structs
    -> m ()
printJobSetPageRanges :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> [PageRange] -> m ()
printJobSetPageRanges a
job [PageRange]
ranges = 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
    let nRanges :: Int32
nRanges = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [PageRange] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [PageRange]
ranges
    Ptr PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    [Ptr PageRange]
ranges' <- (PageRange -> IO (Ptr PageRange))
-> [PageRange] -> IO [Ptr PageRange]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM PageRange -> IO (Ptr PageRange)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [PageRange]
ranges
    Ptr PageRange
ranges'' <- Int -> [Ptr PageRange] -> IO (Ptr PageRange)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
8 [Ptr PageRange]
ranges'
    Ptr PrintJob -> Ptr PageRange -> Int32 -> IO ()
gtk_print_job_set_page_ranges Ptr PrintJob
job' Ptr PageRange
ranges'' Int32
nRanges
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    (PageRange -> IO ()) -> [PageRange] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PageRange -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [PageRange]
ranges
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PrintJobSetPageRangesMethodInfo
instance (signature ~ ([Gtk.PageRange.PageRange] -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSetPageRangesMethodInfo a signature where
    overloadedMethod = printJobSetPageRanges

instance O.OverloadedMethodInfo PrintJobSetPageRangesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSetPageRanges",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSetPageRanges"
        })


#endif

-- method PrintJob::set_page_set
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_set"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PageSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPageSet` setting"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_set_page_set" gtk_print_job_set_page_set :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    CUInt ->                                -- page_set : TInterface (Name {namespace = "Gtk", name = "PageSet"})
    IO ()

-- | Sets the @GtkPageSet@ setting for this job.
printJobSetPageSet ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> Gtk.Enums.PageSet
    -- ^ /@pageSet@/: a @GtkPageSet@ setting
    -> m ()
printJobSetPageSet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> PageSet -> m ()
printJobSetPageSet a
job PageSet
pageSet = 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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    let pageSet' :: CUInt
pageSet' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PageSet -> Int) -> PageSet -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageSet -> Int
forall a. Enum a => a -> Int
fromEnum) PageSet
pageSet
    Ptr PrintJob -> CUInt -> IO ()
gtk_print_job_set_page_set Ptr PrintJob
job' CUInt
pageSet'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PrintJobSetPageSetMethodInfo
instance (signature ~ (Gtk.Enums.PageSet -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSetPageSetMethodInfo a signature where
    overloadedMethod = printJobSetPageSet

instance O.OverloadedMethodInfo PrintJobSetPageSetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSetPageSet",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSetPageSet"
        })


#endif

-- method PrintJob::set_pages
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pages"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintPages" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `GtkPrintPages` setting"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_set_pages" gtk_print_job_set_pages :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    CUInt ->                                -- pages : TInterface (Name {namespace = "Gtk", name = "PrintPages"})
    IO ()

-- | Sets the @GtkPrintPages@ setting for this job.
printJobSetPages ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> Gtk.Enums.PrintPages
    -- ^ /@pages@/: the @GtkPrintPages@ setting
    -> m ()
printJobSetPages :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> PrintPages -> m ()
printJobSetPages a
job PrintPages
pages = 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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    let pages' :: CUInt
pages' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PrintPages -> Int) -> PrintPages -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintPages -> Int
forall a. Enum a => a -> Int
fromEnum) PrintPages
pages
    Ptr PrintJob -> CUInt -> IO ()
gtk_print_job_set_pages Ptr PrintJob
job' CUInt
pages'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PrintJobSetPagesMethodInfo
instance (signature ~ (Gtk.Enums.PrintPages -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSetPagesMethodInfo a signature where
    overloadedMethod = printJobSetPages

instance O.OverloadedMethodInfo PrintJobSetPagesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSetPages",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSetPages"
        })


#endif

-- method PrintJob::set_reverse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "reverse"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether the job is printed reversed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_set_reverse" gtk_print_job_set_reverse :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    CInt ->                                 -- reverse : TBasicType TBoolean
    IO ()

-- | Sets whether this job is printed reversed.
printJobSetReverse ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> Bool
    -- ^ /@reverse@/: whether the job is printed reversed
    -> m ()
printJobSetReverse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> Bool -> m ()
printJobSetReverse a
job Bool
reverse = 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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    let reverse' :: CInt
reverse' = (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
reverse
    Ptr PrintJob -> CInt -> IO ()
gtk_print_job_set_reverse Ptr PrintJob
job' CInt
reverse'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PrintJobSetReverseMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSetReverseMethodInfo a signature where
    overloadedMethod = printJobSetReverse

instance O.OverloadedMethodInfo PrintJobSetReverseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSetReverse",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSetReverse"
        })


#endif

-- method PrintJob::set_rotate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rotate"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to print rotated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_set_rotate" gtk_print_job_set_rotate :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    CInt ->                                 -- rotate : TBasicType TBoolean
    IO ()

-- | Sets whether this job is printed rotated.
printJobSetRotate ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> Bool
    -- ^ /@rotate@/: whether to print rotated
    -> m ()
printJobSetRotate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> Bool -> m ()
printJobSetRotate a
job Bool
rotate = 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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    let rotate' :: CInt
rotate' = (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
rotate
    Ptr PrintJob -> CInt -> IO ()
gtk_print_job_set_rotate Ptr PrintJob
job' CInt
rotate'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PrintJobSetRotateMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSetRotateMethodInfo a signature where
    overloadedMethod = printJobSetRotate

instance O.OverloadedMethodInfo PrintJobSetRotateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSetRotate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSetRotate"
        })


#endif

-- method PrintJob::set_scale
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scale"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the scale" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_set_scale" gtk_print_job_set_scale :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    CDouble ->                              -- scale : TBasicType TDouble
    IO ()

-- | Sets the scale for this job.
-- 
-- 1.0 means unscaled.
printJobSetScale ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> Double
    -- ^ /@scale@/: the scale
    -> m ()
printJobSetScale :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> Double -> m ()
printJobSetScale a
job Double
scale = 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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    let scale' :: CDouble
scale' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
scale
    Ptr PrintJob -> CDouble -> IO ()
gtk_print_job_set_scale Ptr PrintJob
job' CDouble
scale'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PrintJobSetScaleMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSetScaleMethodInfo a signature where
    overloadedMethod = printJobSetScale

instance O.OverloadedMethodInfo PrintJobSetScaleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSetScale",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSetScale"
        })


#endif

-- method PrintJob::set_source_fd
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file descriptor" , 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 "gtk_print_job_set_source_fd" gtk_print_job_set_source_fd :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    Int32 ->                                -- fd : TBasicType TInt
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Make the @GtkPrintJob@ send an existing document to the
-- printing system.
-- 
-- The file can be in any format understood by the platforms
-- printing system (typically PostScript, but on many platforms
-- PDF may work too). See 'GI.Gtk.Objects.Printer.printerAcceptsPdf' and
-- 'GI.Gtk.Objects.Printer.printerAcceptsPs'.
-- 
-- This is similar to 'GI.Gtk.Objects.PrintJob.printJobSetSourceFile',
-- but takes expects an open file descriptor for the file,
-- instead of a filename.
printJobSetSourceFd ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> Int32
    -- ^ /@fd@/: a file descriptor
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
printJobSetSourceFd :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> Int32 -> m ()
printJobSetSourceFd a
job Int32
fd = 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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    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 PrintJob -> Int32 -> Ptr (Ptr GError) -> IO CInt
gtk_print_job_set_source_fd Ptr PrintJob
job' Int32
fd
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data PrintJobSetSourceFdMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSetSourceFdMethodInfo a signature where
    overloadedMethod = printJobSetSourceFd

instance O.OverloadedMethodInfo PrintJobSetSourceFdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSetSourceFd",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSetSourceFd"
        })


#endif

-- method PrintJob::set_source_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the file to be printed"
--                 , 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 "gtk_print_job_set_source_file" gtk_print_job_set_source_file :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    CString ->                              -- filename : TBasicType TFileName
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Make the @GtkPrintJob@ send an existing document to the
-- printing system.
-- 
-- The file can be in any format understood by the platforms
-- printing system (typically PostScript, but on many platforms
-- PDF may work too). See 'GI.Gtk.Objects.Printer.printerAcceptsPdf' and
-- 'GI.Gtk.Objects.Printer.printerAcceptsPs'.
printJobSetSourceFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> [Char]
    -- ^ /@filename@/: the file to be printed
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
printJobSetSourceFile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> String -> m ()
printJobSetSourceFile a
job String
filename = 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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    CString
filename' <- String -> IO CString
stringToCString String
filename
    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 PrintJob -> CString -> Ptr (Ptr GError) -> IO CInt
gtk_print_job_set_source_file Ptr PrintJob
job' CString
filename'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
     )

#if defined(ENABLE_OVERLOADING)
data PrintJobSetSourceFileMethodInfo
instance (signature ~ ([Char] -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSetSourceFileMethodInfo a signature where
    overloadedMethod = printJobSetSourceFile

instance O.OverloadedMethodInfo PrintJobSetSourceFileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSetSourceFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSetSourceFile"
        })


#endif

-- method PrintJob::set_track_print_status
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "job"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintJob" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintJob`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "track_status"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to track status after printing"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_print_job_set_track_print_status" gtk_print_job_set_track_print_status :: 
    Ptr PrintJob ->                         -- job : TInterface (Name {namespace = "Gtk", name = "PrintJob"})
    CInt ->                                 -- track_status : TBasicType TBoolean
    IO ()

-- | If track_status is 'P.True', the print job will try to continue report
-- on the status of the print job in the printer queues and printer.
-- 
-- This can allow your application to show things like “out of paper”
-- issues, and when the print job actually reaches the printer.
-- 
-- This function is often implemented using some form of polling,
-- so it should not be enabled unless needed.
printJobSetTrackPrintStatus ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintJob a) =>
    a
    -- ^ /@job@/: a @GtkPrintJob@
    -> Bool
    -- ^ /@trackStatus@/: 'P.True' to track status after printing
    -> m ()
printJobSetTrackPrintStatus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintJob a) =>
a -> Bool -> m ()
printJobSetTrackPrintStatus a
job Bool
trackStatus = 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 PrintJob
job' <- a -> IO (Ptr PrintJob)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
job
    let trackStatus' :: CInt
trackStatus' = (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
trackStatus
    Ptr PrintJob -> CInt -> IO ()
gtk_print_job_set_track_print_status Ptr PrintJob
job' CInt
trackStatus'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
job
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PrintJobSetTrackPrintStatusMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsPrintJob a) => O.OverloadedMethod PrintJobSetTrackPrintStatusMethodInfo a signature where
    overloadedMethod = printJobSetTrackPrintStatus

instance O.OverloadedMethodInfo PrintJobSetTrackPrintStatusMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.PrintJob.printJobSetTrackPrintStatus",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-PrintJob.html#v:printJobSetTrackPrintStatus"
        })


#endif