{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GtkAlertDialog@ object collects the arguments that
-- are needed to present a message to the user.
-- 
-- The message is shown with the 'GI.Gtk.Objects.AlertDialog.alertDialogChoose'
-- function. This API follows the GIO async pattern, and the result can
-- be obtained by calling 'GI.Gtk.Objects.AlertDialog.alertDialogChooseFinish'.
-- 
-- If you don\'t need to wait for a button to be clicked, you can use
-- 'GI.Gtk.Objects.AlertDialog.alertDialogShow'.
-- 
-- /Since: 4.10/

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

module GI.Gtk.Objects.AlertDialog
    ( 

-- * Exported types
    AlertDialog(..)                         ,
    IsAlertDialog                           ,
    toAlertDialog                           ,


 -- * 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"), [choose]("GI.Gtk.Objects.AlertDialog#g:method:choose"), [chooseFinish]("GI.Gtk.Objects.AlertDialog#g:method:chooseFinish"), [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"), [show]("GI.Gtk.Objects.AlertDialog#g:method:show"), [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
-- [getButtons]("GI.Gtk.Objects.AlertDialog#g:method:getButtons"), [getCancelButton]("GI.Gtk.Objects.AlertDialog#g:method:getCancelButton"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDefaultButton]("GI.Gtk.Objects.AlertDialog#g:method:getDefaultButton"), [getDetail]("GI.Gtk.Objects.AlertDialog#g:method:getDetail"), [getMessage]("GI.Gtk.Objects.AlertDialog#g:method:getMessage"), [getModal]("GI.Gtk.Objects.AlertDialog#g:method:getModal"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setButtons]("GI.Gtk.Objects.AlertDialog#g:method:setButtons"), [setCancelButton]("GI.Gtk.Objects.AlertDialog#g:method:setCancelButton"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDefaultButton]("GI.Gtk.Objects.AlertDialog#g:method:setDefaultButton"), [setDetail]("GI.Gtk.Objects.AlertDialog#g:method:setDetail"), [setMessage]("GI.Gtk.Objects.AlertDialog#g:method:setMessage"), [setModal]("GI.Gtk.Objects.AlertDialog#g:method:setModal"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveAlertDialogMethod                ,
#endif

-- ** choose #method:choose#

#if defined(ENABLE_OVERLOADING)
    AlertDialogChooseMethodInfo             ,
#endif
    alertDialogChoose                       ,


-- ** chooseFinish #method:chooseFinish#

#if defined(ENABLE_OVERLOADING)
    AlertDialogChooseFinishMethodInfo       ,
#endif
    alertDialogChooseFinish                 ,


-- ** getButtons #method:getButtons#

#if defined(ENABLE_OVERLOADING)
    AlertDialogGetButtonsMethodInfo         ,
#endif
    alertDialogGetButtons                   ,


-- ** getCancelButton #method:getCancelButton#

#if defined(ENABLE_OVERLOADING)
    AlertDialogGetCancelButtonMethodInfo    ,
#endif
    alertDialogGetCancelButton              ,


-- ** getDefaultButton #method:getDefaultButton#

#if defined(ENABLE_OVERLOADING)
    AlertDialogGetDefaultButtonMethodInfo   ,
#endif
    alertDialogGetDefaultButton             ,


-- ** getDetail #method:getDetail#

#if defined(ENABLE_OVERLOADING)
    AlertDialogGetDetailMethodInfo          ,
#endif
    alertDialogGetDetail                    ,


-- ** getMessage #method:getMessage#

#if defined(ENABLE_OVERLOADING)
    AlertDialogGetMessageMethodInfo         ,
#endif
    alertDialogGetMessage                   ,


-- ** getModal #method:getModal#

#if defined(ENABLE_OVERLOADING)
    AlertDialogGetModalMethodInfo           ,
#endif
    alertDialogGetModal                     ,


-- ** setButtons #method:setButtons#

#if defined(ENABLE_OVERLOADING)
    AlertDialogSetButtonsMethodInfo         ,
#endif
    alertDialogSetButtons                   ,


-- ** setCancelButton #method:setCancelButton#

#if defined(ENABLE_OVERLOADING)
    AlertDialogSetCancelButtonMethodInfo    ,
#endif
    alertDialogSetCancelButton              ,


-- ** setDefaultButton #method:setDefaultButton#

#if defined(ENABLE_OVERLOADING)
    AlertDialogSetDefaultButtonMethodInfo   ,
#endif
    alertDialogSetDefaultButton             ,


-- ** setDetail #method:setDetail#

#if defined(ENABLE_OVERLOADING)
    AlertDialogSetDetailMethodInfo          ,
#endif
    alertDialogSetDetail                    ,


-- ** setMessage #method:setMessage#

#if defined(ENABLE_OVERLOADING)
    AlertDialogSetMessageMethodInfo         ,
#endif
    alertDialogSetMessage                   ,


-- ** setModal #method:setModal#

#if defined(ENABLE_OVERLOADING)
    AlertDialogSetModalMethodInfo           ,
#endif
    alertDialogSetModal                     ,


-- ** show #method:show#

#if defined(ENABLE_OVERLOADING)
    AlertDialogShowMethodInfo               ,
#endif
    alertDialogShow                         ,




 -- * Properties


-- ** buttons #attr:buttons#
-- | Labels for buttons to show in the alert.
-- 
-- The labels should be translated and may contain
-- a _ to indicate the mnemonic character.
-- 
-- If this property is not set, then a \'Close\' button is
-- automatically created.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    AlertDialogButtonsPropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    alertDialogButtons                      ,
#endif
    constructAlertDialogButtons             ,
    getAlertDialogButtons                   ,
    setAlertDialogButtons                   ,


-- ** cancelButton #attr:cancelButton#
-- | This property determines what happens when the Escape key is
-- pressed while the alert is shown.
-- 
-- If this property holds the index of a button in [AlertDialog:buttons]("GI.Gtk.Objects.AlertDialog#g:attr:buttons"),
-- then pressing Escape is treated as if that button was pressed. If it is -1
-- or not a valid index for the @buttons@ array, then an error is returned.
-- 
-- If @buttons@ is @NULL@, then the automatically created \'Close\' button
-- is treated as both cancel and default button, so 0 is returned.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    AlertDialogCancelButtonPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    alertDialogCancelButton                 ,
#endif
    constructAlertDialogCancelButton        ,
    getAlertDialogCancelButton              ,
    setAlertDialogCancelButton              ,


-- ** defaultButton #attr:defaultButton#
-- | This property determines what happens when the Return key is
-- pressed while the alert is shown.
-- 
-- If this property holds the index of a button in [AlertDialog:buttons]("GI.Gtk.Objects.AlertDialog#g:attr:buttons"),
-- then pressing Return is treated as if that button was pressed. If it is -1
-- or not a valid index for the @buttons@ array, then nothing happens.
-- 
-- If @buttons@ is @NULL@, then the automatically created \'Close\' button
-- is treated as both cancel and default button, so 0 is returned.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    AlertDialogDefaultButtonPropertyInfo    ,
#endif
#if defined(ENABLE_OVERLOADING)
    alertDialogDefaultButton                ,
#endif
    constructAlertDialogDefaultButton       ,
    getAlertDialogDefaultButton             ,
    setAlertDialogDefaultButton             ,


-- ** detail #attr:detail#
-- | The detail text for the alert.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    AlertDialogDetailPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    alertDialogDetail                       ,
#endif
    constructAlertDialogDetail              ,
    getAlertDialogDetail                    ,
    setAlertDialogDetail                    ,


-- ** message #attr:message#
-- | The message for the alert.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    AlertDialogMessagePropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    alertDialogMessage                      ,
#endif
    constructAlertDialogMessage             ,
    getAlertDialogMessage                   ,
    setAlertDialogMessage                   ,


-- ** modal #attr:modal#
-- | Whether the alert is modal.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    AlertDialogModalPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    alertDialogModal                        ,
#endif
    constructAlertDialogModal               ,
    getAlertDialogModal                     ,
    setAlertDialogModal                     ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Window as Gtk.Window

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

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

foreign import ccall "gtk_alert_dialog_get_type"
    c_gtk_alert_dialog_get_type :: IO B.Types.GType

instance B.Types.TypedObject AlertDialog where
    glibType :: IO GType
glibType = IO GType
c_gtk_alert_dialog_get_type

instance B.Types.GObject AlertDialog

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveAlertDialogMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveAlertDialogMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAlertDialogMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAlertDialogMethod "choose" o = AlertDialogChooseMethodInfo
    ResolveAlertDialogMethod "chooseFinish" o = AlertDialogChooseFinishMethodInfo
    ResolveAlertDialogMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAlertDialogMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAlertDialogMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAlertDialogMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAlertDialogMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAlertDialogMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAlertDialogMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAlertDialogMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAlertDialogMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAlertDialogMethod "show" o = AlertDialogShowMethodInfo
    ResolveAlertDialogMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAlertDialogMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAlertDialogMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAlertDialogMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAlertDialogMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAlertDialogMethod "getButtons" o = AlertDialogGetButtonsMethodInfo
    ResolveAlertDialogMethod "getCancelButton" o = AlertDialogGetCancelButtonMethodInfo
    ResolveAlertDialogMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAlertDialogMethod "getDefaultButton" o = AlertDialogGetDefaultButtonMethodInfo
    ResolveAlertDialogMethod "getDetail" o = AlertDialogGetDetailMethodInfo
    ResolveAlertDialogMethod "getMessage" o = AlertDialogGetMessageMethodInfo
    ResolveAlertDialogMethod "getModal" o = AlertDialogGetModalMethodInfo
    ResolveAlertDialogMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAlertDialogMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAlertDialogMethod "setButtons" o = AlertDialogSetButtonsMethodInfo
    ResolveAlertDialogMethod "setCancelButton" o = AlertDialogSetCancelButtonMethodInfo
    ResolveAlertDialogMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAlertDialogMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAlertDialogMethod "setDefaultButton" o = AlertDialogSetDefaultButtonMethodInfo
    ResolveAlertDialogMethod "setDetail" o = AlertDialogSetDetailMethodInfo
    ResolveAlertDialogMethod "setMessage" o = AlertDialogSetMessageMethodInfo
    ResolveAlertDialogMethod "setModal" o = AlertDialogSetModalMethodInfo
    ResolveAlertDialogMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAlertDialogMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

-- | Get the value of the “@buttons@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' alertDialog #buttons
-- @
getAlertDialogButtons :: (MonadIO m, IsAlertDialog o) => o -> m (Maybe [T.Text])
getAlertDialogButtons :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> m (Maybe [Text])
getAlertDialogButtons 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.getObjectPropertyStringArray o
obj String
"buttons"

-- | Set the value of the “@buttons@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' alertDialog [ #buttons 'Data.GI.Base.Attributes.:=' value ]
-- @
setAlertDialogButtons :: (MonadIO m, IsAlertDialog o) => o -> [T.Text] -> m ()
setAlertDialogButtons :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> [Text] -> m ()
setAlertDialogButtons 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.setObjectPropertyStringArray o
obj String
"buttons" ([Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
val)

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

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

-- VVV Prop "cancel-button"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@cancel-button@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' alertDialog [ #cancelButton 'Data.GI.Base.Attributes.:=' value ]
-- @
setAlertDialogCancelButton :: (MonadIO m, IsAlertDialog o) => o -> Int32 -> m ()
setAlertDialogCancelButton :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> Int32 -> m ()
setAlertDialogCancelButton o
obj Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"cancel-button" Int32
val

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

#if defined(ENABLE_OVERLOADING)
data AlertDialogCancelButtonPropertyInfo
instance AttrInfo AlertDialogCancelButtonPropertyInfo where
    type AttrAllowedOps AlertDialogCancelButtonPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AlertDialogCancelButtonPropertyInfo = IsAlertDialog
    type AttrSetTypeConstraint AlertDialogCancelButtonPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint AlertDialogCancelButtonPropertyInfo = (~) Int32
    type AttrTransferType AlertDialogCancelButtonPropertyInfo = Int32
    type AttrGetType AlertDialogCancelButtonPropertyInfo = Int32
    type AttrLabel AlertDialogCancelButtonPropertyInfo = "cancel-button"
    type AttrOrigin AlertDialogCancelButtonPropertyInfo = AlertDialog
    attrGet = getAlertDialogCancelButton
    attrSet = setAlertDialogCancelButton
    attrTransfer _ v = do
        return v
    attrConstruct = constructAlertDialogCancelButton
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.AlertDialog.cancelButton"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-AlertDialog.html#g:attr:cancelButton"
        })
#endif

-- VVV Prop "default-button"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@default-button@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' alertDialog [ #defaultButton 'Data.GI.Base.Attributes.:=' value ]
-- @
setAlertDialogDefaultButton :: (MonadIO m, IsAlertDialog o) => o -> Int32 -> m ()
setAlertDialogDefaultButton :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> Int32 -> m ()
setAlertDialogDefaultButton o
obj Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"default-button" Int32
val

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

#if defined(ENABLE_OVERLOADING)
data AlertDialogDefaultButtonPropertyInfo
instance AttrInfo AlertDialogDefaultButtonPropertyInfo where
    type AttrAllowedOps AlertDialogDefaultButtonPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AlertDialogDefaultButtonPropertyInfo = IsAlertDialog
    type AttrSetTypeConstraint AlertDialogDefaultButtonPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint AlertDialogDefaultButtonPropertyInfo = (~) Int32
    type AttrTransferType AlertDialogDefaultButtonPropertyInfo = Int32
    type AttrGetType AlertDialogDefaultButtonPropertyInfo = Int32
    type AttrLabel AlertDialogDefaultButtonPropertyInfo = "default-button"
    type AttrOrigin AlertDialogDefaultButtonPropertyInfo = AlertDialog
    attrGet = getAlertDialogDefaultButton
    attrSet = setAlertDialogDefaultButton
    attrTransfer _ v = do
        return v
    attrConstruct = constructAlertDialogDefaultButton
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.AlertDialog.defaultButton"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-AlertDialog.html#g:attr:defaultButton"
        })
#endif

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

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

-- | Set the value of the “@detail@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' alertDialog [ #detail 'Data.GI.Base.Attributes.:=' value ]
-- @
setAlertDialogDetail :: (MonadIO m, IsAlertDialog o) => o -> T.Text -> m ()
setAlertDialogDetail :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> Text -> m ()
setAlertDialogDetail 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
"detail" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

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

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

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

-- | Set the value of the “@message@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' alertDialog [ #message 'Data.GI.Base.Attributes.:=' value ]
-- @
setAlertDialogMessage :: (MonadIO m, IsAlertDialog o) => o -> T.Text -> m ()
setAlertDialogMessage :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> Text -> m ()
setAlertDialogMessage 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
"message" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

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

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AlertDialog
type instance O.AttributeList AlertDialog = AlertDialogAttributeList
type AlertDialogAttributeList = ('[ '("buttons", AlertDialogButtonsPropertyInfo), '("cancelButton", AlertDialogCancelButtonPropertyInfo), '("defaultButton", AlertDialogDefaultButtonPropertyInfo), '("detail", AlertDialogDetailPropertyInfo), '("message", AlertDialogMessagePropertyInfo), '("modal", AlertDialogModalPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
alertDialogButtons :: AttrLabelProxy "buttons"
alertDialogButtons = AttrLabelProxy

alertDialogCancelButton :: AttrLabelProxy "cancelButton"
alertDialogCancelButton = AttrLabelProxy

alertDialogDefaultButton :: AttrLabelProxy "defaultButton"
alertDialogDefaultButton = AttrLabelProxy

alertDialogDetail :: AttrLabelProxy "detail"
alertDialogDetail = AttrLabelProxy

alertDialogMessage :: AttrLabelProxy "message"
alertDialogMessage = AttrLabelProxy

alertDialogModal :: AttrLabelProxy "modal"
alertDialogModal = AttrLabelProxy

#endif

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

#endif

-- method AlertDialog::choose
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AlertDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAlertDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent `GtkWindow`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GCancellable` to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a callback to call when the operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_alert_dialog_choose" gtk_alert_dialog_choose :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | This function shows the alert to the user.
-- 
-- The /@callback@/ will be called when the alert is dismissed.
-- It should call 'GI.Gtk.Objects.AlertDialog.alertDialogChooseFinish'
-- to obtain the result.
-- 
-- It is ok to pass @NULL@ for the callback if the alert
-- does not have more than one button. A simpler API for
-- this case is 'GI.Gtk.Objects.AlertDialog.alertDialogShow'.
-- 
-- /Since: 4.10/
alertDialogChoose ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> Maybe (b)
    -- ^ /@parent@/: the parent @GtkWindow@
    -> Maybe (c)
    -- ^ /@cancellable@/: a @GCancellable@ to cancel the operation
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to call when the operation is complete
    -> m ()
alertDialogChoose :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsAlertDialog a, IsWindow b,
 IsCancellable c) =>
a -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
alertDialogChoose a
self Maybe b
parent Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Window
maybeParent <- case Maybe b
parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
nullPtr
        Just b
jParent -> do
            Ptr Window
jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
jParent'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr AlertDialog
-> Ptr Window
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_alert_dialog_choose Ptr AlertDialog
self' Ptr Window
maybeParent Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    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
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> 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 AlertDialogChooseMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsAlertDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod AlertDialogChooseMethodInfo a signature where
    overloadedMethod = alertDialogChoose

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


#endif

-- method AlertDialog::choose_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AlertDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAlertDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GAsyncResult`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : True
-- Skip return : False

foreign import ccall "gtk_alert_dialog_choose_finish" gtk_alert_dialog_choose_finish :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO Int32

-- | Finishes the 'GI.Gtk.Objects.AlertDialog.alertDialogChoose' call
-- and returns the index of the button that was clicked.
-- 
-- /Since: 4.10/
alertDialogChooseFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m Int32
    -- ^ __Returns:__ the index of the button that was clicked, or -1 if
    --   the dialog was cancelled and \`[AlertDialog:cancelButton]("GI.Gtk.Objects.AlertDialog#g:attr:cancelButton")
    --   is not set /(Can throw 'Data.GI.Base.GError.GError')/
alertDialogChooseFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAlertDialog a, IsAsyncResult b) =>
a -> b -> m Int32
alertDialogChooseFinish a
self b
result_ = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO Int32 -> IO () -> IO Int32
forall a b. IO a -> IO b -> IO a
onException (do
        Int32
result <- (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int32) -> IO Int32)
-> (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ Ptr AlertDialog -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO Int32
gtk_alert_dialog_choose_finish Ptr AlertDialog
self' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data AlertDialogChooseFinishMethodInfo
instance (signature ~ (b -> m Int32), MonadIO m, IsAlertDialog a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod AlertDialogChooseFinishMethodInfo a signature where
    overloadedMethod = alertDialogChooseFinish

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


#endif

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

foreign import ccall "gtk_alert_dialog_get_buttons" gtk_alert_dialog_get_buttons :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    IO (Ptr CString)

-- | Returns the button labels for the alert.
-- 
-- /Since: 4.10/
alertDialogGetButtons ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> m (Maybe [T.Text])
    -- ^ __Returns:__ the button labels
alertDialogGetButtons :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> m (Maybe [Text])
alertDialogGetButtons 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 AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
result <- Ptr AlertDialog -> IO (Ptr CString)
gtk_alert_dialog_get_buttons Ptr AlertDialog
self'
    Maybe [Text]
maybeResult <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CString
result ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
result' -> do
        [Text]
result'' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr 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 AlertDialogGetButtonsMethodInfo
instance (signature ~ (m (Maybe [T.Text])), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetButtonsMethodInfo a signature where
    overloadedMethod = alertDialogGetButtons

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


#endif

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

foreign import ccall "gtk_alert_dialog_get_cancel_button" gtk_alert_dialog_get_cancel_button :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    IO Int32

-- | Returns the index of the cancel button.
-- 
-- /Since: 4.10/
alertDialogGetCancelButton ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> m Int32
    -- ^ __Returns:__ the index of the cancel button, or -1
alertDialogGetCancelButton :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> m Int32
alertDialogGetCancelButton a
self = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr AlertDialog -> IO Int32
gtk_alert_dialog_get_cancel_button Ptr AlertDialog
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data AlertDialogGetCancelButtonMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetCancelButtonMethodInfo a signature where
    overloadedMethod = alertDialogGetCancelButton

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


#endif

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

foreign import ccall "gtk_alert_dialog_get_default_button" gtk_alert_dialog_get_default_button :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    IO Int32

-- | Returns the index of the default button.
-- 
-- /Since: 4.10/
alertDialogGetDefaultButton ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> m Int32
    -- ^ __Returns:__ the index of the default button, or -1
alertDialogGetDefaultButton :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> m Int32
alertDialogGetDefaultButton a
self = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr AlertDialog -> IO Int32
gtk_alert_dialog_get_default_button Ptr AlertDialog
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data AlertDialogGetDefaultButtonMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetDefaultButtonMethodInfo a signature where
    overloadedMethod = alertDialogGetDefaultButton

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


#endif

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

foreign import ccall "gtk_alert_dialog_get_detail" gtk_alert_dialog_get_detail :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    IO CString

-- | Returns the detail text that will be shown in the alert.
-- 
-- /Since: 4.10/
alertDialogGetDetail ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> m T.Text
    -- ^ __Returns:__ the detail text
alertDialogGetDetail :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> m Text
alertDialogGetDetail a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr AlertDialog -> IO CString
gtk_alert_dialog_get_detail Ptr AlertDialog
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"alertDialogGetDetail" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AlertDialogGetDetailMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetDetailMethodInfo a signature where
    overloadedMethod = alertDialogGetDetail

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


#endif

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

foreign import ccall "gtk_alert_dialog_get_message" gtk_alert_dialog_get_message :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    IO CString

-- | Returns the message that will be shown in the alert.
-- 
-- /Since: 4.10/
alertDialogGetMessage ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> m T.Text
    -- ^ __Returns:__ the message
alertDialogGetMessage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> m Text
alertDialogGetMessage a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr AlertDialog -> IO CString
gtk_alert_dialog_get_message Ptr AlertDialog
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"alertDialogGetMessage" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AlertDialogGetMessageMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetMessageMethodInfo a signature where
    overloadedMethod = alertDialogGetMessage

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


#endif

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

foreign import ccall "gtk_alert_dialog_get_modal" gtk_alert_dialog_get_modal :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    IO CInt

-- | Returns whether the alert blocks interaction
-- with the parent window while it is presented.
-- 
-- /Since: 4.10/
alertDialogGetModal ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the alert is modal
alertDialogGetModal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> m Bool
alertDialogGetModal a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr AlertDialog -> IO CInt
gtk_alert_dialog_get_modal Ptr AlertDialog
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AlertDialogGetModalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetModalMethodInfo a signature where
    overloadedMethod = alertDialogGetModal

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


#endif

-- method AlertDialog::set_buttons
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AlertDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAlertDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "labels"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new button labels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_alert_dialog_set_buttons" gtk_alert_dialog_set_buttons :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    Ptr CString ->                          -- labels : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO ()

-- | Sets the button labels for the alert.
-- 
-- /Since: 4.10/
alertDialogSetButtons ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> [T.Text]
    -- ^ /@labels@/: the new button labels
    -> m ()
alertDialogSetButtons :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> [Text] -> m ()
alertDialogSetButtons a
self [Text]
labels = 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 AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
labels' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
labels
    Ptr AlertDialog -> Ptr CString -> IO ()
gtk_alert_dialog_set_buttons Ptr AlertDialog
self' Ptr CString
labels'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
labels'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
labels'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AlertDialogSetButtonsMethodInfo
instance (signature ~ ([T.Text] -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogSetButtonsMethodInfo a signature where
    overloadedMethod = alertDialogSetButtons

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


#endif

-- method AlertDialog::set_cancel_button
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AlertDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAlertDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "button"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new cancel button"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_alert_dialog_set_cancel_button" gtk_alert_dialog_set_cancel_button :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    Int32 ->                                -- button : TBasicType TInt
    IO ()

-- | Sets the index of the cancel button.
-- 
-- See [AlertDialog:cancelButton]("GI.Gtk.Objects.AlertDialog#g:attr:cancelButton") for
-- details of how this value is used.
-- 
-- /Since: 4.10/
alertDialogSetCancelButton ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> Int32
    -- ^ /@button@/: the new cancel button
    -> m ()
alertDialogSetCancelButton :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Int32 -> m ()
alertDialogSetCancelButton a
self Int32
button = 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 AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AlertDialog -> Int32 -> IO ()
gtk_alert_dialog_set_cancel_button Ptr AlertDialog
self' Int32
button
    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 AlertDialogSetCancelButtonMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogSetCancelButtonMethodInfo a signature where
    overloadedMethod = alertDialogSetCancelButton

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


#endif

-- method AlertDialog::set_default_button
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AlertDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAlertDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "button"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new default button"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_alert_dialog_set_default_button" gtk_alert_dialog_set_default_button :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    Int32 ->                                -- button : TBasicType TInt
    IO ()

-- | Sets the index of the default button.
-- 
-- See [AlertDialog:defaultButton]("GI.Gtk.Objects.AlertDialog#g:attr:defaultButton") for
-- details of how this value is used.
-- 
-- /Since: 4.10/
alertDialogSetDefaultButton ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> Int32
    -- ^ /@button@/: the new default button
    -> m ()
alertDialogSetDefaultButton :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Int32 -> m ()
alertDialogSetDefaultButton a
self Int32
button = 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 AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AlertDialog -> Int32 -> IO ()
gtk_alert_dialog_set_default_button Ptr AlertDialog
self' Int32
button
    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 AlertDialogSetDefaultButtonMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogSetDefaultButtonMethodInfo a signature where
    overloadedMethod = alertDialogSetDefaultButton

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


#endif

-- method AlertDialog::set_detail
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AlertDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAlertDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "detail"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new detail text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_alert_dialog_set_detail" gtk_alert_dialog_set_detail :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    CString ->                              -- detail : TBasicType TUTF8
    IO ()

-- | Sets the detail text that will be shown in the alert.
-- 
-- /Since: 4.10/
alertDialogSetDetail ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> T.Text
    -- ^ /@detail@/: the new detail text
    -> m ()
alertDialogSetDetail :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Text -> m ()
alertDialogSetDetail a
self Text
detail = 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 AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
detail' <- Text -> IO CString
textToCString Text
detail
    Ptr AlertDialog -> CString -> IO ()
gtk_alert_dialog_set_detail Ptr AlertDialog
self' CString
detail'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
detail'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method AlertDialog::set_message
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AlertDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAlertDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "message"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new message" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_alert_dialog_set_message" gtk_alert_dialog_set_message :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    CString ->                              -- message : TBasicType TUTF8
    IO ()

-- | Sets the message that will be shown in the alert.
-- 
-- /Since: 4.10/
alertDialogSetMessage ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> T.Text
    -- ^ /@message@/: the new message
    -> m ()
alertDialogSetMessage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Text -> m ()
alertDialogSetMessage a
self Text
message = 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 AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
message' <- Text -> IO CString
textToCString Text
message
    Ptr AlertDialog -> CString -> IO ()
gtk_alert_dialog_set_message Ptr AlertDialog
self' CString
message'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
message'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method AlertDialog::set_modal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AlertDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAlertDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modal"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_alert_dialog_set_modal" gtk_alert_dialog_set_modal :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    CInt ->                                 -- modal : TBasicType TBoolean
    IO ()

-- | Sets whether the alert blocks interaction
-- with the parent window while it is presented.
-- 
-- /Since: 4.10/
alertDialogSetModal ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> Bool
    -- ^ /@modal@/: the new value
    -> m ()
alertDialogSetModal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Bool -> m ()
alertDialogSetModal a
self Bool
modal = 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 AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let modal' :: CInt
modal' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
modal
    Ptr AlertDialog -> CInt -> IO ()
gtk_alert_dialog_set_modal Ptr AlertDialog
self' CInt
modal'
    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 AlertDialogSetModalMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogSetModalMethodInfo a signature where
    overloadedMethod = alertDialogSetModal

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


#endif

-- method AlertDialog::show
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AlertDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAlertDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent `GtkWindow`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_alert_dialog_show" gtk_alert_dialog_show :: 
    Ptr AlertDialog ->                      -- self : TInterface (Name {namespace = "Gtk", name = "AlertDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    IO ()

-- | Show the alert to the user.
-- 
-- This function is a simple version of 'GI.Gtk.Objects.AlertDialog.alertDialogChoose'
-- intended for dialogs with a single button.
-- If you want to cancel the dialog or if the alert has more than one button,
-- you should use that function instead and provide it with a t'GI.Gio.Objects.Cancellable.Cancellable' or
-- callback respectively.
-- 
-- /Since: 4.10/
alertDialogShow ::
    (B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a, Gtk.Window.IsWindow b) =>
    a
    -- ^ /@self@/: a @GtkAlertDialog@
    -> Maybe (b)
    -- ^ /@parent@/: the parent @GtkWindow@
    -> m ()
alertDialogShow :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAlertDialog a, IsWindow b) =>
a -> Maybe b -> m ()
alertDialogShow a
self Maybe b
parent = 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 AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Window
maybeParent <- case Maybe b
parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
nullPtr
        Just b
jParent -> do
            Ptr Window
jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
jParent'
    Ptr AlertDialog -> Ptr Window -> IO ()
gtk_alert_dialog_show Ptr AlertDialog
self' Ptr Window
maybeParent
    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
parent 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 AlertDialogShowMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsAlertDialog a, Gtk.Window.IsWindow b) => O.OverloadedMethod AlertDialogShowMethodInfo a signature where
    overloadedMethod = alertDialogShow

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


#endif