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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Allows to embed a custom widget in print dialog.
-- 
-- A WebKitPrintCustomWidget allows to embed a custom widget in the print
-- dialog by connecting to the [PrintOperation::createCustomWidget]("GI.WebKit2.Objects.PrintOperation#g:signal:createCustomWidget")
-- signal, creating a new WebKitPrintCustomWidget with
-- 'GI.WebKit2.Objects.PrintCustomWidget.printCustomWidgetNew' and returning it from there. You can later
-- use 'GI.WebKit2.Objects.PrintOperation.printOperationRunDialog' to display the dialog.
-- 
-- /Since: 2.16/

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

module GI.WebKit2.Objects.PrintCustomWidget
    ( 

-- * Exported types
    PrintCustomWidget(..)                   ,
    IsPrintCustomWidget                     ,
    toPrintCustomWidget                     ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTitle]("GI.WebKit2.Objects.PrintCustomWidget#g:method:getTitle"), [getWidget]("GI.WebKit2.Objects.PrintCustomWidget#g:method:getWidget").
-- 
-- ==== 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)
    ResolvePrintCustomWidgetMethod          ,
#endif

-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    PrintCustomWidgetGetTitleMethodInfo     ,
#endif
    printCustomWidgetGetTitle               ,


-- ** getWidget #method:getWidget#

#if defined(ENABLE_OVERLOADING)
    PrintCustomWidgetGetWidgetMethodInfo    ,
#endif
    printCustomWidgetGetWidget              ,


-- ** new #method:new#

    printCustomWidgetNew                    ,




 -- * Properties


-- ** title #attr:title#
-- | The title of the custom widget.
-- 
-- /Since: 2.16/

#if defined(ENABLE_OVERLOADING)
    PrintCustomWidgetTitlePropertyInfo      ,
#endif
    constructPrintCustomWidgetTitle         ,
    getPrintCustomWidgetTitle               ,
#if defined(ENABLE_OVERLOADING)
    printCustomWidgetTitle                  ,
#endif


-- ** widget #attr:widget#
-- | The custom t'GI.Gtk.Objects.Widget.Widget' that will be embedded in the dialog.
-- 
-- /Since: 2.16/

#if defined(ENABLE_OVERLOADING)
    PrintCustomWidgetWidgetPropertyInfo     ,
#endif
    constructPrintCustomWidgetWidget        ,
    getPrintCustomWidgetWidget              ,
#if defined(ENABLE_OVERLOADING)
    printCustomWidgetWidget                 ,
#endif




 -- * Signals


-- ** apply #signal:apply#

    PrintCustomWidgetApplyCallback          ,
#if defined(ENABLE_OVERLOADING)
    PrintCustomWidgetApplySignalInfo        ,
#endif
    afterPrintCustomWidgetApply             ,
    onPrintCustomWidgetApply                ,


-- ** update #signal:update#

    PrintCustomWidgetUpdateCallback         ,
#if defined(ENABLE_OVERLOADING)
    PrintCustomWidgetUpdateSignalInfo       ,
#endif
    afterPrintCustomWidgetUpdate            ,
    onPrintCustomWidgetUpdate               ,




    ) 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.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 qualified GI.Gtk.Objects.PageSetup as Gtk.PageSetup
import qualified GI.Gtk.Objects.PrintSettings as Gtk.PrintSettings
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

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

foreign import ccall "webkit_print_custom_widget_get_type"
    c_webkit_print_custom_widget_get_type :: IO B.Types.GType

instance B.Types.TypedObject PrintCustomWidget where
    glibType :: IO GType
glibType = IO GType
c_webkit_print_custom_widget_get_type

instance B.Types.GObject PrintCustomWidget

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

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

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

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

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

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

#endif

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

#endif

-- signal PrintCustomWidget::apply
-- | Emitted right before the printing will start. You should read the information
-- from the widget and update the content based on it if necessary. The widget
-- is not guaranteed to be valid at a later time.
-- 
-- /Since: 2.16/
type PrintCustomWidgetApplyCallback =
    IO ()

type C_PrintCustomWidgetApplyCallback =
    Ptr PrintCustomWidget ->                -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PrintCustomWidgetApplyCallback :: 
    GObject a => (a -> PrintCustomWidgetApplyCallback) ->
    C_PrintCustomWidgetApplyCallback
wrap_PrintCustomWidgetApplyCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PrintCustomWidgetApplyCallback
wrap_PrintCustomWidgetApplyCallback a -> IO ()
gi'cb Ptr PrintCustomWidget
gi'selfPtr Ptr ()
_ = do
    Ptr PrintCustomWidget -> (PrintCustomWidget -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PrintCustomWidget
gi'selfPtr ((PrintCustomWidget -> IO ()) -> IO ())
-> (PrintCustomWidget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PrintCustomWidget
gi'self -> a -> IO ()
gi'cb (PrintCustomWidget -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PrintCustomWidget
gi'self) 


-- | Connect a signal handler for the [apply](#signal:apply) 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' printCustomWidget #apply callback
-- @
-- 
-- 
onPrintCustomWidgetApply :: (IsPrintCustomWidget a, MonadIO m) => a -> ((?self :: a) => PrintCustomWidgetApplyCallback) -> m SignalHandlerId
onPrintCustomWidgetApply :: forall a (m :: * -> *).
(IsPrintCustomWidget a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPrintCustomWidgetApply a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PrintCustomWidgetApplyCallback
wrapped' = (a -> IO ()) -> C_PrintCustomWidgetApplyCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PrintCustomWidgetApplyCallback
wrap_PrintCustomWidgetApplyCallback a -> IO ()
wrapped
    FunPtr C_PrintCustomWidgetApplyCallback
wrapped'' <- C_PrintCustomWidgetApplyCallback
-> IO (FunPtr C_PrintCustomWidgetApplyCallback)
mk_PrintCustomWidgetApplyCallback C_PrintCustomWidgetApplyCallback
wrapped'
    a
-> Text
-> FunPtr C_PrintCustomWidgetApplyCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"apply" FunPtr C_PrintCustomWidgetApplyCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [apply](#signal:apply) 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' printCustomWidget #apply 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.
-- 
afterPrintCustomWidgetApply :: (IsPrintCustomWidget a, MonadIO m) => a -> ((?self :: a) => PrintCustomWidgetApplyCallback) -> m SignalHandlerId
afterPrintCustomWidgetApply :: forall a (m :: * -> *).
(IsPrintCustomWidget a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPrintCustomWidgetApply a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PrintCustomWidgetApplyCallback
wrapped' = (a -> IO ()) -> C_PrintCustomWidgetApplyCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PrintCustomWidgetApplyCallback
wrap_PrintCustomWidgetApplyCallback a -> IO ()
wrapped
    FunPtr C_PrintCustomWidgetApplyCallback
wrapped'' <- C_PrintCustomWidgetApplyCallback
-> IO (FunPtr C_PrintCustomWidgetApplyCallback)
mk_PrintCustomWidgetApplyCallback C_PrintCustomWidgetApplyCallback
wrapped'
    a
-> Text
-> FunPtr C_PrintCustomWidgetApplyCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"apply" FunPtr C_PrintCustomWidgetApplyCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PrintCustomWidgetApplySignalInfo
instance SignalInfo PrintCustomWidgetApplySignalInfo where
    type HaskellCallbackType PrintCustomWidgetApplySignalInfo = PrintCustomWidgetApplyCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PrintCustomWidgetApplyCallback cb
        cb'' <- mk_PrintCustomWidgetApplyCallback cb'
        connectSignalFunPtr obj "apply" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.PrintCustomWidget::apply"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.29/docs/GI-WebKit2-Objects-PrintCustomWidget.html#g:signal:apply"})

#endif

-- signal PrintCustomWidget::update
-- | Emitted after change of selected printer in the dialog. The actual page setup
-- and print settings are available and the custom widget can actualize itself
-- according to their values.
-- 
-- /Since: 2.16/
type PrintCustomWidgetUpdateCallback =
    Gtk.PageSetup.PageSetup
    -- ^ /@pageSetup@/: actual page setup
    -> Gtk.PrintSettings.PrintSettings
    -- ^ /@printSettings@/: actual print settings
    -> IO ()

type C_PrintCustomWidgetUpdateCallback =
    Ptr PrintCustomWidget ->                -- object
    Ptr Gtk.PageSetup.PageSetup ->
    Ptr Gtk.PrintSettings.PrintSettings ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PrintCustomWidgetUpdateCallback :: 
    GObject a => (a -> PrintCustomWidgetUpdateCallback) ->
    C_PrintCustomWidgetUpdateCallback
wrap_PrintCustomWidgetUpdateCallback :: forall a.
GObject a =>
(a -> PrintCustomWidgetUpdateCallback)
-> C_PrintCustomWidgetUpdateCallback
wrap_PrintCustomWidgetUpdateCallback a -> PrintCustomWidgetUpdateCallback
gi'cb Ptr PrintCustomWidget
gi'selfPtr Ptr PageSetup
pageSetup Ptr PrintSettings
printSettings Ptr ()
_ = do
    PageSetup
pageSetup' <- ((ManagedPtr PageSetup -> PageSetup)
-> Ptr PageSetup -> IO PageSetup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PageSetup -> PageSetup
Gtk.PageSetup.PageSetup) Ptr PageSetup
pageSetup
    PrintSettings
printSettings' <- ((ManagedPtr PrintSettings -> PrintSettings)
-> Ptr PrintSettings -> IO PrintSettings
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PrintSettings -> PrintSettings
Gtk.PrintSettings.PrintSettings) Ptr PrintSettings
printSettings
    Ptr PrintCustomWidget -> (PrintCustomWidget -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PrintCustomWidget
gi'selfPtr ((PrintCustomWidget -> IO ()) -> IO ())
-> (PrintCustomWidget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PrintCustomWidget
gi'self -> a -> PrintCustomWidgetUpdateCallback
gi'cb (PrintCustomWidget -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PrintCustomWidget
gi'self)  PageSetup
pageSetup' PrintSettings
printSettings'


-- | Connect a signal handler for the [update](#signal:update) 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' printCustomWidget #update callback
-- @
-- 
-- 
onPrintCustomWidgetUpdate :: (IsPrintCustomWidget a, MonadIO m) => a -> ((?self :: a) => PrintCustomWidgetUpdateCallback) -> m SignalHandlerId
onPrintCustomWidgetUpdate :: forall a (m :: * -> *).
(IsPrintCustomWidget a, MonadIO m) =>
a
-> ((?self::a) => PrintCustomWidgetUpdateCallback)
-> m SignalHandlerId
onPrintCustomWidgetUpdate a
obj (?self::a) => PrintCustomWidgetUpdateCallback
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 -> PrintCustomWidgetUpdateCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PrintCustomWidgetUpdateCallback
PrintCustomWidgetUpdateCallback
cb
    let wrapped' :: C_PrintCustomWidgetUpdateCallback
wrapped' = (a -> PrintCustomWidgetUpdateCallback)
-> C_PrintCustomWidgetUpdateCallback
forall a.
GObject a =>
(a -> PrintCustomWidgetUpdateCallback)
-> C_PrintCustomWidgetUpdateCallback
wrap_PrintCustomWidgetUpdateCallback a -> PrintCustomWidgetUpdateCallback
wrapped
    FunPtr C_PrintCustomWidgetUpdateCallback
wrapped'' <- C_PrintCustomWidgetUpdateCallback
-> IO (FunPtr C_PrintCustomWidgetUpdateCallback)
mk_PrintCustomWidgetUpdateCallback C_PrintCustomWidgetUpdateCallback
wrapped'
    a
-> Text
-> FunPtr C_PrintCustomWidgetUpdateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"update" FunPtr C_PrintCustomWidgetUpdateCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [update](#signal:update) 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' printCustomWidget #update 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.
-- 
afterPrintCustomWidgetUpdate :: (IsPrintCustomWidget a, MonadIO m) => a -> ((?self :: a) => PrintCustomWidgetUpdateCallback) -> m SignalHandlerId
afterPrintCustomWidgetUpdate :: forall a (m :: * -> *).
(IsPrintCustomWidget a, MonadIO m) =>
a
-> ((?self::a) => PrintCustomWidgetUpdateCallback)
-> m SignalHandlerId
afterPrintCustomWidgetUpdate a
obj (?self::a) => PrintCustomWidgetUpdateCallback
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 -> PrintCustomWidgetUpdateCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PrintCustomWidgetUpdateCallback
PrintCustomWidgetUpdateCallback
cb
    let wrapped' :: C_PrintCustomWidgetUpdateCallback
wrapped' = (a -> PrintCustomWidgetUpdateCallback)
-> C_PrintCustomWidgetUpdateCallback
forall a.
GObject a =>
(a -> PrintCustomWidgetUpdateCallback)
-> C_PrintCustomWidgetUpdateCallback
wrap_PrintCustomWidgetUpdateCallback a -> PrintCustomWidgetUpdateCallback
wrapped
    FunPtr C_PrintCustomWidgetUpdateCallback
wrapped'' <- C_PrintCustomWidgetUpdateCallback
-> IO (FunPtr C_PrintCustomWidgetUpdateCallback)
mk_PrintCustomWidgetUpdateCallback C_PrintCustomWidgetUpdateCallback
wrapped'
    a
-> Text
-> FunPtr C_PrintCustomWidgetUpdateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"update" FunPtr C_PrintCustomWidgetUpdateCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PrintCustomWidgetUpdateSignalInfo
instance SignalInfo PrintCustomWidgetUpdateSignalInfo where
    type HaskellCallbackType PrintCustomWidgetUpdateSignalInfo = PrintCustomWidgetUpdateCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PrintCustomWidgetUpdateCallback cb
        cb'' <- mk_PrintCustomWidgetUpdateCallback cb'
        connectSignalFunPtr obj "update" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.PrintCustomWidget::update"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.29/docs/GI-WebKit2-Objects-PrintCustomWidget.html#g:signal:update"})

#endif

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

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

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data PrintCustomWidgetWidgetPropertyInfo
instance AttrInfo PrintCustomWidgetWidgetPropertyInfo where
    type AttrAllowedOps PrintCustomWidgetWidgetPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PrintCustomWidgetWidgetPropertyInfo = IsPrintCustomWidget
    type AttrSetTypeConstraint PrintCustomWidgetWidgetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint PrintCustomWidgetWidgetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType PrintCustomWidgetWidgetPropertyInfo = Gtk.Widget.Widget
    type AttrGetType PrintCustomWidgetWidgetPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel PrintCustomWidgetWidgetPropertyInfo = "widget"
    type AttrOrigin PrintCustomWidgetWidgetPropertyInfo = PrintCustomWidget
    attrGet = getPrintCustomWidgetWidget
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructPrintCustomWidgetWidget
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.PrintCustomWidget.widget"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.29/docs/GI-WebKit2-Objects-PrintCustomWidget.html#g:attr:widget"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PrintCustomWidget
type instance O.AttributeList PrintCustomWidget = PrintCustomWidgetAttributeList
type PrintCustomWidgetAttributeList = ('[ '("title", PrintCustomWidgetTitlePropertyInfo), '("widget", PrintCustomWidgetWidgetPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
printCustomWidgetTitle :: AttrLabelProxy "title"
printCustomWidgetTitle = AttrLabelProxy

printCustomWidgetWidget :: AttrLabelProxy "widget"
printCustomWidgetWidget = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList PrintCustomWidget = PrintCustomWidgetSignalList
type PrintCustomWidgetSignalList = ('[ '("apply", PrintCustomWidgetApplySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("update", PrintCustomWidgetUpdateSignalInfo)] :: [(Symbol, *)])

#endif

-- method PrintCustomWidget::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkWidget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a @widget's title" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "PrintCustomWidget" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_print_custom_widget_new" webkit_print_custom_widget_new :: 
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    CString ->                              -- title : TBasicType TUTF8
    IO (Ptr PrintCustomWidget)

-- | Create a new t'GI.WebKit2.Objects.PrintCustomWidget.PrintCustomWidget' with given /@widget@/ and /@title@/.
-- 
-- The /@widget@/
-- ownership is taken and it is destroyed together with the dialog even if this
-- object could still be alive at that point. You typically want to pass a container
-- widget with multiple widgets in it.
-- 
-- /Since: 2.16/
printCustomWidgetNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.Widget.IsWidget a) =>
    a
    -- ^ /@widget@/: a t'GI.Gtk.Objects.Widget.Widget'
    -> T.Text
    -- ^ /@title@/: a /@widget@/\'s title
    -> m PrintCustomWidget
    -- ^ __Returns:__ a new t'GI.WebKit2.Objects.PrintOperation.PrintOperation'.
printCustomWidgetNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> Text -> m PrintCustomWidget
printCustomWidgetNew a
widget Text
title = IO PrintCustomWidget -> m PrintCustomWidget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PrintCustomWidget -> m PrintCustomWidget)
-> IO PrintCustomWidget -> m PrintCustomWidget
forall a b. (a -> b) -> a -> b
$ do
    Ptr Widget
widget' <- a -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
widget
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr PrintCustomWidget
result <- Ptr Widget -> CString -> IO (Ptr PrintCustomWidget)
webkit_print_custom_widget_new Ptr Widget
widget' CString
title'
    Text -> Ptr PrintCustomWidget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printCustomWidgetNew" Ptr PrintCustomWidget
result
    PrintCustomWidget
result' <- ((ManagedPtr PrintCustomWidget -> PrintCustomWidget)
-> Ptr PrintCustomWidget -> IO PrintCustomWidget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr PrintCustomWidget -> PrintCustomWidget
PrintCustomWidget) Ptr PrintCustomWidget
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
widget
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    PrintCustomWidget -> IO PrintCustomWidget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PrintCustomWidget
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method PrintCustomWidget::get_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "print_custom_widget"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "PrintCustomWidget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitPrintCustomWidget"
--                 , 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 "webkit_print_custom_widget_get_title" webkit_print_custom_widget_get_title :: 
    Ptr PrintCustomWidget ->                -- print_custom_widget : TInterface (Name {namespace = "WebKit2", name = "PrintCustomWidget"})
    IO CString

-- | Return the value of [PrintCustomWidget:title]("GI.WebKit2.Objects.PrintCustomWidget#g:attr:title") property.
-- 
-- Return the value of [PrintCustomWidget:title]("GI.WebKit2.Objects.PrintCustomWidget#g:attr:title") property for the given
-- /@printCustomWidget@/ object.
-- 
-- /Since: 2.16/
printCustomWidgetGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintCustomWidget a) =>
    a
    -- ^ /@printCustomWidget@/: a t'GI.WebKit2.Objects.PrintCustomWidget.PrintCustomWidget'
    -> m T.Text
    -- ^ __Returns:__ Title of the /@printCustomWidget@/.
printCustomWidgetGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintCustomWidget a) =>
a -> m Text
printCustomWidgetGetTitle a
printCustomWidget = 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 PrintCustomWidget
printCustomWidget' <- a -> IO (Ptr PrintCustomWidget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printCustomWidget
    CString
result <- Ptr PrintCustomWidget -> IO CString
webkit_print_custom_widget_get_title Ptr PrintCustomWidget
printCustomWidget'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"printCustomWidgetGetTitle" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printCustomWidget
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PrintCustomWidgetGetTitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPrintCustomWidget a) => O.OverloadedMethod PrintCustomWidgetGetTitleMethodInfo a signature where
    overloadedMethod = printCustomWidgetGetTitle

instance O.OverloadedMethodInfo PrintCustomWidgetGetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.PrintCustomWidget.printCustomWidgetGetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.29/docs/GI-WebKit2-Objects-PrintCustomWidget.html#v:printCustomWidgetGetTitle"
        })


#endif

-- method PrintCustomWidget::get_widget
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "print_custom_widget"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "PrintCustomWidget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitPrintCustomWidget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Widget" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_print_custom_widget_get_widget" webkit_print_custom_widget_get_widget :: 
    Ptr PrintCustomWidget ->                -- print_custom_widget : TInterface (Name {namespace = "WebKit2", name = "PrintCustomWidget"})
    IO (Ptr Gtk.Widget.Widget)

-- | Return the value of [PrintCustomWidget:widget]("GI.WebKit2.Objects.PrintCustomWidget#g:attr:widget") property.
-- 
-- Return the value of [PrintCustomWidget:widget]("GI.WebKit2.Objects.PrintCustomWidget#g:attr:widget") property for the given
-- /@printCustomWidget@/ object. The returned value will always be valid if called
-- from [PrintCustomWidget::apply]("GI.WebKit2.Objects.PrintCustomWidget#g:signal:apply") or [PrintCustomWidget::update]("GI.WebKit2.Objects.PrintCustomWidget#g:signal:update")
-- callbacks, but it will be 'P.Nothing' if called after the
-- [PrintCustomWidget::apply]("GI.WebKit2.Objects.PrintCustomWidget#g:signal:apply") signal is emitted.
-- 
-- /Since: 2.16/
printCustomWidgetGetWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsPrintCustomWidget a) =>
    a
    -- ^ /@printCustomWidget@/: a t'GI.WebKit2.Objects.PrintCustomWidget.PrintCustomWidget'
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ a t'GI.Gtk.Objects.Widget.Widget'.
printCustomWidgetGetWidget :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPrintCustomWidget a) =>
a -> m (Maybe Widget)
printCustomWidgetGetWidget a
printCustomWidget = IO (Maybe Widget) -> m (Maybe Widget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr PrintCustomWidget
printCustomWidget' <- a -> IO (Ptr PrintCustomWidget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
printCustomWidget
    Ptr Widget
result <- Ptr PrintCustomWidget -> IO (Ptr Widget)
webkit_print_custom_widget_get_widget Ptr PrintCustomWidget
printCustomWidget'
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
printCustomWidget
    Maybe Widget -> IO (Maybe Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data PrintCustomWidgetGetWidgetMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsPrintCustomWidget a) => O.OverloadedMethod PrintCustomWidgetGetWidgetMethodInfo a signature where
    overloadedMethod = printCustomWidgetGetWidget

instance O.OverloadedMethodInfo PrintCustomWidgetGetWidgetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.PrintCustomWidget.printCustomWidgetGetWidget",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.29/docs/GI-WebKit2-Objects-PrintCustomWidget.html#v:printCustomWidgetGetWidget"
        })


#endif