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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A helper object for [class/@toastOverlay@/].
-- 
-- Toasts are meant to be passed into [method/@toastOverlay@/.add_toast] as
-- follows:
-- 
-- 
-- === /c code/
-- >adw_toast_overlay_add_toast (overlay, adw_toast_new (_("Simple Toast")));
-- 
-- 
-- \<picture>
--   \<source srcset=\"toast-simple-dark.png\" media=\"(prefers-color-scheme: dark)\">
--   \<img src=\"toast-simple.png\" alt=\"toast-simple\">
-- \<\/picture>
-- 
-- Toasts always have a close button. They emit the [signal/@toast@/[dismissed](#g:signal:dismissed)]
-- signal when disappearing.
-- 
-- [property/@toast@/:timeout] determines how long the toast stays on screen, while
-- [property/@toast@/:priority] determines how it behaves if another toast is
-- already being displayed.
-- 
-- [property/@toast@/:custom-title] can be used to replace the title label with a
-- custom widget.
-- 
-- == Actions
-- 
-- Toasts can have one button on them, with a label and an attached
-- t'GI.Gio.Interfaces.Action.Action'.
-- 
-- 
-- === /c code/
-- >AdwToast *toast = adw_toast_new (_("Toast with Action"));
-- >
-- >adw_toast_set_button_label (toast, _("_Example"));
-- >adw_toast_set_action_name (toast, "win.example");
-- >
-- >adw_toast_overlay_add_toast (overlay, toast);
-- 
-- 
-- \<picture>
--   \<source srcset=\"toast-action-dark.png\" media=\"(prefers-color-scheme: dark)\">
--   \<img src=\"toast-action.png\" alt=\"toast-action\">
-- \<\/picture>
-- 
-- == Modifying toasts
-- 
-- Toasts can be modified after they have been shown. For this, an @AdwToast@
-- reference must be kept around while the toast is visible.
-- 
-- A common use case for this is using toasts as undo prompts that stack with
-- each other, allowing to batch undo the last deleted items:
-- 
-- 
-- === /c code/
-- >
-- >static void
-- >toast_undo_cb (GtkWidget  *sender,
-- >               const char *action,
-- >               GVariant   *param)
-- >{
-- >  // Undo the deletion
-- >}
-- >
-- >static void
-- >dismissed_cb (MyWindow *self)
-- >{
-- >  self->undo_toast = NULL;
-- >
-- >  // Permanently delete the items
-- >}
-- >
-- >static void
-- >delete_item (MyWindow *self,
-- >             MyItem   *item)
-- >{
-- >  g_autofree char *title = NULL;
-- >  int n_items;
-- >
-- >  // Mark the item as waiting for deletion
-- >  n_items = ... // The number of waiting items
-- >
-- >  if (!self->undo_toast) {
-- >    self->undo_toast = adw_toast_new_format (_("‘%s’ deleted"), ...);
-- >
-- >    adw_toast_set_priority (self->undo_toast, ADW_TOAST_PRIORITY_HIGH);
-- >    adw_toast_set_button_label (self->undo_toast, _("_Undo"));
-- >    adw_toast_set_action_name (self->undo_toast, "toast.undo");
-- >
-- >    g_signal_connect_swapped (self->undo_toast, "dismissed",
-- >                              G_CALLBACK (dismissed_cb), self);
-- >
-- >    adw_toast_overlay_add_toast (self->toast_overlay, self->undo_toast);
-- >
-- >    return;
-- >  }
-- >
-- >  title =
-- >    g_strdup_printf (ngettext ("<span font_features='tnum=1'>%d</span> item deleted",
-- >                               "<span font_features='tnum=1'>%d</span> items deleted",
-- >                               n_items), n_items);
-- >
-- >  adw_toast_set_title (self->undo_toast, title);
-- >
-- >  // Bump the toast timeout
-- >  adw_toast_overlay_add_toast (self->toast_overlay, g_object_ref (self->undo_toast));
-- >}
-- >
-- >static void
-- >my_window_class_init (MyWindowClass *klass)
-- >{
-- >  GtkWidgetClass *widget_class = GTK_WIDGET_CLASS (klass);
-- >
-- >  gtk_widget_class_install_action (widget_class, "toast.undo", NULL, toast_undo_cb);
-- >}
-- 
-- 
-- \<picture>
--   \<source srcset=\"toast-undo-dark.png\" media=\"(prefers-color-scheme: dark)\">
--   \<img src=\"toast-undo.png\" alt=\"toast-undo\">
-- \<\/picture>

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

module GI.Adw.Objects.Toast
    ( 

-- * Exported types
    Toast(..)                               ,
    IsToast                                 ,
    toToast                                 ,


 -- * 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"), [dismiss]("GI.Adw.Objects.Toast#g:method:dismiss"), [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
-- [getActionName]("GI.Adw.Objects.Toast#g:method:getActionName"), [getActionTargetValue]("GI.Adw.Objects.Toast#g:method:getActionTargetValue"), [getButtonLabel]("GI.Adw.Objects.Toast#g:method:getButtonLabel"), [getCustomTitle]("GI.Adw.Objects.Toast#g:method:getCustomTitle"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getPriority]("GI.Adw.Objects.Toast#g:method:getPriority"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTimeout]("GI.Adw.Objects.Toast#g:method:getTimeout"), [getTitle]("GI.Adw.Objects.Toast#g:method:getTitle").
-- 
-- ==== Setters
-- [setActionName]("GI.Adw.Objects.Toast#g:method:setActionName"), [setActionTargetValue]("GI.Adw.Objects.Toast#g:method:setActionTargetValue"), [setButtonLabel]("GI.Adw.Objects.Toast#g:method:setButtonLabel"), [setCustomTitle]("GI.Adw.Objects.Toast#g:method:setCustomTitle"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDetailedActionName]("GI.Adw.Objects.Toast#g:method:setDetailedActionName"), [setPriority]("GI.Adw.Objects.Toast#g:method:setPriority"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTimeout]("GI.Adw.Objects.Toast#g:method:setTimeout"), [setTitle]("GI.Adw.Objects.Toast#g:method:setTitle").

#if defined(ENABLE_OVERLOADING)
    ResolveToastMethod                      ,
#endif

-- ** dismiss #method:dismiss#

#if defined(ENABLE_OVERLOADING)
    ToastDismissMethodInfo                  ,
#endif
    toastDismiss                            ,


-- ** getActionName #method:getActionName#

#if defined(ENABLE_OVERLOADING)
    ToastGetActionNameMethodInfo            ,
#endif
    toastGetActionName                      ,


-- ** getActionTargetValue #method:getActionTargetValue#

#if defined(ENABLE_OVERLOADING)
    ToastGetActionTargetValueMethodInfo     ,
#endif
    toastGetActionTargetValue               ,


-- ** getButtonLabel #method:getButtonLabel#

#if defined(ENABLE_OVERLOADING)
    ToastGetButtonLabelMethodInfo           ,
#endif
    toastGetButtonLabel                     ,


-- ** getCustomTitle #method:getCustomTitle#

#if defined(ENABLE_OVERLOADING)
    ToastGetCustomTitleMethodInfo           ,
#endif
    toastGetCustomTitle                     ,


-- ** getPriority #method:getPriority#

#if defined(ENABLE_OVERLOADING)
    ToastGetPriorityMethodInfo              ,
#endif
    toastGetPriority                        ,


-- ** getTimeout #method:getTimeout#

#if defined(ENABLE_OVERLOADING)
    ToastGetTimeoutMethodInfo               ,
#endif
    toastGetTimeout                         ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    ToastGetTitleMethodInfo                 ,
#endif
    toastGetTitle                           ,


-- ** new #method:new#

    toastNew                                ,


-- ** setActionName #method:setActionName#

#if defined(ENABLE_OVERLOADING)
    ToastSetActionNameMethodInfo            ,
#endif
    toastSetActionName                      ,


-- ** setActionTargetValue #method:setActionTargetValue#

#if defined(ENABLE_OVERLOADING)
    ToastSetActionTargetValueMethodInfo     ,
#endif
    toastSetActionTargetValue               ,


-- ** setButtonLabel #method:setButtonLabel#

#if defined(ENABLE_OVERLOADING)
    ToastSetButtonLabelMethodInfo           ,
#endif
    toastSetButtonLabel                     ,


-- ** setCustomTitle #method:setCustomTitle#

#if defined(ENABLE_OVERLOADING)
    ToastSetCustomTitleMethodInfo           ,
#endif
    toastSetCustomTitle                     ,


-- ** setDetailedActionName #method:setDetailedActionName#

#if defined(ENABLE_OVERLOADING)
    ToastSetDetailedActionNameMethodInfo    ,
#endif
    toastSetDetailedActionName              ,


-- ** setPriority #method:setPriority#

#if defined(ENABLE_OVERLOADING)
    ToastSetPriorityMethodInfo              ,
#endif
    toastSetPriority                        ,


-- ** setTimeout #method:setTimeout#

#if defined(ENABLE_OVERLOADING)
    ToastSetTimeoutMethodInfo               ,
#endif
    toastSetTimeout                         ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    ToastSetTitleMethodInfo                 ,
#endif
    toastSetTitle                           ,




 -- * Properties


-- ** actionName #attr:actionName#
-- | The name of the associated action.
-- 
-- It will be activated when clicking the button.
-- 
-- See [property/@toast@/:action-target].

#if defined(ENABLE_OVERLOADING)
    ToastActionNamePropertyInfo             ,
#endif
    clearToastActionName                    ,
    constructToastActionName                ,
    getToastActionName                      ,
    setToastActionName                      ,
#if defined(ENABLE_OVERLOADING)
    toastActionName                         ,
#endif


-- ** actionTarget #attr:actionTarget#
-- | The parameter for action invocations.

#if defined(ENABLE_OVERLOADING)
    ToastActionTargetPropertyInfo           ,
#endif
    clearToastActionTarget                  ,
    constructToastActionTarget              ,
    getToastActionTarget                    ,
    setToastActionTarget                    ,
#if defined(ENABLE_OVERLOADING)
    toastActionTarget                       ,
#endif


-- ** buttonLabel #attr:buttonLabel#
-- | The label to show on the button.
-- 
-- Underlines in the button text can be used to indicate a mnemonic.
-- 
-- If set to @NULL@, the button won\'t be shown.
-- 
-- See [property/@toast@/:action-name].

#if defined(ENABLE_OVERLOADING)
    ToastButtonLabelPropertyInfo            ,
#endif
    clearToastButtonLabel                   ,
    constructToastButtonLabel               ,
    getToastButtonLabel                     ,
    setToastButtonLabel                     ,
#if defined(ENABLE_OVERLOADING)
    toastButtonLabel                        ,
#endif


-- ** customTitle #attr:customTitle#
-- | The custom title widget.
-- 
-- It will be displayed instead of the title if set. In this case,
-- [property/@toast@/:title] is ignored.
-- 
-- Setting a custom title will unset [property/@toast@/:title].
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    ToastCustomTitlePropertyInfo            ,
#endif
    clearToastCustomTitle                   ,
    constructToastCustomTitle               ,
    getToastCustomTitle                     ,
    setToastCustomTitle                     ,
#if defined(ENABLE_OVERLOADING)
    toastCustomTitle                        ,
#endif


-- ** priority #attr:priority#
-- | The priority of the toast.
-- 
-- Priority controls how the toast behaves when another toast is already
-- being displayed.
-- 
-- If the priority is @ADW_TOAST_PRIORITY_NORMAL@, the toast will be queued.
-- 
-- If the priority is @ADW_TOAST_PRIORITY_HIGH@, the toast will be displayed
-- immediately, pushing the previous toast into the queue instead.

#if defined(ENABLE_OVERLOADING)
    ToastPriorityPropertyInfo               ,
#endif
    constructToastPriority                  ,
    getToastPriority                        ,
    setToastPriority                        ,
#if defined(ENABLE_OVERLOADING)
    toastPriority                           ,
#endif


-- ** timeout #attr:timeout#
-- | The timeout of the toast, in seconds.
-- 
-- If timeout is 0, the toast is displayed indefinitely until manually
-- dismissed.
-- 
-- Toasts cannot disappear while being hovered, pressed (on touchscreen), or
-- have keyboard focus inside them.

#if defined(ENABLE_OVERLOADING)
    ToastTimeoutPropertyInfo                ,
#endif
    constructToastTimeout                   ,
    getToastTimeout                         ,
    setToastTimeout                         ,
#if defined(ENABLE_OVERLOADING)
    toastTimeout                            ,
#endif


-- ** title #attr:title#
-- | The title of the toast.
-- 
-- The title can be marked up with the Pango text markup language.
-- 
-- Setting a title will unset [property/@toast@/:custom-title].
-- 
-- If [property/@toast@/:custom-title] is set, it will be used instead.

#if defined(ENABLE_OVERLOADING)
    ToastTitlePropertyInfo                  ,
#endif
    constructToastTitle                     ,
    getToastTitle                           ,
    setToastTitle                           ,
#if defined(ENABLE_OVERLOADING)
    toastTitle                              ,
#endif




 -- * Signals


-- ** buttonClicked #signal:buttonClicked#

    ToastButtonClickedCallback              ,
#if defined(ENABLE_OVERLOADING)
    ToastButtonClickedSignalInfo            ,
#endif
    afterToastButtonClicked                 ,
    onToastButtonClicked                    ,


-- ** dismissed #signal:dismissed#

    ToastDismissedCallback                  ,
#if defined(ENABLE_OVERLOADING)
    ToastDismissedSignalInfo                ,
#endif
    afterToastDismissed                     ,
    onToastDismissed                        ,




    ) 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 {-# SOURCE #-} qualified GI.Adw.Enums as Adw.Enums
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

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

foreign import ccall "adw_toast_get_type"
    c_adw_toast_get_type :: IO B.Types.GType

instance B.Types.TypedObject Toast where
    glibType :: IO GType
glibType = IO GType
c_adw_toast_get_type

instance B.Types.GObject Toast

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveToastMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveToastMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveToastMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveToastMethod "dismiss" o = ToastDismissMethodInfo
    ResolveToastMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveToastMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveToastMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveToastMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveToastMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveToastMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveToastMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveToastMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveToastMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveToastMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveToastMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveToastMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveToastMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveToastMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveToastMethod "getActionName" o = ToastGetActionNameMethodInfo
    ResolveToastMethod "getActionTargetValue" o = ToastGetActionTargetValueMethodInfo
    ResolveToastMethod "getButtonLabel" o = ToastGetButtonLabelMethodInfo
    ResolveToastMethod "getCustomTitle" o = ToastGetCustomTitleMethodInfo
    ResolveToastMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveToastMethod "getPriority" o = ToastGetPriorityMethodInfo
    ResolveToastMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveToastMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveToastMethod "getTimeout" o = ToastGetTimeoutMethodInfo
    ResolveToastMethod "getTitle" o = ToastGetTitleMethodInfo
    ResolveToastMethod "setActionName" o = ToastSetActionNameMethodInfo
    ResolveToastMethod "setActionTargetValue" o = ToastSetActionTargetValueMethodInfo
    ResolveToastMethod "setButtonLabel" o = ToastSetButtonLabelMethodInfo
    ResolveToastMethod "setCustomTitle" o = ToastSetCustomTitleMethodInfo
    ResolveToastMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveToastMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveToastMethod "setDetailedActionName" o = ToastSetDetailedActionNameMethodInfo
    ResolveToastMethod "setPriority" o = ToastSetPriorityMethodInfo
    ResolveToastMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveToastMethod "setTimeout" o = ToastSetTimeoutMethodInfo
    ResolveToastMethod "setTitle" o = ToastSetTitleMethodInfo
    ResolveToastMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Toast::button-clicked
-- | Emitted after the button has been clicked.
-- 
-- It can be used as an alternative to setting an action.
-- 
-- /Since: 1.2/
type ToastButtonClickedCallback =
    IO ()

type C_ToastButtonClickedCallback =
    Ptr Toast ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ToastButtonClickedCallback :: 
    GObject a => (a -> ToastButtonClickedCallback) ->
    C_ToastButtonClickedCallback
wrap_ToastButtonClickedCallback :: forall a. GObject a => (a -> IO ()) -> C_ToastButtonClickedCallback
wrap_ToastButtonClickedCallback a -> IO ()
gi'cb Ptr Toast
gi'selfPtr Ptr ()
_ = do
    Ptr Toast -> (Toast -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Toast
gi'selfPtr ((Toast -> IO ()) -> IO ()) -> (Toast -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Toast
gi'self -> a -> IO ()
gi'cb (Toast -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Toast
gi'self) 


-- | Connect a signal handler for the [buttonClicked](#signal:buttonClicked) 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' toast #buttonClicked callback
-- @
-- 
-- 
onToastButtonClicked :: (IsToast a, MonadIO m) => a -> ((?self :: a) => ToastButtonClickedCallback) -> m SignalHandlerId
onToastButtonClicked :: forall a (m :: * -> *).
(IsToast a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onToastButtonClicked 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_ToastButtonClickedCallback
wrapped' = (a -> IO ()) -> C_ToastButtonClickedCallback
forall a. GObject a => (a -> IO ()) -> C_ToastButtonClickedCallback
wrap_ToastButtonClickedCallback a -> IO ()
wrapped
    FunPtr C_ToastButtonClickedCallback
wrapped'' <- C_ToastButtonClickedCallback
-> IO (FunPtr C_ToastButtonClickedCallback)
mk_ToastButtonClickedCallback C_ToastButtonClickedCallback
wrapped'
    a
-> Text
-> FunPtr C_ToastButtonClickedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"button-clicked" FunPtr C_ToastButtonClickedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [buttonClicked](#signal:buttonClicked) 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' toast #buttonClicked 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.
-- 
afterToastButtonClicked :: (IsToast a, MonadIO m) => a -> ((?self :: a) => ToastButtonClickedCallback) -> m SignalHandlerId
afterToastButtonClicked :: forall a (m :: * -> *).
(IsToast a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterToastButtonClicked 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_ToastButtonClickedCallback
wrapped' = (a -> IO ()) -> C_ToastButtonClickedCallback
forall a. GObject a => (a -> IO ()) -> C_ToastButtonClickedCallback
wrap_ToastButtonClickedCallback a -> IO ()
wrapped
    FunPtr C_ToastButtonClickedCallback
wrapped'' <- C_ToastButtonClickedCallback
-> IO (FunPtr C_ToastButtonClickedCallback)
mk_ToastButtonClickedCallback C_ToastButtonClickedCallback
wrapped'
    a
-> Text
-> FunPtr C_ToastButtonClickedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"button-clicked" FunPtr C_ToastButtonClickedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ToastButtonClickedSignalInfo
instance SignalInfo ToastButtonClickedSignalInfo where
    type HaskellCallbackType ToastButtonClickedSignalInfo = ToastButtonClickedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ToastButtonClickedCallback cb
        cb'' <- mk_ToastButtonClickedCallback cb'
        connectSignalFunPtr obj "button-clicked" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast::button-clicked"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#g:signal:buttonClicked"})

#endif

-- signal Toast::dismissed
-- | Emitted when the toast has been dismissed.
type ToastDismissedCallback =
    IO ()

type C_ToastDismissedCallback =
    Ptr Toast ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ToastDismissedCallback :: 
    GObject a => (a -> ToastDismissedCallback) ->
    C_ToastDismissedCallback
wrap_ToastDismissedCallback :: forall a. GObject a => (a -> IO ()) -> C_ToastButtonClickedCallback
wrap_ToastDismissedCallback a -> IO ()
gi'cb Ptr Toast
gi'selfPtr Ptr ()
_ = do
    Ptr Toast -> (Toast -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Toast
gi'selfPtr ((Toast -> IO ()) -> IO ()) -> (Toast -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Toast
gi'self -> a -> IO ()
gi'cb (Toast -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Toast
gi'self) 


-- | Connect a signal handler for the [dismissed](#signal:dismissed) 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' toast #dismissed callback
-- @
-- 
-- 
onToastDismissed :: (IsToast a, MonadIO m) => a -> ((?self :: a) => ToastDismissedCallback) -> m SignalHandlerId
onToastDismissed :: forall a (m :: * -> *).
(IsToast a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onToastDismissed 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_ToastButtonClickedCallback
wrapped' = (a -> IO ()) -> C_ToastButtonClickedCallback
forall a. GObject a => (a -> IO ()) -> C_ToastButtonClickedCallback
wrap_ToastDismissedCallback a -> IO ()
wrapped
    FunPtr C_ToastButtonClickedCallback
wrapped'' <- C_ToastButtonClickedCallback
-> IO (FunPtr C_ToastButtonClickedCallback)
mk_ToastDismissedCallback C_ToastButtonClickedCallback
wrapped'
    a
-> Text
-> FunPtr C_ToastButtonClickedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"dismissed" FunPtr C_ToastButtonClickedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [dismissed](#signal:dismissed) 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' toast #dismissed 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.
-- 
afterToastDismissed :: (IsToast a, MonadIO m) => a -> ((?self :: a) => ToastDismissedCallback) -> m SignalHandlerId
afterToastDismissed :: forall a (m :: * -> *).
(IsToast a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterToastDismissed 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_ToastButtonClickedCallback
wrapped' = (a -> IO ()) -> C_ToastButtonClickedCallback
forall a. GObject a => (a -> IO ()) -> C_ToastButtonClickedCallback
wrap_ToastDismissedCallback a -> IO ()
wrapped
    FunPtr C_ToastButtonClickedCallback
wrapped'' <- C_ToastButtonClickedCallback
-> IO (FunPtr C_ToastButtonClickedCallback)
mk_ToastDismissedCallback C_ToastButtonClickedCallback
wrapped'
    a
-> Text
-> FunPtr C_ToastButtonClickedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"dismissed" FunPtr C_ToastButtonClickedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ToastDismissedSignalInfo
instance SignalInfo ToastDismissedSignalInfo where
    type HaskellCallbackType ToastDismissedSignalInfo = ToastDismissedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ToastDismissedCallback cb
        cb'' <- mk_ToastDismissedCallback cb'
        connectSignalFunPtr obj "dismissed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast::dismissed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#g:signal:dismissed"})

#endif

-- VVV Prop "action-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@action-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' toast #actionName
-- @
getToastActionName :: (MonadIO m, IsToast o) => o -> m (Maybe T.Text)
getToastActionName :: forall (m :: * -> *) o.
(MonadIO m, IsToast o) =>
o -> m (Maybe Text)
getToastActionName o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"action-name"

-- | Set the value of the “@action-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' toast [ #actionName 'Data.GI.Base.Attributes.:=' value ]
-- @
setToastActionName :: (MonadIO m, IsToast o) => o -> T.Text -> m ()
setToastActionName :: forall (m :: * -> *) o. (MonadIO m, IsToast o) => o -> Text -> m ()
setToastActionName o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"action-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@action-name@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #actionName
-- @
clearToastActionName :: (MonadIO m, IsToast o) => o -> m ()
clearToastActionName :: forall (m :: * -> *) o. (MonadIO m, IsToast o) => o -> m ()
clearToastActionName o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"action-name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data ToastActionNamePropertyInfo
instance AttrInfo ToastActionNamePropertyInfo where
    type AttrAllowedOps ToastActionNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ToastActionNamePropertyInfo = IsToast
    type AttrSetTypeConstraint ToastActionNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ToastActionNamePropertyInfo = (~) T.Text
    type AttrTransferType ToastActionNamePropertyInfo = T.Text
    type AttrGetType ToastActionNamePropertyInfo = (Maybe T.Text)
    type AttrLabel ToastActionNamePropertyInfo = "action-name"
    type AttrOrigin ToastActionNamePropertyInfo = Toast
    attrGet = getToastActionName
    attrSet = setToastActionName
    attrTransfer _ v = do
        return v
    attrConstruct = constructToastActionName
    attrClear = clearToastActionName
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.actionName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#g:attr:actionName"
        })
#endif

-- VVV Prop "action-target"
   -- Type: TVariant
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@action-target@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' toast #actionTarget
-- @
getToastActionTarget :: (MonadIO m, IsToast o) => o -> m (Maybe GVariant)
getToastActionTarget :: forall (m :: * -> *) o.
(MonadIO m, IsToast o) =>
o -> m (Maybe GVariant)
getToastActionTarget o
obj = IO (Maybe GVariant) -> m (Maybe GVariant)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe GVariant) -> m (Maybe GVariant))
-> IO (Maybe GVariant) -> m (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe GVariant)
forall a. GObject a => a -> String -> IO (Maybe GVariant)
B.Properties.getObjectPropertyVariant o
obj String
"action-target"

-- | Set the value of the “@action-target@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' toast [ #actionTarget 'Data.GI.Base.Attributes.:=' value ]
-- @
setToastActionTarget :: (MonadIO m, IsToast o) => o -> GVariant -> m ()
setToastActionTarget :: forall (m :: * -> *) o.
(MonadIO m, IsToast o) =>
o -> GVariant -> m ()
setToastActionTarget o
obj GVariant
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe GVariant -> IO ()
forall a. GObject a => a -> String -> Maybe GVariant -> IO ()
B.Properties.setObjectPropertyVariant o
obj String
"action-target" (GVariant -> Maybe GVariant
forall a. a -> Maybe a
Just GVariant
val)

-- | Construct a `GValueConstruct` with valid value for the “@action-target@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructToastActionTarget :: (IsToast o, MIO.MonadIO m) => GVariant -> m (GValueConstruct o)
constructToastActionTarget :: forall o (m :: * -> *).
(IsToast o, MonadIO m) =>
GVariant -> m (GValueConstruct o)
constructToastActionTarget GVariant
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 GVariant -> IO (GValueConstruct o)
forall o. String -> Maybe GVariant -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyVariant String
"action-target" (GVariant -> Maybe GVariant
forall a. a -> Maybe a
P.Just GVariant
val)

-- | Set the value of the “@action-target@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #actionTarget
-- @
clearToastActionTarget :: (MonadIO m, IsToast o) => o -> m ()
clearToastActionTarget :: forall (m :: * -> *) o. (MonadIO m, IsToast o) => o -> m ()
clearToastActionTarget o
obj = 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
$ o -> String -> Maybe GVariant -> IO ()
forall a. GObject a => a -> String -> Maybe GVariant -> IO ()
B.Properties.setObjectPropertyVariant o
obj String
"action-target" (Maybe GVariant
forall a. Maybe a
Nothing :: Maybe GVariant)

#if defined(ENABLE_OVERLOADING)
data ToastActionTargetPropertyInfo
instance AttrInfo ToastActionTargetPropertyInfo where
    type AttrAllowedOps ToastActionTargetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ToastActionTargetPropertyInfo = IsToast
    type AttrSetTypeConstraint ToastActionTargetPropertyInfo = (~) GVariant
    type AttrTransferTypeConstraint ToastActionTargetPropertyInfo = (~) GVariant
    type AttrTransferType ToastActionTargetPropertyInfo = GVariant
    type AttrGetType ToastActionTargetPropertyInfo = (Maybe GVariant)
    type AttrLabel ToastActionTargetPropertyInfo = "action-target"
    type AttrOrigin ToastActionTargetPropertyInfo = Toast
    attrGet = getToastActionTarget
    attrSet = setToastActionTarget
    attrTransfer _ v = do
        return v
    attrConstruct = constructToastActionTarget
    attrClear = clearToastActionTarget
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.actionTarget"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#g:attr:actionTarget"
        })
#endif

-- VVV Prop "button-label"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@button-label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' toast #buttonLabel
-- @
getToastButtonLabel :: (MonadIO m, IsToast o) => o -> m (Maybe T.Text)
getToastButtonLabel :: forall (m :: * -> *) o.
(MonadIO m, IsToast o) =>
o -> m (Maybe Text)
getToastButtonLabel o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"button-label"

-- | Set the value of the “@button-label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' toast [ #buttonLabel 'Data.GI.Base.Attributes.:=' value ]
-- @
setToastButtonLabel :: (MonadIO m, IsToast o) => o -> T.Text -> m ()
setToastButtonLabel :: forall (m :: * -> *) o. (MonadIO m, IsToast o) => o -> Text -> m ()
setToastButtonLabel o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"button-label" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@button-label@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #buttonLabel
-- @
clearToastButtonLabel :: (MonadIO m, IsToast o) => o -> m ()
clearToastButtonLabel :: forall (m :: * -> *) o. (MonadIO m, IsToast o) => o -> m ()
clearToastButtonLabel o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"button-label" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data ToastButtonLabelPropertyInfo
instance AttrInfo ToastButtonLabelPropertyInfo where
    type AttrAllowedOps ToastButtonLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ToastButtonLabelPropertyInfo = IsToast
    type AttrSetTypeConstraint ToastButtonLabelPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ToastButtonLabelPropertyInfo = (~) T.Text
    type AttrTransferType ToastButtonLabelPropertyInfo = T.Text
    type AttrGetType ToastButtonLabelPropertyInfo = (Maybe T.Text)
    type AttrLabel ToastButtonLabelPropertyInfo = "button-label"
    type AttrOrigin ToastButtonLabelPropertyInfo = Toast
    attrGet = getToastButtonLabel
    attrSet = setToastButtonLabel
    attrTransfer _ v = do
        return v
    attrConstruct = constructToastButtonLabel
    attrClear = clearToastButtonLabel
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.buttonLabel"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#g:attr:buttonLabel"
        })
#endif

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

-- | Get the value of the “@custom-title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' toast #customTitle
-- @
getToastCustomTitle :: (MonadIO m, IsToast o) => o -> m (Maybe Gtk.Widget.Widget)
getToastCustomTitle :: forall (m :: * -> *) o.
(MonadIO m, IsToast o) =>
o -> m (Maybe Widget)
getToastCustomTitle 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
"custom-title" ManagedPtr Widget -> Widget
Gtk.Widget.Widget

-- | Set the value of the “@custom-title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' toast [ #customTitle 'Data.GI.Base.Attributes.:=' value ]
-- @
setToastCustomTitle :: (MonadIO m, IsToast o, Gtk.Widget.IsWidget a) => o -> a -> m ()
setToastCustomTitle :: forall (m :: * -> *) o a.
(MonadIO m, IsToast o, IsWidget a) =>
o -> a -> m ()
setToastCustomTitle o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"custom-title" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

-- | Set the value of the “@custom-title@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #customTitle
-- @
clearToastCustomTitle :: (MonadIO m, IsToast o) => o -> m ()
clearToastCustomTitle :: forall (m :: * -> *) o. (MonadIO m, IsToast o) => o -> m ()
clearToastCustomTitle o
obj = 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
$ o -> String -> Maybe Widget -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"custom-title" (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget.Widget)

#if defined(ENABLE_OVERLOADING)
data ToastCustomTitlePropertyInfo
instance AttrInfo ToastCustomTitlePropertyInfo where
    type AttrAllowedOps ToastCustomTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ToastCustomTitlePropertyInfo = IsToast
    type AttrSetTypeConstraint ToastCustomTitlePropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint ToastCustomTitlePropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType ToastCustomTitlePropertyInfo = Gtk.Widget.Widget
    type AttrGetType ToastCustomTitlePropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel ToastCustomTitlePropertyInfo = "custom-title"
    type AttrOrigin ToastCustomTitlePropertyInfo = Toast
    attrGet = getToastCustomTitle
    attrSet = setToastCustomTitle
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructToastCustomTitle
    attrClear = clearToastCustomTitle
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.customTitle"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#g:attr:customTitle"
        })
#endif

-- VVV Prop "priority"
   -- Type: TInterface (Name {namespace = "Adw", name = "ToastPriority"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@priority@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' toast #priority
-- @
getToastPriority :: (MonadIO m, IsToast o) => o -> m Adw.Enums.ToastPriority
getToastPriority :: forall (m :: * -> *) o.
(MonadIO m, IsToast o) =>
o -> m ToastPriority
getToastPriority o
obj = IO ToastPriority -> m ToastPriority
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ToastPriority -> m ToastPriority)
-> IO ToastPriority -> m ToastPriority
forall a b. (a -> b) -> a -> b
$ o -> String -> IO ToastPriority
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"priority"

-- | Set the value of the “@priority@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' toast [ #priority 'Data.GI.Base.Attributes.:=' value ]
-- @
setToastPriority :: (MonadIO m, IsToast o) => o -> Adw.Enums.ToastPriority -> m ()
setToastPriority :: forall (m :: * -> *) o.
(MonadIO m, IsToast o) =>
o -> ToastPriority -> m ()
setToastPriority o
obj ToastPriority
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> ToastPriority -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"priority" ToastPriority
val

-- | Construct a `GValueConstruct` with valid value for the “@priority@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructToastPriority :: (IsToast o, MIO.MonadIO m) => Adw.Enums.ToastPriority -> m (GValueConstruct o)
constructToastPriority :: forall o (m :: * -> *).
(IsToast o, MonadIO m) =>
ToastPriority -> m (GValueConstruct o)
constructToastPriority ToastPriority
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 -> ToastPriority -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"priority" ToastPriority
val

#if defined(ENABLE_OVERLOADING)
data ToastPriorityPropertyInfo
instance AttrInfo ToastPriorityPropertyInfo where
    type AttrAllowedOps ToastPriorityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ToastPriorityPropertyInfo = IsToast
    type AttrSetTypeConstraint ToastPriorityPropertyInfo = (~) Adw.Enums.ToastPriority
    type AttrTransferTypeConstraint ToastPriorityPropertyInfo = (~) Adw.Enums.ToastPriority
    type AttrTransferType ToastPriorityPropertyInfo = Adw.Enums.ToastPriority
    type AttrGetType ToastPriorityPropertyInfo = Adw.Enums.ToastPriority
    type AttrLabel ToastPriorityPropertyInfo = "priority"
    type AttrOrigin ToastPriorityPropertyInfo = Toast
    attrGet = getToastPriority
    attrSet = setToastPriority
    attrTransfer _ v = do
        return v
    attrConstruct = constructToastPriority
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.priority"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#g:attr:priority"
        })
#endif

-- VVV Prop "timeout"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@timeout@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructToastTimeout :: (IsToast o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructToastTimeout :: forall o (m :: * -> *).
(IsToast o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructToastTimeout Word32
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 -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"timeout" Word32
val

#if defined(ENABLE_OVERLOADING)
data ToastTimeoutPropertyInfo
instance AttrInfo ToastTimeoutPropertyInfo where
    type AttrAllowedOps ToastTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ToastTimeoutPropertyInfo = IsToast
    type AttrSetTypeConstraint ToastTimeoutPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint ToastTimeoutPropertyInfo = (~) Word32
    type AttrTransferType ToastTimeoutPropertyInfo = Word32
    type AttrGetType ToastTimeoutPropertyInfo = Word32
    type AttrLabel ToastTimeoutPropertyInfo = "timeout"
    type AttrOrigin ToastTimeoutPropertyInfo = Toast
    attrGet = getToastTimeout
    attrSet = setToastTimeout
    attrTransfer _ v = do
        return v
    attrConstruct = constructToastTimeout
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.timeout"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#g:attr:timeout"
        })
#endif

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

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

-- | Set the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' toast [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setToastTitle :: (MonadIO m, IsToast o) => o -> T.Text -> m ()
setToastTitle :: forall (m :: * -> *) o. (MonadIO m, IsToast o) => o -> Text -> m ()
setToastTitle o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"title" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@title@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructToastTitle :: (IsToast o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructToastTitle :: forall o (m :: * -> *).
(IsToast o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructToastTitle 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 ToastTitlePropertyInfo
instance AttrInfo ToastTitlePropertyInfo where
    type AttrAllowedOps ToastTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ToastTitlePropertyInfo = IsToast
    type AttrSetTypeConstraint ToastTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ToastTitlePropertyInfo = (~) T.Text
    type AttrTransferType ToastTitlePropertyInfo = T.Text
    type AttrGetType ToastTitlePropertyInfo = (Maybe T.Text)
    type AttrLabel ToastTitlePropertyInfo = "title"
    type AttrOrigin ToastTitlePropertyInfo = Toast
    attrGet = getToastTitle
    attrSet = setToastTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructToastTitle
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#g:attr:title"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Toast
type instance O.AttributeList Toast = ToastAttributeList
type ToastAttributeList = ('[ '("actionName", ToastActionNamePropertyInfo), '("actionTarget", ToastActionTargetPropertyInfo), '("buttonLabel", ToastButtonLabelPropertyInfo), '("customTitle", ToastCustomTitlePropertyInfo), '("priority", ToastPriorityPropertyInfo), '("timeout", ToastTimeoutPropertyInfo), '("title", ToastTitlePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
toastActionName :: AttrLabelProxy "actionName"
toastActionName = AttrLabelProxy

toastActionTarget :: AttrLabelProxy "actionTarget"
toastActionTarget = AttrLabelProxy

toastButtonLabel :: AttrLabelProxy "buttonLabel"
toastButtonLabel = AttrLabelProxy

toastCustomTitle :: AttrLabelProxy "customTitle"
toastCustomTitle = AttrLabelProxy

toastPriority :: AttrLabelProxy "priority"
toastPriority = AttrLabelProxy

toastTimeout :: AttrLabelProxy "timeout"
toastTimeout = AttrLabelProxy

toastTitle :: AttrLabelProxy "title"
toastTitle = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Toast = ToastSignalList
type ToastSignalList = ('[ '("buttonClicked", ToastButtonClickedSignalInfo), '("dismissed", ToastDismissedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Toast::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the title to be displayed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Adw" , name = "Toast" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_toast_new" adw_toast_new :: 
    CString ->                              -- title : TBasicType TUTF8
    IO (Ptr Toast)

-- | Creates a new @AdwToast@.
-- 
-- The toast will use /@title@/ as its title.
-- 
-- /@title@/ can be marked up with the Pango text markup language.
toastNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@title@/: the title to be displayed
    -> m Toast
    -- ^ __Returns:__ the new created @AdwToast@
toastNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m Toast
toastNew Text
title = IO Toast -> m Toast
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Toast -> m Toast) -> IO Toast -> m Toast
forall a b. (a -> b) -> a -> b
$ do
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr Toast
result <- CString -> IO (Ptr Toast)
adw_toast_new CString
title'
    Text -> Ptr Toast -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"toastNew" Ptr Toast
result
    Toast
result' <- ((ManagedPtr Toast -> Toast) -> Ptr Toast -> IO Toast
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Toast -> Toast
Toast) Ptr Toast
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    Toast -> IO Toast
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Toast
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "adw_toast_dismiss" adw_toast_dismiss :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    IO ()

-- | Dismisses /@self@/.
-- 
-- Does nothing if /@self@/ has already been dismissed, or hasn\'t been added to an
-- [class/@toastOverlay@/].
toastDismiss ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> m ()
toastDismiss :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> m ()
toastDismiss a
self = 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 Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Toast -> IO ()
adw_toast_dismiss Ptr Toast
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToastDismissMethodInfo
instance (signature ~ (m ()), MonadIO m, IsToast a) => O.OverloadedMethod ToastDismissMethodInfo a signature where
    overloadedMethod = toastDismiss

instance O.OverloadedMethodInfo ToastDismissMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastDismiss",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastDismiss"
        })


#endif

-- method Toast::get_action_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , 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 "adw_toast_get_action_name" adw_toast_get_action_name :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    IO CString

-- | Gets the name of the associated action.
toastGetActionName ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the action name
toastGetActionName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> m (Maybe Text)
toastGetActionName a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Toast -> IO CString
adw_toast_get_action_name Ptr Toast
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ToastGetActionNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsToast a) => O.OverloadedMethod ToastGetActionNameMethodInfo a signature where
    overloadedMethod = toastGetActionName

instance O.OverloadedMethodInfo ToastGetActionNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastGetActionName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastGetActionName"
        })


#endif

-- method Toast::get_action_target_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "adw_toast_get_action_target_value" adw_toast_get_action_target_value :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    IO (Ptr GVariant)

-- | Gets the parameter for action invocations.
toastGetActionTargetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> m (Maybe GVariant)
    -- ^ __Returns:__ the action target
toastGetActionTargetValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> m (Maybe GVariant)
toastGetActionTargetValue a
self = IO (Maybe GVariant) -> m (Maybe GVariant)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GVariant) -> m (Maybe GVariant))
-> IO (Maybe GVariant) -> m (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr GVariant
result <- Ptr Toast -> IO (Ptr GVariant)
adw_toast_get_action_target_value Ptr Toast
self'
    Maybe GVariant
maybeResult <- Ptr GVariant
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GVariant
result ((Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant))
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ \Ptr GVariant
result' -> do
        GVariant
result'' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
result'
        GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe GVariant -> IO (Maybe GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GVariant
maybeResult

#if defined(ENABLE_OVERLOADING)
data ToastGetActionTargetValueMethodInfo
instance (signature ~ (m (Maybe GVariant)), MonadIO m, IsToast a) => O.OverloadedMethod ToastGetActionTargetValueMethodInfo a signature where
    overloadedMethod = toastGetActionTargetValue

instance O.OverloadedMethodInfo ToastGetActionTargetValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastGetActionTargetValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastGetActionTargetValue"
        })


#endif

-- method Toast::get_button_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , 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 "adw_toast_get_button_label" adw_toast_get_button_label :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    IO CString

-- | Gets the label to show on the button.
toastGetButtonLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the button label
toastGetButtonLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> m (Maybe Text)
toastGetButtonLabel a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Toast -> IO CString
adw_toast_get_button_label Ptr Toast
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ToastGetButtonLabelMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsToast a) => O.OverloadedMethod ToastGetButtonLabelMethodInfo a signature where
    overloadedMethod = toastGetButtonLabel

instance O.OverloadedMethodInfo ToastGetButtonLabelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastGetButtonLabel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastGetButtonLabel"
        })


#endif

-- method Toast::get_custom_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , 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 "adw_toast_get_custom_title" adw_toast_get_custom_title :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    IO (Ptr Gtk.Widget.Widget)

-- | Gets the custom title widget of /@self@/.
-- 
-- /Since: 1.2/
toastGetCustomTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ the custom title widget
toastGetCustomTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> m (Maybe Widget)
toastGetCustomTitle a
self = 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 Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr Toast -> IO (Ptr Widget)
adw_toast_get_custom_title Ptr Toast
self'
    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
self
    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 ToastGetCustomTitleMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsToast a) => O.OverloadedMethod ToastGetCustomTitleMethodInfo a signature where
    overloadedMethod = toastGetCustomTitle

instance O.OverloadedMethodInfo ToastGetCustomTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastGetCustomTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastGetCustomTitle"
        })


#endif

-- method Toast::get_priority
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Adw" , name = "ToastPriority" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_toast_get_priority" adw_toast_get_priority :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    IO CUInt

-- | Gets priority for /@self@/.
toastGetPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> m Adw.Enums.ToastPriority
    -- ^ __Returns:__ the priority
toastGetPriority :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> m ToastPriority
toastGetPriority a
self = IO ToastPriority -> m ToastPriority
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ToastPriority -> m ToastPriority)
-> IO ToastPriority -> m ToastPriority
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Toast -> IO CUInt
adw_toast_get_priority Ptr Toast
self'
    let result' :: ToastPriority
result' = (Int -> ToastPriority
forall a. Enum a => Int -> a
toEnum (Int -> ToastPriority) -> (CUInt -> Int) -> CUInt -> ToastPriority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    ToastPriority -> IO ToastPriority
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ToastPriority
result'

#if defined(ENABLE_OVERLOADING)
data ToastGetPriorityMethodInfo
instance (signature ~ (m Adw.Enums.ToastPriority), MonadIO m, IsToast a) => O.OverloadedMethod ToastGetPriorityMethodInfo a signature where
    overloadedMethod = toastGetPriority

instance O.OverloadedMethodInfo ToastGetPriorityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastGetPriority",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastGetPriority"
        })


#endif

-- method Toast::get_timeout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "adw_toast_get_timeout" adw_toast_get_timeout :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    IO Word32

-- | Gets timeout for /@self@/.
toastGetTimeout ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> m Word32
    -- ^ __Returns:__ the timeout
toastGetTimeout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> m Word32
toastGetTimeout a
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr Toast -> IO Word32
adw_toast_get_timeout Ptr Toast
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ToastGetTimeoutMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsToast a) => O.OverloadedMethod ToastGetTimeoutMethodInfo a signature where
    overloadedMethod = toastGetTimeout

instance O.OverloadedMethodInfo ToastGetTimeoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastGetTimeout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastGetTimeout"
        })


#endif

-- method Toast::get_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , 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 "adw_toast_get_title" adw_toast_get_title :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    IO CString

-- | Gets the title that will be displayed on the toast.
-- 
-- If a custom title has been set with 'GI.Adw.Objects.Toast.toastSetCustomTitle'
-- the return value will be 'P.Nothing'.
toastGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the title
toastGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> m (Maybe Text)
toastGetTitle a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Toast -> IO CString
adw_toast_get_title Ptr Toast
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ToastGetTitleMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsToast a) => O.OverloadedMethod ToastGetTitleMethodInfo a signature where
    overloadedMethod = toastGetTitle

instance O.OverloadedMethodInfo ToastGetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastGetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastGetTitle"
        })


#endif

-- method Toast::set_action_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the action name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_toast_set_action_name" adw_toast_set_action_name :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    CString ->                              -- action_name : TBasicType TUTF8
    IO ()

-- | Sets the name of the associated action.
-- 
-- It will be activated when clicking the button.
-- 
-- See [property/@toast@/:action-target].
toastSetActionName ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> Maybe (T.Text)
    -- ^ /@actionName@/: the action name
    -> m ()
toastSetActionName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> Maybe Text -> m ()
toastSetActionName a
self Maybe Text
actionName = 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 Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeActionName <- case Maybe Text
actionName of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jActionName -> do
            CString
jActionName' <- Text -> IO CString
textToCString Text
jActionName
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jActionName'
    Ptr Toast -> CString -> IO ()
adw_toast_set_action_name Ptr Toast
self' CString
maybeActionName
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeActionName
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToastSetActionNameMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsToast a) => O.OverloadedMethod ToastSetActionNameMethodInfo a signature where
    overloadedMethod = toastSetActionName

instance O.OverloadedMethodInfo ToastSetActionNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastSetActionName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastSetActionName"
        })


#endif

-- method Toast::set_action_target_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action_target"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the action target" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_toast_set_action_target_value" adw_toast_set_action_target_value :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    Ptr GVariant ->                         -- action_target : TVariant
    IO ()

-- | Sets the parameter for action invocations.
-- 
-- If the /@actionTarget@/ variant has a floating reference this function
-- will sink it.
toastSetActionTargetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> Maybe (GVariant)
    -- ^ /@actionTarget@/: the action target
    -> m ()
toastSetActionTargetValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> Maybe GVariant -> m ()
toastSetActionTargetValue a
self Maybe GVariant
actionTarget = 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 Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr GVariant
maybeActionTarget <- case Maybe GVariant
actionTarget of
        Maybe GVariant
Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just GVariant
jActionTarget -> do
            Ptr GVariant
jActionTarget' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jActionTarget
            Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jActionTarget'
    Ptr Toast -> Ptr GVariant -> IO ()
adw_toast_set_action_target_value Ptr Toast
self' Ptr GVariant
maybeActionTarget
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
actionTarget GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToastSetActionTargetValueMethodInfo
instance (signature ~ (Maybe (GVariant) -> m ()), MonadIO m, IsToast a) => O.OverloadedMethod ToastSetActionTargetValueMethodInfo a signature where
    overloadedMethod = toastSetActionTargetValue

instance O.OverloadedMethodInfo ToastSetActionTargetValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastSetActionTargetValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastSetActionTargetValue"
        })


#endif

-- method Toast::set_button_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "button_label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a button label" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_toast_set_button_label" adw_toast_set_button_label :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    CString ->                              -- button_label : TBasicType TUTF8
    IO ()

-- | Sets the label to show on the button.
-- 
-- Underlines in the button text can be used to indicate a mnemonic.
-- 
-- If set to @NULL@, the button won\'t be shown.
-- 
-- See [property/@toast@/:action-name].
toastSetButtonLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> Maybe (T.Text)
    -- ^ /@buttonLabel@/: a button label
    -> m ()
toastSetButtonLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> Maybe Text -> m ()
toastSetButtonLabel a
self Maybe Text
buttonLabel = 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 Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeButtonLabel <- case Maybe Text
buttonLabel of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jButtonLabel -> do
            CString
jButtonLabel' <- Text -> IO CString
textToCString Text
jButtonLabel
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jButtonLabel'
    Ptr Toast -> CString -> IO ()
adw_toast_set_button_label Ptr Toast
self' CString
maybeButtonLabel
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeButtonLabel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToastSetButtonLabelMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsToast a) => O.OverloadedMethod ToastSetButtonLabelMethodInfo a signature where
    overloadedMethod = toastSetButtonLabel

instance O.OverloadedMethodInfo ToastSetButtonLabelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastSetButtonLabel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastSetButtonLabel"
        })


#endif

-- method Toast::set_custom_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the custom title widget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_toast_set_custom_title" adw_toast_set_custom_title :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Sets the custom title widget of /@self@/.
-- 
-- It will be displayed instead of the title if set. In this case,
-- [property/@toast@/:title] is ignored.
-- 
-- Setting a custom title will unset [property/@toast@/:title].
-- 
-- /Since: 1.2/
toastSetCustomTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@self@/: a toast
    -> Maybe (b)
    -- ^ /@widget@/: the custom title widget
    -> m ()
toastSetCustomTitle :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsToast a, IsWidget b) =>
a -> Maybe b -> m ()
toastSetCustomTitle a
self Maybe b
widget = 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 Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
maybeWidget <- case Maybe b
widget of
        Maybe b
Nothing -> Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just b
jWidget -> do
            Ptr Widget
jWidget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jWidget
            Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jWidget'
    Ptr Toast -> Ptr Widget -> IO ()
adw_toast_set_custom_title Ptr Toast
self' Ptr Widget
maybeWidget
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
widget b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToastSetCustomTitleMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsToast a, Gtk.Widget.IsWidget b) => O.OverloadedMethod ToastSetCustomTitleMethodInfo a signature where
    overloadedMethod = toastSetCustomTitle

instance O.OverloadedMethodInfo ToastSetCustomTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastSetCustomTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastSetCustomTitle"
        })


#endif

-- method Toast::set_detailed_action_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "detailed_action_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the detailed action name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_toast_set_detailed_action_name" adw_toast_set_detailed_action_name :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    CString ->                              -- detailed_action_name : TBasicType TUTF8
    IO ()

-- | Sets the action name and its parameter.
-- 
-- /@detailedActionName@/ is a string in the format accepted by
-- [func/@gio@/.Action.parse_detailed_name].
toastSetDetailedActionName ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> Maybe (T.Text)
    -- ^ /@detailedActionName@/: the detailed action name
    -> m ()
toastSetDetailedActionName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> Maybe Text -> m ()
toastSetDetailedActionName a
self Maybe Text
detailedActionName = 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 Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeDetailedActionName <- case Maybe Text
detailedActionName of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jDetailedActionName -> do
            CString
jDetailedActionName' <- Text -> IO CString
textToCString Text
jDetailedActionName
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jDetailedActionName'
    Ptr Toast -> CString -> IO ()
adw_toast_set_detailed_action_name Ptr Toast
self' CString
maybeDetailedActionName
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeDetailedActionName
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToastSetDetailedActionNameMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsToast a) => O.OverloadedMethod ToastSetDetailedActionNameMethodInfo a signature where
    overloadedMethod = toastSetDetailedActionName

instance O.OverloadedMethodInfo ToastSetDetailedActionNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastSetDetailedActionName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastSetDetailedActionName"
        })


#endif

-- method Toast::set_priority
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "ToastPriority" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the priority" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_toast_set_priority" adw_toast_set_priority :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    CUInt ->                                -- priority : TInterface (Name {namespace = "Adw", name = "ToastPriority"})
    IO ()

-- | Sets priority for /@self@/.
-- 
-- Priority controls how the toast behaves when another toast is already
-- being displayed.
-- 
-- If /@priority@/ is @ADW_TOAST_PRIORITY_NORMAL@, the toast will be queued.
-- 
-- If /@priority@/ is @ADW_TOAST_PRIORITY_HIGH@, the toast will be displayed
-- immediately, pushing the previous toast into the queue instead.
toastSetPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> Adw.Enums.ToastPriority
    -- ^ /@priority@/: the priority
    -> m ()
toastSetPriority :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> ToastPriority -> m ()
toastSetPriority a
self ToastPriority
priority = 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 Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let priority' :: CUInt
priority' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ToastPriority -> Int) -> ToastPriority -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToastPriority -> Int
forall a. Enum a => a -> Int
fromEnum) ToastPriority
priority
    Ptr Toast -> CUInt -> IO ()
adw_toast_set_priority Ptr Toast
self' CUInt
priority'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToastSetPriorityMethodInfo
instance (signature ~ (Adw.Enums.ToastPriority -> m ()), MonadIO m, IsToast a) => O.OverloadedMethod ToastSetPriorityMethodInfo a signature where
    overloadedMethod = toastSetPriority

instance O.OverloadedMethodInfo ToastSetPriorityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastSetPriority",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastSetPriority"
        })


#endif

-- method Toast::set_timeout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the timeout" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_toast_set_timeout" adw_toast_set_timeout :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    Word32 ->                               -- timeout : TBasicType TUInt
    IO ()

-- | Sets timeout for /@self@/.
-- 
-- If /@timeout@/ is 0, the toast is displayed indefinitely until manually
-- dismissed.
-- 
-- Toasts cannot disappear while being hovered, pressed (on touchscreen), or
-- have keyboard focus inside them.
toastSetTimeout ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> Word32
    -- ^ /@timeout@/: the timeout
    -> m ()
toastSetTimeout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> Word32 -> m ()
toastSetTimeout a
self Word32
timeout = 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 Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Toast -> Word32 -> IO ()
adw_toast_set_timeout Ptr Toast
self' Word32
timeout
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToastSetTimeoutMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsToast a) => O.OverloadedMethod ToastSetTimeoutMethodInfo a signature where
    overloadedMethod = toastSetTimeout

instance O.OverloadedMethodInfo ToastSetTimeoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastSetTimeout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastSetTimeout"
        })


#endif

-- method Toast::set_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Toast" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a toast" , 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 title" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_toast_set_title" adw_toast_set_title :: 
    Ptr Toast ->                            -- self : TInterface (Name {namespace = "Adw", name = "Toast"})
    CString ->                              -- title : TBasicType TUTF8
    IO ()

-- | Sets the title that will be displayed on the toast.
-- 
-- The title can be marked up with the Pango text markup language.
-- 
-- Setting a title will unset [property/@toast@/:custom-title].
-- 
-- If [property/@toast@/:custom-title] is set, it will be used instead.
toastSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsToast a) =>
    a
    -- ^ /@self@/: a toast
    -> T.Text
    -- ^ /@title@/: a title
    -> m ()
toastSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsToast a) =>
a -> Text -> m ()
toastSetTitle a
self Text
title = 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 Toast
self' <- a -> IO (Ptr Toast)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr Toast -> CString -> IO ()
adw_toast_set_title Ptr Toast
self' CString
title'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ToastSetTitleMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsToast a) => O.OverloadedMethod ToastSetTitleMethodInfo a signature where
    overloadedMethod = toastSetTitle

instance O.OverloadedMethodInfo ToastSetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Toast.toastSetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Toast.html#v:toastSetTitle"
        })


#endif