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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GtkPrinter@ object represents a printer.
-- 
-- You only need to deal directly with printers if you use the
-- non-portable t'GI.Gtk.Objects.PrintUnixDialog.PrintUnixDialog' API.
-- 
-- A @GtkPrinter@ allows to get status information about the printer,
-- such as its description, its location, the number of queued jobs,
-- etc. Most importantly, a @GtkPrinter@ object can be used to create
-- a t'GI.Gtk.Objects.PrintJob.PrintJob' object, which lets you print to the printer.

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

module GI.Gtk.Objects.Printer
    ( 

-- * Exported types
    Printer(..)                             ,
    IsPrinter                               ,
    toPrinter                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [acceptsPdf]("GI.Gtk.Objects.Printer#g:method:acceptsPdf"), [acceptsPs]("GI.Gtk.Objects.Printer#g:method:acceptsPs"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [compare]("GI.Gtk.Objects.Printer#g:method:compare"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasDetails]("GI.Gtk.Objects.Printer#g:method:hasDetails"), [isAcceptingJobs]("GI.Gtk.Objects.Printer#g:method:isAcceptingJobs"), [isActive]("GI.Gtk.Objects.Printer#g:method:isActive"), [isDefault]("GI.Gtk.Objects.Printer#g:method:isDefault"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isPaused]("GI.Gtk.Objects.Printer#g:method:isPaused"), [isVirtual]("GI.Gtk.Objects.Printer#g:method:isVirtual"), [listPapers]("GI.Gtk.Objects.Printer#g:method:listPapers"), [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"), [requestDetails]("GI.Gtk.Objects.Printer#g:method:requestDetails"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getBackend]("GI.Gtk.Objects.Printer#g:method:getBackend"), [getCapabilities]("GI.Gtk.Objects.Printer#g:method:getCapabilities"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDefaultPageSize]("GI.Gtk.Objects.Printer#g:method:getDefaultPageSize"), [getDescription]("GI.Gtk.Objects.Printer#g:method:getDescription"), [getHardMargins]("GI.Gtk.Objects.Printer#g:method:getHardMargins"), [getHardMarginsForPaperSize]("GI.Gtk.Objects.Printer#g:method:getHardMarginsForPaperSize"), [getIconName]("GI.Gtk.Objects.Printer#g:method:getIconName"), [getJobCount]("GI.Gtk.Objects.Printer#g:method:getJobCount"), [getLocation]("GI.Gtk.Objects.Printer#g:method:getLocation"), [getName]("GI.Gtk.Objects.Printer#g:method:getName"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getStateMessage]("GI.Gtk.Objects.Printer#g:method:getStateMessage").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolvePrinterMethod                    ,
#endif

-- ** acceptsPdf #method:acceptsPdf#

#if defined(ENABLE_OVERLOADING)
    PrinterAcceptsPdfMethodInfo             ,
#endif
    printerAcceptsPdf                       ,


-- ** acceptsPs #method:acceptsPs#

#if defined(ENABLE_OVERLOADING)
    PrinterAcceptsPsMethodInfo              ,
#endif
    printerAcceptsPs                        ,


-- ** compare #method:compare#

#if defined(ENABLE_OVERLOADING)
    PrinterCompareMethodInfo                ,
#endif
    printerCompare                          ,


-- ** getBackend #method:getBackend#

#if defined(ENABLE_OVERLOADING)
    PrinterGetBackendMethodInfo             ,
#endif
    printerGetBackend                       ,


-- ** getCapabilities #method:getCapabilities#

#if defined(ENABLE_OVERLOADING)
    PrinterGetCapabilitiesMethodInfo        ,
#endif
    printerGetCapabilities                  ,


-- ** getDefaultPageSize #method:getDefaultPageSize#

#if defined(ENABLE_OVERLOADING)
    PrinterGetDefaultPageSizeMethodInfo     ,
#endif
    printerGetDefaultPageSize               ,


-- ** getDescription #method:getDescription#

#if defined(ENABLE_OVERLOADING)
    PrinterGetDescriptionMethodInfo         ,
#endif
    printerGetDescription                   ,


-- ** getHardMargins #method:getHardMargins#

#if defined(ENABLE_OVERLOADING)
    PrinterGetHardMarginsMethodInfo         ,
#endif
    printerGetHardMargins                   ,


-- ** getHardMarginsForPaperSize #method:getHardMarginsForPaperSize#

#if defined(ENABLE_OVERLOADING)
    PrinterGetHardMarginsForPaperSizeMethodInfo,
#endif
    printerGetHardMarginsForPaperSize       ,


-- ** getIconName #method:getIconName#

#if defined(ENABLE_OVERLOADING)
    PrinterGetIconNameMethodInfo            ,
#endif
    printerGetIconName                      ,


-- ** getJobCount #method:getJobCount#

#if defined(ENABLE_OVERLOADING)
    PrinterGetJobCountMethodInfo            ,
#endif
    printerGetJobCount                      ,


-- ** getLocation #method:getLocation#

#if defined(ENABLE_OVERLOADING)
    PrinterGetLocationMethodInfo            ,
#endif
    printerGetLocation                      ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    PrinterGetNameMethodInfo                ,
#endif
    printerGetName                          ,


-- ** getStateMessage #method:getStateMessage#

#if defined(ENABLE_OVERLOADING)
    PrinterGetStateMessageMethodInfo        ,
#endif
    printerGetStateMessage                  ,


-- ** hasDetails #method:hasDetails#

#if defined(ENABLE_OVERLOADING)
    PrinterHasDetailsMethodInfo             ,
#endif
    printerHasDetails                       ,


-- ** isAcceptingJobs #method:isAcceptingJobs#

#if defined(ENABLE_OVERLOADING)
    PrinterIsAcceptingJobsMethodInfo        ,
#endif
    printerIsAcceptingJobs                  ,


-- ** isActive #method:isActive#

#if defined(ENABLE_OVERLOADING)
    PrinterIsActiveMethodInfo               ,
#endif
    printerIsActive                         ,


-- ** isDefault #method:isDefault#

#if defined(ENABLE_OVERLOADING)
    PrinterIsDefaultMethodInfo              ,
#endif
    printerIsDefault                        ,


-- ** isPaused #method:isPaused#

#if defined(ENABLE_OVERLOADING)
    PrinterIsPausedMethodInfo               ,
#endif
    printerIsPaused                         ,


-- ** isVirtual #method:isVirtual#

#if defined(ENABLE_OVERLOADING)
    PrinterIsVirtualMethodInfo              ,
#endif
    printerIsVirtual                        ,


-- ** listPapers #method:listPapers#

#if defined(ENABLE_OVERLOADING)
    PrinterListPapersMethodInfo             ,
#endif
    printerListPapers                       ,


-- ** new #method:new#

    printerNew                              ,


-- ** requestDetails #method:requestDetails#

#if defined(ENABLE_OVERLOADING)
    PrinterRequestDetailsMethodInfo         ,
#endif
    printerRequestDetails                   ,




 -- * Properties


-- ** acceptingJobs #attr:acceptingJobs#
-- | 'P.True' if the printer is accepting jobs.

#if defined(ENABLE_OVERLOADING)
    PrinterAcceptingJobsPropertyInfo        ,
#endif
    getPrinterAcceptingJobs                 ,
#if defined(ENABLE_OVERLOADING)
    printerAcceptingJobs                    ,
#endif


-- ** acceptsPdf #attr:acceptsPdf#
-- | 'P.True' if this printer can accept PDF.

#if defined(ENABLE_OVERLOADING)
    PrinterAcceptsPdfPropertyInfo           ,
#endif
    constructPrinterAcceptsPdf              ,
    getPrinterAcceptsPdf                    ,


-- ** acceptsPs #attr:acceptsPs#
-- | 'P.True' if this printer can accept PostScript.

#if defined(ENABLE_OVERLOADING)
    PrinterAcceptsPsPropertyInfo            ,
#endif
    constructPrinterAcceptsPs               ,
    getPrinterAcceptsPs                     ,


-- ** iconName #attr:iconName#
-- | Icon name to use for the printer.

#if defined(ENABLE_OVERLOADING)
    PrinterIconNamePropertyInfo             ,
#endif
    getPrinterIconName                      ,
#if defined(ENABLE_OVERLOADING)
    printerIconName                         ,
#endif


-- ** isVirtual #attr:isVirtual#
-- | 'P.False' if this represents a real hardware device.

#if defined(ENABLE_OVERLOADING)
    PrinterIsVirtualPropertyInfo            ,
#endif
    constructPrinterIsVirtual               ,
    getPrinterIsVirtual                     ,


-- ** jobCount #attr:jobCount#
-- | Number of jobs queued in the printer.

#if defined(ENABLE_OVERLOADING)
    PrinterJobCountPropertyInfo             ,
#endif
    getPrinterJobCount                      ,
#if defined(ENABLE_OVERLOADING)
    printerJobCount                         ,
#endif


-- ** location #attr:location#
-- | Information about the location of the printer.

#if defined(ENABLE_OVERLOADING)
    PrinterLocationPropertyInfo             ,
#endif
    getPrinterLocation                      ,
#if defined(ENABLE_OVERLOADING)
    printerLocation                         ,
#endif


-- ** name #attr:name#
-- | The name of the printer.

#if defined(ENABLE_OVERLOADING)
    PrinterNamePropertyInfo                 ,
#endif
    constructPrinterName                    ,
    getPrinterName                          ,
#if defined(ENABLE_OVERLOADING)
    printerName                             ,
#endif


-- ** paused #attr:paused#
-- | 'P.True' if this printer is paused.
-- 
-- A paused printer still accepts jobs, but it does
-- not print them.

#if defined(ENABLE_OVERLOADING)
    PrinterPausedPropertyInfo               ,
#endif
    getPrinterPaused                        ,
#if defined(ENABLE_OVERLOADING)
    printerPaused                           ,
#endif


-- ** stateMessage #attr:stateMessage#
-- | String giving the current status of the printer.

#if defined(ENABLE_OVERLOADING)
    PrinterStateMessagePropertyInfo         ,
#endif
    getPrinterStateMessage                  ,
#if defined(ENABLE_OVERLOADING)
    printerStateMessage                     ,
#endif




 -- * Signals


-- ** detailsAcquired #signal:detailsAcquired#

    PrinterDetailsAcquiredCallback          ,
#if defined(ENABLE_OVERLOADING)
    PrinterDetailsAcquiredSignalInfo        ,
#endif
    afterPrinterDetailsAcquired             ,
    onPrinterDetailsAcquired                ,




    ) 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.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Objects.PageSetup as Gtk.PageSetup
import {-# SOURCE #-} qualified GI.Gtk.Structs.PaperSize as Gtk.PaperSize
import {-# SOURCE #-} qualified GI.Gtk.Structs.PrintBackend as Gtk.PrintBackend

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

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

foreign import ccall "gtk_printer_get_type"
    c_gtk_printer_get_type :: IO B.Types.GType

instance B.Types.TypedObject Printer where
    glibType :: IO GType
glibType = IO GType
c_gtk_printer_get_type

instance B.Types.GObject Printer

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

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

-- | Cast to `Printer`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toPrinter :: (MIO.MonadIO m, IsPrinter o) => o -> m Printer
toPrinter :: forall (m :: * -> *) o. (MonadIO m, IsPrinter o) => o -> m Printer
toPrinter = 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) -> (o -> IO Printer) -> o -> m Printer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Printer -> Printer) -> o -> IO Printer
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Printer -> Printer
Printer

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePrinterMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePrinterMethod "acceptsPdf" o = PrinterAcceptsPdfMethodInfo
    ResolvePrinterMethod "acceptsPs" o = PrinterAcceptsPsMethodInfo
    ResolvePrinterMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePrinterMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePrinterMethod "compare" o = PrinterCompareMethodInfo
    ResolvePrinterMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePrinterMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePrinterMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePrinterMethod "hasDetails" o = PrinterHasDetailsMethodInfo
    ResolvePrinterMethod "isAcceptingJobs" o = PrinterIsAcceptingJobsMethodInfo
    ResolvePrinterMethod "isActive" o = PrinterIsActiveMethodInfo
    ResolvePrinterMethod "isDefault" o = PrinterIsDefaultMethodInfo
    ResolvePrinterMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePrinterMethod "isPaused" o = PrinterIsPausedMethodInfo
    ResolvePrinterMethod "isVirtual" o = PrinterIsVirtualMethodInfo
    ResolvePrinterMethod "listPapers" o = PrinterListPapersMethodInfo
    ResolvePrinterMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePrinterMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePrinterMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePrinterMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePrinterMethod "requestDetails" o = PrinterRequestDetailsMethodInfo
    ResolvePrinterMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePrinterMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePrinterMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePrinterMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePrinterMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePrinterMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePrinterMethod "getBackend" o = PrinterGetBackendMethodInfo
    ResolvePrinterMethod "getCapabilities" o = PrinterGetCapabilitiesMethodInfo
    ResolvePrinterMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePrinterMethod "getDefaultPageSize" o = PrinterGetDefaultPageSizeMethodInfo
    ResolvePrinterMethod "getDescription" o = PrinterGetDescriptionMethodInfo
    ResolvePrinterMethod "getHardMargins" o = PrinterGetHardMarginsMethodInfo
    ResolvePrinterMethod "getHardMarginsForPaperSize" o = PrinterGetHardMarginsForPaperSizeMethodInfo
    ResolvePrinterMethod "getIconName" o = PrinterGetIconNameMethodInfo
    ResolvePrinterMethod "getJobCount" o = PrinterGetJobCountMethodInfo
    ResolvePrinterMethod "getLocation" o = PrinterGetLocationMethodInfo
    ResolvePrinterMethod "getName" o = PrinterGetNameMethodInfo
    ResolvePrinterMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePrinterMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePrinterMethod "getStateMessage" o = PrinterGetStateMessageMethodInfo
    ResolvePrinterMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePrinterMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePrinterMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePrinterMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Printer::details-acquired
-- | Emitted in response to a request for detailed information
-- about a printer from the print backend.
-- 
-- The /@success@/ parameter indicates if the information was
-- actually obtained.
type PrinterDetailsAcquiredCallback =
    Bool
    -- ^ /@success@/: 'P.True' if the details were successfully acquired
    -> IO ()

type C_PrinterDetailsAcquiredCallback =
    Ptr Printer ->                          -- object
    CInt ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PrinterDetailsAcquiredCallback :: 
    GObject a => (a -> PrinterDetailsAcquiredCallback) ->
    C_PrinterDetailsAcquiredCallback
wrap_PrinterDetailsAcquiredCallback :: forall a.
GObject a =>
(a -> PrinterDetailsAcquiredCallback)
-> C_PrinterDetailsAcquiredCallback
wrap_PrinterDetailsAcquiredCallback a -> PrinterDetailsAcquiredCallback
gi'cb Ptr Printer
gi'selfPtr CInt
success Ptr ()
_ = do
    let success' :: Bool
success' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
success
    Ptr Printer -> (Printer -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Printer
gi'selfPtr ((Printer -> IO ()) -> IO ()) -> (Printer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Printer
gi'self -> a -> PrinterDetailsAcquiredCallback
gi'cb (Printer -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Printer
gi'self)  Bool
success'


-- | Connect a signal handler for the [detailsAcquired](#signal:detailsAcquired) 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' printer #detailsAcquired callback
-- @
-- 
-- 
onPrinterDetailsAcquired :: (IsPrinter a, MonadIO m) => a -> ((?self :: a) => PrinterDetailsAcquiredCallback) -> m SignalHandlerId
onPrinterDetailsAcquired :: forall a (m :: * -> *).
(IsPrinter a, MonadIO m) =>
a
-> ((?self::a) => PrinterDetailsAcquiredCallback)
-> m SignalHandlerId
onPrinterDetailsAcquired a
obj (?self::a) => PrinterDetailsAcquiredCallback
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 -> PrinterDetailsAcquiredCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PrinterDetailsAcquiredCallback
PrinterDetailsAcquiredCallback
cb
    let wrapped' :: C_PrinterDetailsAcquiredCallback
wrapped' = (a -> PrinterDetailsAcquiredCallback)
-> C_PrinterDetailsAcquiredCallback
forall a.
GObject a =>
(a -> PrinterDetailsAcquiredCallback)
-> C_PrinterDetailsAcquiredCallback
wrap_PrinterDetailsAcquiredCallback a -> PrinterDetailsAcquiredCallback
wrapped
    FunPtr C_PrinterDetailsAcquiredCallback
wrapped'' <- C_PrinterDetailsAcquiredCallback
-> IO (FunPtr C_PrinterDetailsAcquiredCallback)
mk_PrinterDetailsAcquiredCallback C_PrinterDetailsAcquiredCallback
wrapped'
    a
-> Text
-> FunPtr C_PrinterDetailsAcquiredCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"details-acquired" FunPtr C_PrinterDetailsAcquiredCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [detailsAcquired](#signal:detailsAcquired) 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' printer #detailsAcquired 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.
-- 
afterPrinterDetailsAcquired :: (IsPrinter a, MonadIO m) => a -> ((?self :: a) => PrinterDetailsAcquiredCallback) -> m SignalHandlerId
afterPrinterDetailsAcquired :: forall a (m :: * -> *).
(IsPrinter a, MonadIO m) =>
a
-> ((?self::a) => PrinterDetailsAcquiredCallback)
-> m SignalHandlerId
afterPrinterDetailsAcquired a
obj (?self::a) => PrinterDetailsAcquiredCallback
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 -> PrinterDetailsAcquiredCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PrinterDetailsAcquiredCallback
PrinterDetailsAcquiredCallback
cb
    let wrapped' :: C_PrinterDetailsAcquiredCallback
wrapped' = (a -> PrinterDetailsAcquiredCallback)
-> C_PrinterDetailsAcquiredCallback
forall a.
GObject a =>
(a -> PrinterDetailsAcquiredCallback)
-> C_PrinterDetailsAcquiredCallback
wrap_PrinterDetailsAcquiredCallback a -> PrinterDetailsAcquiredCallback
wrapped
    FunPtr C_PrinterDetailsAcquiredCallback
wrapped'' <- C_PrinterDetailsAcquiredCallback
-> IO (FunPtr C_PrinterDetailsAcquiredCallback)
mk_PrinterDetailsAcquiredCallback C_PrinterDetailsAcquiredCallback
wrapped'
    a
-> Text
-> FunPtr C_PrinterDetailsAcquiredCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"details-acquired" FunPtr C_PrinterDetailsAcquiredCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PrinterDetailsAcquiredSignalInfo
instance SignalInfo PrinterDetailsAcquiredSignalInfo where
    type HaskellCallbackType PrinterDetailsAcquiredSignalInfo = PrinterDetailsAcquiredCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PrinterDetailsAcquiredCallback cb
        cb'' <- mk_PrinterDetailsAcquiredCallback cb'
        connectSignalFunPtr obj "details-acquired" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Printer::details-acquired"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Printer.html#g:signal:detailsAcquired"})

#endif

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

-- | Get the value of the “@accepting-jobs@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' printer #acceptingJobs
-- @
getPrinterAcceptingJobs :: (MonadIO m, IsPrinter o) => o -> m Bool
getPrinterAcceptingJobs :: forall (m :: * -> *) o. (MonadIO m, IsPrinter o) => o -> m Bool
getPrinterAcceptingJobs 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
"accepting-jobs"

#if defined(ENABLE_OVERLOADING)
data PrinterAcceptingJobsPropertyInfo
instance AttrInfo PrinterAcceptingJobsPropertyInfo where
    type AttrAllowedOps PrinterAcceptingJobsPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint PrinterAcceptingJobsPropertyInfo = IsPrinter
    type AttrSetTypeConstraint PrinterAcceptingJobsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint PrinterAcceptingJobsPropertyInfo = (~) ()
    type AttrTransferType PrinterAcceptingJobsPropertyInfo = ()
    type AttrGetType PrinterAcceptingJobsPropertyInfo = Bool
    type AttrLabel PrinterAcceptingJobsPropertyInfo = "accepting-jobs"
    type AttrOrigin PrinterAcceptingJobsPropertyInfo = Printer
    attrGet = getPrinterAcceptingJobs
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Printer.acceptingJobs"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Printer.html#g:attr:acceptingJobs"
        })
#endif

-- VVV Prop "accepts-pdf"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@accepts-pdf@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' printer #acceptsPdf
-- @
getPrinterAcceptsPdf :: (MonadIO m, IsPrinter o) => o -> m Bool
getPrinterAcceptsPdf :: forall (m :: * -> *) o. (MonadIO m, IsPrinter o) => o -> m Bool
getPrinterAcceptsPdf 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
"accepts-pdf"

-- | Construct a `GValueConstruct` with valid value for the “@accepts-pdf@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPrinterAcceptsPdf :: (IsPrinter o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructPrinterAcceptsPdf :: forall o (m :: * -> *).
(IsPrinter o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructPrinterAcceptsPdf 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
"accepts-pdf" Bool
val

#if defined(ENABLE_OVERLOADING)
data PrinterAcceptsPdfPropertyInfo
instance AttrInfo PrinterAcceptsPdfPropertyInfo where
    type AttrAllowedOps PrinterAcceptsPdfPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PrinterAcceptsPdfPropertyInfo = IsPrinter
    type AttrSetTypeConstraint PrinterAcceptsPdfPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PrinterAcceptsPdfPropertyInfo = (~) Bool
    type AttrTransferType PrinterAcceptsPdfPropertyInfo = Bool
    type AttrGetType PrinterAcceptsPdfPropertyInfo = Bool
    type AttrLabel PrinterAcceptsPdfPropertyInfo = "accepts-pdf"
    type AttrOrigin PrinterAcceptsPdfPropertyInfo = Printer
    attrGet = getPrinterAcceptsPdf
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPrinterAcceptsPdf
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Printer.acceptsPdf"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Printer.html#g:attr:acceptsPdf"
        })
#endif

-- VVV Prop "accepts-ps"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@accepts-ps@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' printer #acceptsPs
-- @
getPrinterAcceptsPs :: (MonadIO m, IsPrinter o) => o -> m Bool
getPrinterAcceptsPs :: forall (m :: * -> *) o. (MonadIO m, IsPrinter o) => o -> m Bool
getPrinterAcceptsPs 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
"accepts-ps"

-- | Construct a `GValueConstruct` with valid value for the “@accepts-ps@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPrinterAcceptsPs :: (IsPrinter o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructPrinterAcceptsPs :: forall o (m :: * -> *).
(IsPrinter o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructPrinterAcceptsPs 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
"accepts-ps" Bool
val

#if defined(ENABLE_OVERLOADING)
data PrinterAcceptsPsPropertyInfo
instance AttrInfo PrinterAcceptsPsPropertyInfo where
    type AttrAllowedOps PrinterAcceptsPsPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PrinterAcceptsPsPropertyInfo = IsPrinter
    type AttrSetTypeConstraint PrinterAcceptsPsPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PrinterAcceptsPsPropertyInfo = (~) Bool
    type AttrTransferType PrinterAcceptsPsPropertyInfo = Bool
    type AttrGetType PrinterAcceptsPsPropertyInfo = Bool
    type AttrLabel PrinterAcceptsPsPropertyInfo = "accepts-ps"
    type AttrOrigin PrinterAcceptsPsPropertyInfo = Printer
    attrGet = getPrinterAcceptsPs
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPrinterAcceptsPs
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Printer.acceptsPs"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Printer.html#g:attr:acceptsPs"
        })
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data PrinterIconNamePropertyInfo
instance AttrInfo PrinterIconNamePropertyInfo where
    type AttrAllowedOps PrinterIconNamePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PrinterIconNamePropertyInfo = IsPrinter
    type AttrSetTypeConstraint PrinterIconNamePropertyInfo = (~) ()
    type AttrTransferTypeConstraint PrinterIconNamePropertyInfo = (~) ()
    type AttrTransferType PrinterIconNamePropertyInfo = ()
    type AttrGetType PrinterIconNamePropertyInfo = T.Text
    type AttrLabel PrinterIconNamePropertyInfo = "icon-name"
    type AttrOrigin PrinterIconNamePropertyInfo = Printer
    attrGet = getPrinterIconName
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Printer.iconName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Printer.html#g:attr:iconName"
        })
#endif

-- VVV Prop "is-virtual"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@is-virtual@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' printer #isVirtual
-- @
getPrinterIsVirtual :: (MonadIO m, IsPrinter o) => o -> m Bool
getPrinterIsVirtual :: forall (m :: * -> *) o. (MonadIO m, IsPrinter o) => o -> m Bool
getPrinterIsVirtual 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
"is-virtual"

-- | Construct a `GValueConstruct` with valid value for the “@is-virtual@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPrinterIsVirtual :: (IsPrinter o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructPrinterIsVirtual :: forall o (m :: * -> *).
(IsPrinter o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructPrinterIsVirtual 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
"is-virtual" Bool
val

#if defined(ENABLE_OVERLOADING)
data PrinterIsVirtualPropertyInfo
instance AttrInfo PrinterIsVirtualPropertyInfo where
    type AttrAllowedOps PrinterIsVirtualPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PrinterIsVirtualPropertyInfo = IsPrinter
    type AttrSetTypeConstraint PrinterIsVirtualPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PrinterIsVirtualPropertyInfo = (~) Bool
    type AttrTransferType PrinterIsVirtualPropertyInfo = Bool
    type AttrGetType PrinterIsVirtualPropertyInfo = Bool
    type AttrLabel PrinterIsVirtualPropertyInfo = "is-virtual"
    type AttrOrigin PrinterIsVirtualPropertyInfo = Printer
    attrGet = getPrinterIsVirtual
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructPrinterIsVirtual
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Printer.isVirtual"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Printer.html#g:attr:isVirtual"
        })
#endif

-- VVV Prop "job-count"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data PrinterJobCountPropertyInfo
instance AttrInfo PrinterJobCountPropertyInfo where
    type AttrAllowedOps PrinterJobCountPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint PrinterJobCountPropertyInfo = IsPrinter
    type AttrSetTypeConstraint PrinterJobCountPropertyInfo = (~) ()
    type AttrTransferTypeConstraint PrinterJobCountPropertyInfo = (~) ()
    type AttrTransferType PrinterJobCountPropertyInfo = ()
    type AttrGetType PrinterJobCountPropertyInfo = Int32
    type AttrLabel PrinterJobCountPropertyInfo = "job-count"
    type AttrOrigin PrinterJobCountPropertyInfo = Printer
    attrGet = getPrinterJobCount
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Printer.jobCount"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Printer.html#g:attr:jobCount"
        })
#endif

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

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

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPrinterName :: (IsPrinter o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructPrinterName :: forall o (m :: * -> *).
(IsPrinter o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructPrinterName 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
"name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

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

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

-- | Get the value of the “@paused@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' printer #paused
-- @
getPrinterPaused :: (MonadIO m, IsPrinter o) => o -> m Bool
getPrinterPaused :: forall (m :: * -> *) o. (MonadIO m, IsPrinter o) => o -> m Bool
getPrinterPaused 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
"paused"

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

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

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

#if defined(ENABLE_OVERLOADING)
data PrinterStateMessagePropertyInfo
instance AttrInfo PrinterStateMessagePropertyInfo where
    type AttrAllowedOps PrinterStateMessagePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PrinterStateMessagePropertyInfo = IsPrinter
    type AttrSetTypeConstraint PrinterStateMessagePropertyInfo = (~) ()
    type AttrTransferTypeConstraint PrinterStateMessagePropertyInfo = (~) ()
    type AttrTransferType PrinterStateMessagePropertyInfo = ()
    type AttrGetType PrinterStateMessagePropertyInfo = T.Text
    type AttrLabel PrinterStateMessagePropertyInfo = "state-message"
    type AttrOrigin PrinterStateMessagePropertyInfo = Printer
    attrGet = getPrinterStateMessage
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Printer.stateMessage"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Printer.html#g:attr:stateMessage"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Printer
type instance O.AttributeList Printer = PrinterAttributeList
type PrinterAttributeList = ('[ '("acceptingJobs", PrinterAcceptingJobsPropertyInfo), '("acceptsPdf", PrinterAcceptsPdfPropertyInfo), '("acceptsPs", PrinterAcceptsPsPropertyInfo), '("iconName", PrinterIconNamePropertyInfo), '("isVirtual", PrinterIsVirtualPropertyInfo), '("jobCount", PrinterJobCountPropertyInfo), '("location", PrinterLocationPropertyInfo), '("name", PrinterNamePropertyInfo), '("paused", PrinterPausedPropertyInfo), '("stateMessage", PrinterStateMessagePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
printerAcceptingJobs :: AttrLabelProxy "acceptingJobs"
printerAcceptingJobs = AttrLabelProxy

printerIconName :: AttrLabelProxy "iconName"
printerIconName = AttrLabelProxy

printerJobCount :: AttrLabelProxy "jobCount"
printerJobCount = AttrLabelProxy

printerLocation :: AttrLabelProxy "location"
printerLocation = AttrLabelProxy

printerName :: AttrLabelProxy "name"
printerName = AttrLabelProxy

printerPaused :: AttrLabelProxy "paused"
printerPaused = AttrLabelProxy

printerStateMessage :: AttrLabelProxy "stateMessage"
printerStateMessage = AttrLabelProxy

#endif

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

#endif

-- method Printer::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the printer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "backend"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PrintBackend" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPrintBackend`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "virtual_"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether the printer is virtual"
--                 , 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_printer_new" gtk_printer_new :: 
    CString ->                              -- name : TBasicType TUTF8
    Ptr Gtk.PrintBackend.PrintBackend ->    -- backend : TInterface (Name {namespace = "Gtk", name = "PrintBackend"})
    CInt ->                                 -- virtual_ : TBasicType TBoolean
    IO (Ptr Printer)

-- | Creates a new @GtkPrinter@.
printerNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: the name of the printer
    -> Gtk.PrintBackend.PrintBackend
    -- ^ /@backend@/: a @GtkPrintBackend@
    -> Bool
    -- ^ /@virtual_@/: whether the printer is virtual
    -> m Printer
    -- ^ __Returns:__ a new @GtkPrinter@
printerNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> PrintBackend -> Bool -> m Printer
printerNew Text
name PrintBackend
backend Bool
virtual_ = 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
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr PrintBackend
backend' <- PrintBackend -> IO (Ptr PrintBackend)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PrintBackend
backend
    let virtual_' :: CInt
virtual_' = (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
virtual_
    Ptr Printer
result <- CString -> Ptr PrintBackend -> CInt -> IO (Ptr Printer)
gtk_printer_new CString
name' Ptr PrintBackend
backend' CInt
virtual_'
    Text -> Ptr Printer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printerNew" 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
wrapObject ManagedPtr Printer -> Printer
Printer) Ptr Printer
result
    PrintBackend -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PrintBackend
backend
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Printer -> IO Printer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Printer
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Printer::accepts_pdf
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_accepts_pdf" gtk_printer_accepts_pdf :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CInt

-- | Returns whether the printer accepts input in
-- PDF format.
printerAcceptsPdf ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@printer@/ accepts PDF
printerAcceptsPdf :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Bool
printerAcceptsPdf a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CInt
result <- Ptr Printer -> IO CInt
gtk_printer_accepts_pdf Ptr Printer
printer'
    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
printer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PrinterAcceptsPdfMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterAcceptsPdfMethodInfo a signature where
    overloadedMethod = printerAcceptsPdf

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


#endif

-- method Printer::accepts_ps
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_accepts_ps" gtk_printer_accepts_ps :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CInt

-- | Returns whether the printer accepts input in
-- PostScript format.
printerAcceptsPs ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@printer@/ accepts PostScript
printerAcceptsPs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Bool
printerAcceptsPs a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CInt
result <- Ptr Printer -> IO CInt
gtk_printer_accepts_ps Ptr Printer
printer'
    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
printer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PrinterAcceptsPsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterAcceptsPsMethodInfo a signature where
    overloadedMethod = printerAcceptsPs

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


#endif

-- method Printer::compare
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , 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 = "b"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Printer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another `GtkPrinter`"
--                 , 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_printer_compare" gtk_printer_compare :: 
    Ptr Printer ->                          -- a : TInterface (Name {namespace = "Gtk", name = "Printer"})
    Ptr Printer ->                          -- b : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO Int32

-- | Compares two printers.
printerCompare ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a, IsPrinter b) =>
    a
    -- ^ /@a@/: a @GtkPrinter@
    -> b
    -- ^ /@b@/: another @GtkPrinter@
    -> m Int32
    -- ^ __Returns:__ 0 if the printer match, a negative value if /@a@/ \< /@b@/,
    --   or a positive value if /@a@/ > /@b@/
printerCompare :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPrinter a, IsPrinter b) =>
a -> b -> m Int32
printerCompare a
a b
b = 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 Printer
a' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
a
    Ptr Printer
b' <- b -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
b
    Int32
result <- Ptr Printer -> Ptr Printer -> IO Int32
gtk_printer_compare Ptr Printer
a' Ptr Printer
b'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
a
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
b
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data PrinterCompareMethodInfo
instance (signature ~ (b -> m Int32), MonadIO m, IsPrinter a, IsPrinter b) => O.OverloadedMethod PrinterCompareMethodInfo a signature where
    overloadedMethod = printerCompare

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


#endif

-- method Printer::get_backend
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "PrintBackend" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_get_backend" gtk_printer_get_backend :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO (Ptr Gtk.PrintBackend.PrintBackend)

-- | Returns the backend of the printer.
printerGetBackend ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m Gtk.PrintBackend.PrintBackend
    -- ^ __Returns:__ the backend of /@printer@/
printerGetBackend :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m PrintBackend
printerGetBackend a
printer = IO PrintBackend -> m PrintBackend
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PrintBackend -> m PrintBackend)
-> IO PrintBackend -> m PrintBackend
forall a b. (a -> b) -> a -> b
$ do
    Ptr Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    Ptr PrintBackend
result <- Ptr Printer -> IO (Ptr PrintBackend)
gtk_printer_get_backend Ptr Printer
printer'
    Text -> Ptr PrintBackend -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printerGetBackend" Ptr PrintBackend
result
    PrintBackend
result' <- ((ManagedPtr PrintBackend -> PrintBackend)
-> Ptr PrintBackend -> IO PrintBackend
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr PrintBackend -> PrintBackend
Gtk.PrintBackend.PrintBackend) Ptr PrintBackend
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    PrintBackend -> IO PrintBackend
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PrintBackend
result'

#if defined(ENABLE_OVERLOADING)
data PrinterGetBackendMethodInfo
instance (signature ~ (m Gtk.PrintBackend.PrintBackend), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterGetBackendMethodInfo a signature where
    overloadedMethod = printerGetBackend

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


#endif

-- method Printer::get_capabilities
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gtk" , name = "PrintCapabilities" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_get_capabilities" gtk_printer_get_capabilities :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CUInt

-- | Returns the printer’s capabilities.
-- 
-- This is useful when you’re using @GtkPrintUnixDialog@’s
-- manual-capabilities setting and need to know which settings
-- the printer can handle and which you must handle yourself.
-- 
-- This will return 0 unless the printer’s details are
-- available, see 'GI.Gtk.Objects.Printer.printerHasDetails' and
-- 'GI.Gtk.Objects.Printer.printerRequestDetails'.
printerGetCapabilities ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m [Gtk.Flags.PrintCapabilities]
    -- ^ __Returns:__ the printer’s capabilities
printerGetCapabilities :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m [PrintCapabilities]
printerGetCapabilities a
printer = IO [PrintCapabilities] -> m [PrintCapabilities]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [PrintCapabilities] -> m [PrintCapabilities])
-> IO [PrintCapabilities] -> m [PrintCapabilities]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CUInt
result <- Ptr Printer -> IO CUInt
gtk_printer_get_capabilities Ptr Printer
printer'
    let result' :: [PrintCapabilities]
result' = CUInt -> [PrintCapabilities]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    [PrintCapabilities] -> IO [PrintCapabilities]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PrintCapabilities]
result'

#if defined(ENABLE_OVERLOADING)
data PrinterGetCapabilitiesMethodInfo
instance (signature ~ (m [Gtk.Flags.PrintCapabilities]), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterGetCapabilitiesMethodInfo a signature where
    overloadedMethod = printerGetCapabilities

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


#endif

-- method Printer::get_default_page_size
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "PageSetup" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_get_default_page_size" gtk_printer_get_default_page_size :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO (Ptr Gtk.PageSetup.PageSetup)

-- | Returns default page size of /@printer@/.
printerGetDefaultPageSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m Gtk.PageSetup.PageSetup
    -- ^ __Returns:__ a newly allocated @GtkPageSetup@ with default page size
    --   of the printer.
printerGetDefaultPageSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m PageSetup
printerGetDefaultPageSize a
printer = IO PageSetup -> m PageSetup
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PageSetup -> m PageSetup) -> IO PageSetup -> m PageSetup
forall a b. (a -> b) -> a -> b
$ do
    Ptr Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    Ptr PageSetup
result <- Ptr Printer -> IO (Ptr PageSetup)
gtk_printer_get_default_page_size Ptr Printer
printer'
    Text -> Ptr PageSetup -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printerGetDefaultPageSize" Ptr PageSetup
result
    PageSetup
result' <- ((ManagedPtr PageSetup -> PageSetup)
-> Ptr PageSetup -> IO PageSetup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PageSetup -> PageSetup
Gtk.PageSetup.PageSetup) Ptr PageSetup
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    PageSetup -> IO PageSetup
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PageSetup
result'

#if defined(ENABLE_OVERLOADING)
data PrinterGetDefaultPageSizeMethodInfo
instance (signature ~ (m Gtk.PageSetup.PageSetup), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterGetDefaultPageSizeMethodInfo a signature where
    overloadedMethod = printerGetDefaultPageSize

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


#endif

-- method Printer::get_description
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_get_description" gtk_printer_get_description :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CString

-- | Gets the description of the printer.
printerGetDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m T.Text
    -- ^ __Returns:__ the description of /@printer@/
printerGetDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Text
printerGetDescription a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CString
result <- Ptr Printer -> IO CString
gtk_printer_get_description Ptr Printer
printer'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printerGetDescription" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PrinterGetDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterGetDescriptionMethodInfo a signature where
    overloadedMethod = printerGetDescription

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


#endif

-- method Printer::get_hard_margins
-- method type : OrdinaryMethod
-- Args: [ 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 = "top"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the top margin in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "bottom"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the bottom margin in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "left"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the left margin in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "right"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the right margin in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_get_hard_margins" gtk_printer_get_hard_margins :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    Ptr CDouble ->                          -- top : TBasicType TDouble
    Ptr CDouble ->                          -- bottom : TBasicType TDouble
    Ptr CDouble ->                          -- left : TBasicType TDouble
    Ptr CDouble ->                          -- right : TBasicType TDouble
    IO CInt

-- | Retrieve the hard margins of /@printer@/.
-- 
-- These are the margins that define the area at the borders
-- of the paper that the printer cannot print to.
-- 
-- Note: This will not succeed unless the printer’s details are
-- available, see 'GI.Gtk.Objects.Printer.printerHasDetails' and
-- 'GI.Gtk.Objects.Printer.printerRequestDetails'.
printerGetHardMargins ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m ((Bool, Double, Double, Double, Double))
    -- ^ __Returns:__ 'P.True' iff the hard margins were retrieved
printerGetHardMargins :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m (Bool, Double, Double, Double, Double)
printerGetHardMargins a
printer = IO (Bool, Double, Double, Double, Double)
-> m (Bool, Double, Double, Double, Double)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double, Double, Double, Double)
 -> m (Bool, Double, Double, Double, Double))
-> IO (Bool, Double, Double, Double, Double)
-> m (Bool, Double, Double, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    Ptr CDouble
top <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
bottom <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
left <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
right <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Printer
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> IO CInt
gtk_printer_get_hard_margins Ptr Printer
printer' Ptr CDouble
top Ptr CDouble
bottom Ptr CDouble
left Ptr CDouble
right
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
top' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
top
    let top'' :: Double
top'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
top'
    CDouble
bottom' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
bottom
    let bottom'' :: Double
bottom'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
bottom'
    CDouble
left' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
left
    let left'' :: Double
left'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
left'
    CDouble
right' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
right
    let right'' :: Double
right'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
right'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
top
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
bottom
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
left
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
right
    (Bool, Double, Double, Double, Double)
-> IO (Bool, Double, Double, Double, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
top'', Double
bottom'', Double
left'', Double
right'')

#if defined(ENABLE_OVERLOADING)
data PrinterGetHardMarginsMethodInfo
instance (signature ~ (m ((Bool, Double, Double, Double, Double))), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterGetHardMarginsMethodInfo a signature where
    overloadedMethod = printerGetHardMargins

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


#endif

-- method Printer::get_hard_margins_for_paper_size
-- method type : OrdinaryMethod
-- Args: [ 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 = "paper_size"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PaperSize" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkPaperSize`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "top"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the top margin in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "bottom"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the bottom margin in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "left"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the left margin in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "right"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the right margin in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_get_hard_margins_for_paper_size" gtk_printer_get_hard_margins_for_paper_size :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    Ptr Gtk.PaperSize.PaperSize ->          -- paper_size : TInterface (Name {namespace = "Gtk", name = "PaperSize"})
    Ptr CDouble ->                          -- top : TBasicType TDouble
    Ptr CDouble ->                          -- bottom : TBasicType TDouble
    Ptr CDouble ->                          -- left : TBasicType TDouble
    Ptr CDouble ->                          -- right : TBasicType TDouble
    IO CInt

-- | Retrieve the hard margins of /@printer@/ for /@paperSize@/.
-- 
-- These are the margins that define the area at the borders
-- of the paper that the printer cannot print to.
-- 
-- Note: This will not succeed unless the printer’s details are
-- available, see 'GI.Gtk.Objects.Printer.printerHasDetails' and
-- 'GI.Gtk.Objects.Printer.printerRequestDetails'.
printerGetHardMarginsForPaperSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> Gtk.PaperSize.PaperSize
    -- ^ /@paperSize@/: a @GtkPaperSize@
    -> m ((Bool, Double, Double, Double, Double))
    -- ^ __Returns:__ 'P.True' iff the hard margins were retrieved
printerGetHardMarginsForPaperSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> PaperSize -> m (Bool, Double, Double, Double, Double)
printerGetHardMarginsForPaperSize a
printer PaperSize
paperSize = IO (Bool, Double, Double, Double, Double)
-> m (Bool, Double, Double, Double, Double)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double, Double, Double, Double)
 -> m (Bool, Double, Double, Double, Double))
-> IO (Bool, Double, Double, Double, Double)
-> m (Bool, Double, Double, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    Ptr PaperSize
paperSize' <- PaperSize -> IO (Ptr PaperSize)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PaperSize
paperSize
    Ptr CDouble
top <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
bottom <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
left <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
right <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Printer
-> Ptr PaperSize
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> Ptr CDouble
-> IO CInt
gtk_printer_get_hard_margins_for_paper_size Ptr Printer
printer' Ptr PaperSize
paperSize' Ptr CDouble
top Ptr CDouble
bottom Ptr CDouble
left Ptr CDouble
right
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
top' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
top
    let top'' :: Double
top'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
top'
    CDouble
bottom' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
bottom
    let bottom'' :: Double
bottom'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
bottom'
    CDouble
left' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
left
    let left'' :: Double
left'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
left'
    CDouble
right' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
right
    let right'' :: Double
right'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
right'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    PaperSize -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PaperSize
paperSize
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
top
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
bottom
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
left
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
right
    (Bool, Double, Double, Double, Double)
-> IO (Bool, Double, Double, Double, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
top'', Double
bottom'', Double
left'', Double
right'')

#if defined(ENABLE_OVERLOADING)
data PrinterGetHardMarginsForPaperSizeMethodInfo
instance (signature ~ (Gtk.PaperSize.PaperSize -> m ((Bool, Double, Double, Double, Double))), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterGetHardMarginsForPaperSizeMethodInfo a signature where
    overloadedMethod = printerGetHardMarginsForPaperSize

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


#endif

-- method Printer::get_icon_name
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_get_icon_name" gtk_printer_get_icon_name :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CString

-- | Gets the name of the icon to use for the printer.
printerGetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m T.Text
    -- ^ __Returns:__ the icon name for /@printer@/
printerGetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Text
printerGetIconName a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CString
result <- Ptr Printer -> IO CString
gtk_printer_get_icon_name Ptr Printer
printer'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printerGetIconName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PrinterGetIconNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterGetIconNameMethodInfo a signature where
    overloadedMethod = printerGetIconName

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


#endif

-- method Printer::get_job_count
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_get_job_count" gtk_printer_get_job_count :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO Int32

-- | Gets the number of jobs currently queued on the printer.
printerGetJobCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m Int32
    -- ^ __Returns:__ the number of jobs on /@printer@/
printerGetJobCount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Int32
printerGetJobCount a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    Int32
result <- Ptr Printer -> IO Int32
gtk_printer_get_job_count Ptr Printer
printer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data PrinterGetJobCountMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterGetJobCountMethodInfo a signature where
    overloadedMethod = printerGetJobCount

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


#endif

-- method Printer::get_location
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_get_location" gtk_printer_get_location :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CString

-- | Returns a description of the location of the printer.
printerGetLocation ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m T.Text
    -- ^ __Returns:__ the location of /@printer@/
printerGetLocation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Text
printerGetLocation a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CString
result <- Ptr Printer -> IO CString
gtk_printer_get_location Ptr Printer
printer'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printerGetLocation" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PrinterGetLocationMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterGetLocationMethodInfo a signature where
    overloadedMethod = printerGetLocation

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


#endif

-- method Printer::get_name
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_get_name" gtk_printer_get_name :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CString

-- | Returns the name of the printer.
printerGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m T.Text
    -- ^ __Returns:__ the name of /@printer@/
printerGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Text
printerGetName a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CString
result <- Ptr Printer -> IO CString
gtk_printer_get_name Ptr Printer
printer'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printerGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PrinterGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterGetNameMethodInfo a signature where
    overloadedMethod = printerGetName

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


#endif

-- method Printer::get_state_message
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_get_state_message" gtk_printer_get_state_message :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CString

-- | Returns the state message describing the current state
-- of the printer.
printerGetStateMessage ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m T.Text
    -- ^ __Returns:__ the state message of /@printer@/
printerGetStateMessage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Text
printerGetStateMessage a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CString
result <- Ptr Printer -> IO CString
gtk_printer_get_state_message Ptr Printer
printer'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printerGetStateMessage" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PrinterGetStateMessageMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterGetStateMessageMethodInfo a signature where
    overloadedMethod = printerGetStateMessage

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


#endif

-- method Printer::has_details
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_has_details" gtk_printer_has_details :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CInt

-- | Returns whether the printer details are available.
printerHasDetails ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@printer@/ details are available
printerHasDetails :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Bool
printerHasDetails a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CInt
result <- Ptr Printer -> IO CInt
gtk_printer_has_details Ptr Printer
printer'
    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
printer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PrinterHasDetailsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterHasDetailsMethodInfo a signature where
    overloadedMethod = printerHasDetails

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


#endif

-- method Printer::is_accepting_jobs
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_is_accepting_jobs" gtk_printer_is_accepting_jobs :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CInt

-- | Returns whether the printer is accepting jobs
printerIsAcceptingJobs ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@printer@/ is accepting jobs
printerIsAcceptingJobs :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Bool
printerIsAcceptingJobs a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CInt
result <- Ptr Printer -> IO CInt
gtk_printer_is_accepting_jobs Ptr Printer
printer'
    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
printer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PrinterIsAcceptingJobsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterIsAcceptingJobsMethodInfo a signature where
    overloadedMethod = printerIsAcceptingJobs

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


#endif

-- method Printer::is_active
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_is_active" gtk_printer_is_active :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CInt

-- | Returns whether the printer is currently active (i.e.
-- accepts new jobs).
printerIsActive ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@printer@/ is active
printerIsActive :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Bool
printerIsActive a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CInt
result <- Ptr Printer -> IO CInt
gtk_printer_is_active Ptr Printer
printer'
    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
printer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PrinterIsActiveMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterIsActiveMethodInfo a signature where
    overloadedMethod = printerIsActive

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


#endif

-- method Printer::is_default
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_is_default" gtk_printer_is_default :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CInt

-- | Returns whether the printer is the default printer.
printerIsDefault ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@printer@/ is the default
printerIsDefault :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Bool
printerIsDefault a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CInt
result <- Ptr Printer -> IO CInt
gtk_printer_is_default Ptr Printer
printer'
    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
printer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PrinterIsDefaultMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterIsDefaultMethodInfo a signature where
    overloadedMethod = printerIsDefault

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


#endif

-- method Printer::is_paused
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_is_paused" gtk_printer_is_paused :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CInt

-- | Returns whether the printer is currently paused.
-- 
-- A paused printer still accepts jobs, but it is not
-- printing them.
printerIsPaused ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@printer@/ is paused
printerIsPaused :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Bool
printerIsPaused a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CInt
result <- Ptr Printer -> IO CInt
gtk_printer_is_paused Ptr Printer
printer'
    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
printer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PrinterIsPausedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterIsPausedMethodInfo a signature where
    overloadedMethod = printerIsPaused

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


#endif

-- method Printer::is_virtual
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_is_virtual" gtk_printer_is_virtual :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO CInt

-- | Returns whether the printer is virtual (i.e. does not
-- represent actual printer hardware, but something like
-- a CUPS class).
printerIsVirtual ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@printer@/ is virtual
printerIsVirtual :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m Bool
printerIsVirtual a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    CInt
result <- Ptr Printer -> IO CInt
gtk_printer_is_virtual Ptr Printer
printer'
    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
printer
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PrinterIsVirtualMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterIsVirtualMethodInfo a signature where
    overloadedMethod = printerIsVirtual

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


#endif

-- method Printer::list_papers
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "Gtk" , name = "PageSetup" }))
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_list_papers" gtk_printer_list_papers :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO (Ptr (GList (Ptr Gtk.PageSetup.PageSetup)))

-- | Lists all the paper sizes /@printer@/ supports.
-- 
-- This will return and empty list unless the printer’s details
-- are available, see 'GI.Gtk.Objects.Printer.printerHasDetails' and
-- 'GI.Gtk.Objects.Printer.printerRequestDetails'.
printerListPapers ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m [Gtk.PageSetup.PageSetup]
    -- ^ __Returns:__ a newly
    --   allocated list of newly allocated @GtkPageSetup@s.
printerListPapers :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m [PageSetup]
printerListPapers a
printer = IO [PageSetup] -> m [PageSetup]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [PageSetup] -> m [PageSetup])
-> IO [PageSetup] -> m [PageSetup]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    Ptr (GList (Ptr PageSetup))
result <- Ptr Printer -> IO (Ptr (GList (Ptr PageSetup)))
gtk_printer_list_papers Ptr Printer
printer'
    [Ptr PageSetup]
result' <- Ptr (GList (Ptr PageSetup)) -> IO [Ptr PageSetup]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr PageSetup))
result
    [PageSetup]
result'' <- (Ptr PageSetup -> IO PageSetup)
-> [Ptr PageSetup] -> IO [PageSetup]
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 PageSetup -> PageSetup)
-> Ptr PageSetup -> IO PageSetup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PageSetup -> PageSetup
Gtk.PageSetup.PageSetup) [Ptr PageSetup]
result'
    Ptr (GList (Ptr PageSetup)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr PageSetup))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    [PageSetup] -> IO [PageSetup]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PageSetup]
result''

#if defined(ENABLE_OVERLOADING)
data PrinterListPapersMethodInfo
instance (signature ~ (m [Gtk.PageSetup.PageSetup]), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterListPapersMethodInfo a signature where
    overloadedMethod = printerListPapers

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


#endif

-- method Printer::request_details
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_printer_request_details" gtk_printer_request_details :: 
    Ptr Printer ->                          -- printer : TInterface (Name {namespace = "Gtk", name = "Printer"})
    IO ()

-- | Requests the printer details.
-- 
-- When the details are available, the
-- [Printer::detailsAcquired]("GI.Gtk.Objects.Printer#g:signal:detailsAcquired") signal
-- will be emitted on /@printer@/.
printerRequestDetails ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrinter a) =>
    a
    -- ^ /@printer@/: a @GtkPrinter@
    -> m ()
printerRequestDetails :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrinter a) =>
a -> m ()
printerRequestDetails a
printer = 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 Printer
printer' <- a -> IO (Ptr Printer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printer
    Ptr Printer -> IO ()
gtk_printer_request_details Ptr Printer
printer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PrinterRequestDetailsMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPrinter a) => O.OverloadedMethod PrinterRequestDetailsMethodInfo a signature where
    overloadedMethod = printerRequestDetails

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


#endif