{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Adw.Objects.AlertDialog
(
AlertDialog(..) ,
IsAlertDialog ,
toAlertDialog ,
#if defined(ENABLE_OVERLOADING)
ResolveAlertDialogMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
AlertDialogAddResponseMethodInfo ,
#endif
alertDialogAddResponse ,
#if defined(ENABLE_OVERLOADING)
AlertDialogChooseMethodInfo ,
#endif
alertDialogChoose ,
#if defined(ENABLE_OVERLOADING)
AlertDialogChooseFinishMethodInfo ,
#endif
alertDialogChooseFinish ,
#if defined(ENABLE_OVERLOADING)
AlertDialogGetBodyMethodInfo ,
#endif
alertDialogGetBody ,
#if defined(ENABLE_OVERLOADING)
AlertDialogGetBodyUseMarkupMethodInfo ,
#endif
alertDialogGetBodyUseMarkup ,
#if defined(ENABLE_OVERLOADING)
AlertDialogGetCloseResponseMethodInfo ,
#endif
alertDialogGetCloseResponse ,
#if defined(ENABLE_OVERLOADING)
AlertDialogGetDefaultResponseMethodInfo ,
#endif
alertDialogGetDefaultResponse ,
#if defined(ENABLE_OVERLOADING)
AlertDialogGetExtraChildMethodInfo ,
#endif
alertDialogGetExtraChild ,
#if defined(ENABLE_OVERLOADING)
AlertDialogGetHeadingMethodInfo ,
#endif
alertDialogGetHeading ,
#if defined(ENABLE_OVERLOADING)
AlertDialogGetHeadingUseMarkupMethodInfo,
#endif
alertDialogGetHeadingUseMarkup ,
#if defined(ENABLE_OVERLOADING)
AlertDialogGetResponseAppearanceMethodInfo,
#endif
alertDialogGetResponseAppearance ,
#if defined(ENABLE_OVERLOADING)
AlertDialogGetResponseEnabledMethodInfo ,
#endif
alertDialogGetResponseEnabled ,
#if defined(ENABLE_OVERLOADING)
AlertDialogGetResponseLabelMethodInfo ,
#endif
alertDialogGetResponseLabel ,
#if defined(ENABLE_OVERLOADING)
AlertDialogHasResponseMethodInfo ,
#endif
alertDialogHasResponse ,
alertDialogNew ,
#if defined(ENABLE_OVERLOADING)
AlertDialogRemoveResponseMethodInfo ,
#endif
alertDialogRemoveResponse ,
#if defined(ENABLE_OVERLOADING)
AlertDialogSetBodyMethodInfo ,
#endif
alertDialogSetBody ,
#if defined(ENABLE_OVERLOADING)
AlertDialogSetBodyUseMarkupMethodInfo ,
#endif
alertDialogSetBodyUseMarkup ,
#if defined(ENABLE_OVERLOADING)
AlertDialogSetCloseResponseMethodInfo ,
#endif
alertDialogSetCloseResponse ,
#if defined(ENABLE_OVERLOADING)
AlertDialogSetDefaultResponseMethodInfo ,
#endif
alertDialogSetDefaultResponse ,
#if defined(ENABLE_OVERLOADING)
AlertDialogSetExtraChildMethodInfo ,
#endif
alertDialogSetExtraChild ,
#if defined(ENABLE_OVERLOADING)
AlertDialogSetHeadingMethodInfo ,
#endif
alertDialogSetHeading ,
#if defined(ENABLE_OVERLOADING)
AlertDialogSetHeadingUseMarkupMethodInfo,
#endif
alertDialogSetHeadingUseMarkup ,
#if defined(ENABLE_OVERLOADING)
AlertDialogSetResponseAppearanceMethodInfo,
#endif
alertDialogSetResponseAppearance ,
#if defined(ENABLE_OVERLOADING)
AlertDialogSetResponseEnabledMethodInfo ,
#endif
alertDialogSetResponseEnabled ,
#if defined(ENABLE_OVERLOADING)
AlertDialogSetResponseLabelMethodInfo ,
#endif
alertDialogSetResponseLabel ,
#if defined(ENABLE_OVERLOADING)
AlertDialogBodyPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
alertDialogBody ,
#endif
constructAlertDialogBody ,
getAlertDialogBody ,
setAlertDialogBody ,
#if defined(ENABLE_OVERLOADING)
AlertDialogBodyUseMarkupPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
alertDialogBodyUseMarkup ,
#endif
constructAlertDialogBodyUseMarkup ,
getAlertDialogBodyUseMarkup ,
setAlertDialogBodyUseMarkup ,
#if defined(ENABLE_OVERLOADING)
AlertDialogCloseResponsePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
alertDialogCloseResponse ,
#endif
constructAlertDialogCloseResponse ,
getAlertDialogCloseResponse ,
setAlertDialogCloseResponse ,
#if defined(ENABLE_OVERLOADING)
AlertDialogDefaultResponsePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
alertDialogDefaultResponse ,
#endif
clearAlertDialogDefaultResponse ,
constructAlertDialogDefaultResponse ,
getAlertDialogDefaultResponse ,
setAlertDialogDefaultResponse ,
#if defined(ENABLE_OVERLOADING)
AlertDialogExtraChildPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
alertDialogExtraChild ,
#endif
clearAlertDialogExtraChild ,
constructAlertDialogExtraChild ,
getAlertDialogExtraChild ,
setAlertDialogExtraChild ,
#if defined(ENABLE_OVERLOADING)
AlertDialogHeadingPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
alertDialogHeading ,
#endif
clearAlertDialogHeading ,
constructAlertDialogHeading ,
getAlertDialogHeading ,
setAlertDialogHeading ,
#if defined(ENABLE_OVERLOADING)
AlertDialogHeadingUseMarkupPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
alertDialogHeadingUseMarkup ,
#endif
constructAlertDialogHeadingUseMarkup ,
getAlertDialogHeadingUseMarkup ,
setAlertDialogHeadingUseMarkup ,
AlertDialogResponseCallback ,
#if defined(ENABLE_OVERLOADING)
AlertDialogResponseSignalInfo ,
#endif
afterAlertDialogResponse ,
onAlertDialogResponse ,
) 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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT
#if MIN_VERSION_base(4,18,0)
import {-# SOURCE #-} qualified GI.Adw.Enums as Adw.Enums
import {-# SOURCE #-} qualified GI.Adw.Objects.Breakpoint as Adw.Breakpoint
import {-# SOURCE #-} qualified GI.Adw.Objects.Dialog as Adw.Dialog
import {-# SOURCE #-} qualified GI.Adw.Structs.BreakpointCondition as Adw.BreakpointCondition
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 qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import qualified GI.Gtk.Objects.Widget as Gtk.Widget
#else
import {-# SOURCE #-} qualified GI.Adw.Enums as Adw.Enums
import {-# SOURCE #-} qualified GI.Adw.Objects.Dialog as Adw.Dialog
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 qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import qualified GI.Gtk.Objects.Widget as Gtk.Widget
#endif
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 "adw_alert_dialog_get_type"
c_adw_alert_dialog_get_type :: IO B.Types.GType
instance B.Types.TypedObject AlertDialog where
glibType :: IO GType
glibType = IO GType
c_adw_alert_dialog_get_type
instance B.Types.GObject AlertDialog
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 = '[Adw.Dialog.Dialog, Gtk.Widget.Widget, GObject.Object.Object, Gtk.Accessible.Accessible, Gtk.Buildable.Buildable, Gtk.ConstraintTarget.ConstraintTarget]
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
instance B.GValue.IsGValue (Maybe AlertDialog) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_adw_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 "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
ResolveAlertDialogMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
ResolveAlertDialogMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
ResolveAlertDialogMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
ResolveAlertDialogMethod "addBreakpoint" o = Adw.Dialog.DialogAddBreakpointMethodInfo
ResolveAlertDialogMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
ResolveAlertDialogMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
ResolveAlertDialogMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
ResolveAlertDialogMethod "addResponse" o = AlertDialogAddResponseMethodInfo
ResolveAlertDialogMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
ResolveAlertDialogMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
ResolveAlertDialogMethod "announce" o = Gtk.Accessible.AccessibleAnnounceMethodInfo
ResolveAlertDialogMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveAlertDialogMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveAlertDialogMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
ResolveAlertDialogMethod "choose" o = AlertDialogChooseMethodInfo
ResolveAlertDialogMethod "chooseFinish" o = AlertDialogChooseFinishMethodInfo
ResolveAlertDialogMethod "close" o = Adw.Dialog.DialogCloseMethodInfo
ResolveAlertDialogMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
ResolveAlertDialogMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
ResolveAlertDialogMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
ResolveAlertDialogMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
ResolveAlertDialogMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
ResolveAlertDialogMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
ResolveAlertDialogMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
ResolveAlertDialogMethod "disposeTemplate" o = Gtk.Widget.WidgetDisposeTemplateMethodInfo
ResolveAlertDialogMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
ResolveAlertDialogMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
ResolveAlertDialogMethod "forceClose" o = Adw.Dialog.DialogForceCloseMethodInfo
ResolveAlertDialogMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveAlertDialogMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveAlertDialogMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveAlertDialogMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
ResolveAlertDialogMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
ResolveAlertDialogMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
ResolveAlertDialogMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
ResolveAlertDialogMethod "hasResponse" o = AlertDialogHasResponseMethodInfo
ResolveAlertDialogMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
ResolveAlertDialogMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
ResolveAlertDialogMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
ResolveAlertDialogMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
ResolveAlertDialogMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
ResolveAlertDialogMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
ResolveAlertDialogMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
ResolveAlertDialogMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
ResolveAlertDialogMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
ResolveAlertDialogMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveAlertDialogMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
ResolveAlertDialogMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
ResolveAlertDialogMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
ResolveAlertDialogMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
ResolveAlertDialogMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
ResolveAlertDialogMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
ResolveAlertDialogMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
ResolveAlertDialogMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
ResolveAlertDialogMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveAlertDialogMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveAlertDialogMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
ResolveAlertDialogMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
ResolveAlertDialogMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
ResolveAlertDialogMethod "present" o = Adw.Dialog.DialogPresentMethodInfo
ResolveAlertDialogMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
ResolveAlertDialogMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
ResolveAlertDialogMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
ResolveAlertDialogMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
ResolveAlertDialogMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveAlertDialogMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveAlertDialogMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
ResolveAlertDialogMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
ResolveAlertDialogMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
ResolveAlertDialogMethod "removeResponse" o = AlertDialogRemoveResponseMethodInfo
ResolveAlertDialogMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
ResolveAlertDialogMethod "resetProperty" o = Gtk.Accessible.AccessibleResetPropertyMethodInfo
ResolveAlertDialogMethod "resetRelation" o = Gtk.Accessible.AccessibleResetRelationMethodInfo
ResolveAlertDialogMethod "resetState" o = Gtk.Accessible.AccessibleResetStateMethodInfo
ResolveAlertDialogMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveAlertDialogMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
ResolveAlertDialogMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
ResolveAlertDialogMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
ResolveAlertDialogMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
ResolveAlertDialogMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveAlertDialogMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveAlertDialogMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveAlertDialogMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
ResolveAlertDialogMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
ResolveAlertDialogMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
ResolveAlertDialogMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
ResolveAlertDialogMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
ResolveAlertDialogMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveAlertDialogMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
ResolveAlertDialogMethod "updateNextAccessibleSibling" o = Gtk.Accessible.AccessibleUpdateNextAccessibleSiblingMethodInfo
ResolveAlertDialogMethod "updateProperty" o = Gtk.Accessible.AccessibleUpdatePropertyMethodInfo
ResolveAlertDialogMethod "updateRelation" o = Gtk.Accessible.AccessibleUpdateRelationMethodInfo
ResolveAlertDialogMethod "updateState" o = Gtk.Accessible.AccessibleUpdateStateMethodInfo
ResolveAlertDialogMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveAlertDialogMethod "getAccessibleParent" o = Gtk.Accessible.AccessibleGetAccessibleParentMethodInfo
ResolveAlertDialogMethod "getAccessibleRole" o = Gtk.Accessible.AccessibleGetAccessibleRoleMethodInfo
ResolveAlertDialogMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
ResolveAlertDialogMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
ResolveAlertDialogMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
ResolveAlertDialogMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
ResolveAlertDialogMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
ResolveAlertDialogMethod "getAtContext" o = Gtk.Accessible.AccessibleGetAtContextMethodInfo
ResolveAlertDialogMethod "getBaseline" o = Gtk.Widget.WidgetGetBaselineMethodInfo
ResolveAlertDialogMethod "getBody" o = AlertDialogGetBodyMethodInfo
ResolveAlertDialogMethod "getBodyUseMarkup" o = AlertDialogGetBodyUseMarkupMethodInfo
ResolveAlertDialogMethod "getBounds" o = Gtk.Accessible.AccessibleGetBoundsMethodInfo
ResolveAlertDialogMethod "getBuildableId" o = Gtk.Buildable.BuildableGetBuildableIdMethodInfo
ResolveAlertDialogMethod "getCanClose" o = Adw.Dialog.DialogGetCanCloseMethodInfo
ResolveAlertDialogMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
ResolveAlertDialogMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
ResolveAlertDialogMethod "getChild" o = Adw.Dialog.DialogGetChildMethodInfo
ResolveAlertDialogMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
ResolveAlertDialogMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
ResolveAlertDialogMethod "getCloseResponse" o = AlertDialogGetCloseResponseMethodInfo
ResolveAlertDialogMethod "getColor" o = Gtk.Widget.WidgetGetColorMethodInfo
ResolveAlertDialogMethod "getContentHeight" o = Adw.Dialog.DialogGetContentHeightMethodInfo
ResolveAlertDialogMethod "getContentWidth" o = Adw.Dialog.DialogGetContentWidthMethodInfo
ResolveAlertDialogMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
ResolveAlertDialogMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
ResolveAlertDialogMethod "getCurrentBreakpoint" o = Adw.Dialog.DialogGetCurrentBreakpointMethodInfo
ResolveAlertDialogMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
ResolveAlertDialogMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveAlertDialogMethod "getDefaultResponse" o = AlertDialogGetDefaultResponseMethodInfo
ResolveAlertDialogMethod "getDefaultWidget" o = Adw.Dialog.DialogGetDefaultWidgetMethodInfo
ResolveAlertDialogMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
ResolveAlertDialogMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
ResolveAlertDialogMethod "getExtraChild" o = AlertDialogGetExtraChildMethodInfo
ResolveAlertDialogMethod "getFirstAccessibleChild" o = Gtk.Accessible.AccessibleGetFirstAccessibleChildMethodInfo
ResolveAlertDialogMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
ResolveAlertDialogMethod "getFocus" o = Adw.Dialog.DialogGetFocusMethodInfo
ResolveAlertDialogMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
ResolveAlertDialogMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
ResolveAlertDialogMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
ResolveAlertDialogMethod "getFollowsContentSize" o = Adw.Dialog.DialogGetFollowsContentSizeMethodInfo
ResolveAlertDialogMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
ResolveAlertDialogMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
ResolveAlertDialogMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
ResolveAlertDialogMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
ResolveAlertDialogMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
ResolveAlertDialogMethod "getHeading" o = AlertDialogGetHeadingMethodInfo
ResolveAlertDialogMethod "getHeadingUseMarkup" o = AlertDialogGetHeadingUseMarkupMethodInfo
ResolveAlertDialogMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
ResolveAlertDialogMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
ResolveAlertDialogMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
ResolveAlertDialogMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
ResolveAlertDialogMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
ResolveAlertDialogMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
ResolveAlertDialogMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
ResolveAlertDialogMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
ResolveAlertDialogMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
ResolveAlertDialogMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
ResolveAlertDialogMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
ResolveAlertDialogMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
ResolveAlertDialogMethod "getNextAccessibleSibling" o = Gtk.Accessible.AccessibleGetNextAccessibleSiblingMethodInfo
ResolveAlertDialogMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
ResolveAlertDialogMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
ResolveAlertDialogMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
ResolveAlertDialogMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
ResolveAlertDialogMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
ResolveAlertDialogMethod "getPlatformState" o = Gtk.Accessible.AccessibleGetPlatformStateMethodInfo
ResolveAlertDialogMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
ResolveAlertDialogMethod "getPresentationMode" o = Adw.Dialog.DialogGetPresentationModeMethodInfo
ResolveAlertDialogMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
ResolveAlertDialogMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
ResolveAlertDialogMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveAlertDialogMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveAlertDialogMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
ResolveAlertDialogMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
ResolveAlertDialogMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
ResolveAlertDialogMethod "getResponseAppearance" o = AlertDialogGetResponseAppearanceMethodInfo
ResolveAlertDialogMethod "getResponseEnabled" o = AlertDialogGetResponseEnabledMethodInfo
ResolveAlertDialogMethod "getResponseLabel" o = AlertDialogGetResponseLabelMethodInfo
ResolveAlertDialogMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
ResolveAlertDialogMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
ResolveAlertDialogMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
ResolveAlertDialogMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
ResolveAlertDialogMethod "getSize" o = Gtk.Widget.WidgetGetSizeMethodInfo
ResolveAlertDialogMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
ResolveAlertDialogMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
ResolveAlertDialogMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
ResolveAlertDialogMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
ResolveAlertDialogMethod "getTitle" o = Adw.Dialog.DialogGetTitleMethodInfo
ResolveAlertDialogMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
ResolveAlertDialogMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
ResolveAlertDialogMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
ResolveAlertDialogMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
ResolveAlertDialogMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
ResolveAlertDialogMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
ResolveAlertDialogMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
ResolveAlertDialogMethod "setAccessibleParent" o = Gtk.Accessible.AccessibleSetAccessibleParentMethodInfo
ResolveAlertDialogMethod "setBody" o = AlertDialogSetBodyMethodInfo
ResolveAlertDialogMethod "setBodyUseMarkup" o = AlertDialogSetBodyUseMarkupMethodInfo
ResolveAlertDialogMethod "setCanClose" o = Adw.Dialog.DialogSetCanCloseMethodInfo
ResolveAlertDialogMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
ResolveAlertDialogMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
ResolveAlertDialogMethod "setChild" o = Adw.Dialog.DialogSetChildMethodInfo
ResolveAlertDialogMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
ResolveAlertDialogMethod "setCloseResponse" o = AlertDialogSetCloseResponseMethodInfo
ResolveAlertDialogMethod "setContentHeight" o = Adw.Dialog.DialogSetContentHeightMethodInfo
ResolveAlertDialogMethod "setContentWidth" o = Adw.Dialog.DialogSetContentWidthMethodInfo
ResolveAlertDialogMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
ResolveAlertDialogMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
ResolveAlertDialogMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
ResolveAlertDialogMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveAlertDialogMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveAlertDialogMethod "setDefaultResponse" o = AlertDialogSetDefaultResponseMethodInfo
ResolveAlertDialogMethod "setDefaultWidget" o = Adw.Dialog.DialogSetDefaultWidgetMethodInfo
ResolveAlertDialogMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
ResolveAlertDialogMethod "setExtraChild" o = AlertDialogSetExtraChildMethodInfo
ResolveAlertDialogMethod "setFocus" o = Adw.Dialog.DialogSetFocusMethodInfo
ResolveAlertDialogMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
ResolveAlertDialogMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
ResolveAlertDialogMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
ResolveAlertDialogMethod "setFollowsContentSize" o = Adw.Dialog.DialogSetFollowsContentSizeMethodInfo
ResolveAlertDialogMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
ResolveAlertDialogMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
ResolveAlertDialogMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
ResolveAlertDialogMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
ResolveAlertDialogMethod "setHeading" o = AlertDialogSetHeadingMethodInfo
ResolveAlertDialogMethod "setHeadingUseMarkup" o = AlertDialogSetHeadingUseMarkupMethodInfo
ResolveAlertDialogMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
ResolveAlertDialogMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
ResolveAlertDialogMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
ResolveAlertDialogMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
ResolveAlertDialogMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
ResolveAlertDialogMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
ResolveAlertDialogMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
ResolveAlertDialogMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
ResolveAlertDialogMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
ResolveAlertDialogMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
ResolveAlertDialogMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
ResolveAlertDialogMethod "setPresentationMode" o = Adw.Dialog.DialogSetPresentationModeMethodInfo
ResolveAlertDialogMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveAlertDialogMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
ResolveAlertDialogMethod "setResponseAppearance" o = AlertDialogSetResponseAppearanceMethodInfo
ResolveAlertDialogMethod "setResponseEnabled" o = AlertDialogSetResponseEnabledMethodInfo
ResolveAlertDialogMethod "setResponseLabel" o = AlertDialogSetResponseLabelMethodInfo
ResolveAlertDialogMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
ResolveAlertDialogMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
ResolveAlertDialogMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
ResolveAlertDialogMethod "setTitle" o = Adw.Dialog.DialogSetTitleMethodInfo
ResolveAlertDialogMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
ResolveAlertDialogMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
ResolveAlertDialogMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
ResolveAlertDialogMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
ResolveAlertDialogMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
ResolveAlertDialogMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
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
type AlertDialogResponseCallback =
T.Text
-> IO ()
type C_AlertDialogResponseCallback =
Ptr AlertDialog ->
CString ->
Ptr () ->
IO ()
foreign import ccall "wrapper"
mk_AlertDialogResponseCallback :: C_AlertDialogResponseCallback -> IO (FunPtr C_AlertDialogResponseCallback)
wrap_AlertDialogResponseCallback ::
GObject a => (a -> AlertDialogResponseCallback) ->
C_AlertDialogResponseCallback
wrap_AlertDialogResponseCallback :: forall a.
GObject a =>
(a -> AlertDialogResponseCallback) -> C_AlertDialogResponseCallback
wrap_AlertDialogResponseCallback a -> AlertDialogResponseCallback
gi'cb Ptr AlertDialog
gi'selfPtr CString
response Ptr ()
_ = do
Text
response' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
response
Ptr AlertDialog -> (AlertDialog -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr AlertDialog
gi'selfPtr ((AlertDialog -> IO ()) -> IO ())
-> (AlertDialog -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AlertDialog
gi'self -> a -> AlertDialogResponseCallback
gi'cb (AlertDialog -> a
forall a b. Coercible a b => a -> b
Coerce.coerce AlertDialog
gi'self) Text
response'
onAlertDialogResponse :: (IsAlertDialog a, MonadIO m) => a -> P.Maybe T.Text -> ((?self :: a) => AlertDialogResponseCallback) -> m SignalHandlerId
onAlertDialogResponse :: forall a (m :: * -> *).
(IsAlertDialog a, MonadIO m) =>
a
-> Maybe Text
-> ((?self::a) => AlertDialogResponseCallback)
-> m SignalHandlerId
onAlertDialogResponse a
obj Maybe Text
detail (?self::a) => AlertDialogResponseCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
let wrapped :: a -> AlertDialogResponseCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => AlertDialogResponseCallback
AlertDialogResponseCallback
cb
let wrapped' :: C_AlertDialogResponseCallback
wrapped' = (a -> AlertDialogResponseCallback) -> C_AlertDialogResponseCallback
forall a.
GObject a =>
(a -> AlertDialogResponseCallback) -> C_AlertDialogResponseCallback
wrap_AlertDialogResponseCallback a -> AlertDialogResponseCallback
wrapped
FunPtr C_AlertDialogResponseCallback
wrapped'' <- C_AlertDialogResponseCallback
-> IO (FunPtr C_AlertDialogResponseCallback)
mk_AlertDialogResponseCallback C_AlertDialogResponseCallback
wrapped'
a
-> Text
-> FunPtr C_AlertDialogResponseCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"response" FunPtr C_AlertDialogResponseCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
detail
afterAlertDialogResponse :: (IsAlertDialog a, MonadIO m) => a -> P.Maybe T.Text -> ((?self :: a) => AlertDialogResponseCallback) -> m SignalHandlerId
afterAlertDialogResponse :: forall a (m :: * -> *).
(IsAlertDialog a, MonadIO m) =>
a
-> Maybe Text
-> ((?self::a) => AlertDialogResponseCallback)
-> m SignalHandlerId
afterAlertDialogResponse a
obj Maybe Text
detail (?self::a) => AlertDialogResponseCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
let wrapped :: a -> AlertDialogResponseCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => AlertDialogResponseCallback
AlertDialogResponseCallback
cb
let wrapped' :: C_AlertDialogResponseCallback
wrapped' = (a -> AlertDialogResponseCallback) -> C_AlertDialogResponseCallback
forall a.
GObject a =>
(a -> AlertDialogResponseCallback) -> C_AlertDialogResponseCallback
wrap_AlertDialogResponseCallback a -> AlertDialogResponseCallback
wrapped
FunPtr C_AlertDialogResponseCallback
wrapped'' <- C_AlertDialogResponseCallback
-> IO (FunPtr C_AlertDialogResponseCallback)
mk_AlertDialogResponseCallback C_AlertDialogResponseCallback
wrapped'
a
-> Text
-> FunPtr C_AlertDialogResponseCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"response" FunPtr C_AlertDialogResponseCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
detail
#if defined(ENABLE_OVERLOADING)
data AlertDialogResponseSignalInfo
instance SignalInfo AlertDialogResponseSignalInfo where
type HaskellCallbackType AlertDialogResponseSignalInfo = AlertDialogResponseCallback
connectSignal obj cb connectMode detail = do
let cb' = wrap_AlertDialogResponseCallback cb
cb'' <- mk_AlertDialogResponseCallback cb'
connectSignalFunPtr obj "response" cb'' connectMode detail
dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog::response"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#g:signal:response"})
#endif
getAlertDialogBody :: (MonadIO m, IsAlertDialog o) => o -> m T.Text
getAlertDialogBody :: forall (m :: * -> *) o. (MonadIO m, IsAlertDialog o) => o -> m Text
getAlertDialogBody 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
"getAlertDialogBody" (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
"body"
setAlertDialogBody :: (MonadIO m, IsAlertDialog o) => o -> T.Text -> m ()
setAlertDialogBody :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> Text -> m ()
setAlertDialogBody 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
"body" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructAlertDialogBody :: (IsAlertDialog o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructAlertDialogBody :: forall o (m :: * -> *).
(IsAlertDialog o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructAlertDialogBody 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
"body" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
#if defined(ENABLE_OVERLOADING)
data AlertDialogBodyPropertyInfo
instance AttrInfo AlertDialogBodyPropertyInfo where
type AttrAllowedOps AlertDialogBodyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint AlertDialogBodyPropertyInfo = IsAlertDialog
type AttrSetTypeConstraint AlertDialogBodyPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint AlertDialogBodyPropertyInfo = (~) T.Text
type AttrTransferType AlertDialogBodyPropertyInfo = T.Text
type AttrGetType AlertDialogBodyPropertyInfo = T.Text
type AttrLabel AlertDialogBodyPropertyInfo = "body"
type AttrOrigin AlertDialogBodyPropertyInfo = AlertDialog
attrGet = getAlertDialogBody
attrSet = setAlertDialogBody
attrTransfer _ v = do
return v
attrConstruct = constructAlertDialogBody
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.body"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#g:attr:body"
})
#endif
getAlertDialogBodyUseMarkup :: (MonadIO m, IsAlertDialog o) => o -> m Bool
getAlertDialogBodyUseMarkup :: forall (m :: * -> *) o. (MonadIO m, IsAlertDialog o) => o -> m Bool
getAlertDialogBodyUseMarkup 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
"body-use-markup"
setAlertDialogBodyUseMarkup :: (MonadIO m, IsAlertDialog o) => o -> Bool -> m ()
setAlertDialogBodyUseMarkup :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> Bool -> m ()
setAlertDialogBodyUseMarkup 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
"body-use-markup" Bool
val
constructAlertDialogBodyUseMarkup :: (IsAlertDialog o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructAlertDialogBodyUseMarkup :: forall o (m :: * -> *).
(IsAlertDialog o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructAlertDialogBodyUseMarkup 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
"body-use-markup" Bool
val
#if defined(ENABLE_OVERLOADING)
data AlertDialogBodyUseMarkupPropertyInfo
instance AttrInfo AlertDialogBodyUseMarkupPropertyInfo where
type AttrAllowedOps AlertDialogBodyUseMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint AlertDialogBodyUseMarkupPropertyInfo = IsAlertDialog
type AttrSetTypeConstraint AlertDialogBodyUseMarkupPropertyInfo = (~) Bool
type AttrTransferTypeConstraint AlertDialogBodyUseMarkupPropertyInfo = (~) Bool
type AttrTransferType AlertDialogBodyUseMarkupPropertyInfo = Bool
type AttrGetType AlertDialogBodyUseMarkupPropertyInfo = Bool
type AttrLabel AlertDialogBodyUseMarkupPropertyInfo = "body-use-markup"
type AttrOrigin AlertDialogBodyUseMarkupPropertyInfo = AlertDialog
attrGet = getAlertDialogBodyUseMarkup
attrSet = setAlertDialogBodyUseMarkup
attrTransfer _ v = do
return v
attrConstruct = constructAlertDialogBodyUseMarkup
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.bodyUseMarkup"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#g:attr:bodyUseMarkup"
})
#endif
getAlertDialogCloseResponse :: (MonadIO m, IsAlertDialog o) => o -> m T.Text
getAlertDialogCloseResponse :: forall (m :: * -> *) o. (MonadIO m, IsAlertDialog o) => o -> m Text
getAlertDialogCloseResponse 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
"getAlertDialogCloseResponse" (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
"close-response"
setAlertDialogCloseResponse :: (MonadIO m, IsAlertDialog o) => o -> T.Text -> m ()
setAlertDialogCloseResponse :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> Text -> m ()
setAlertDialogCloseResponse 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
"close-response" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructAlertDialogCloseResponse :: (IsAlertDialog o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructAlertDialogCloseResponse :: forall o (m :: * -> *).
(IsAlertDialog o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructAlertDialogCloseResponse 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
"close-response" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
#if defined(ENABLE_OVERLOADING)
data AlertDialogCloseResponsePropertyInfo
instance AttrInfo AlertDialogCloseResponsePropertyInfo where
type AttrAllowedOps AlertDialogCloseResponsePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint AlertDialogCloseResponsePropertyInfo = IsAlertDialog
type AttrSetTypeConstraint AlertDialogCloseResponsePropertyInfo = (~) T.Text
type AttrTransferTypeConstraint AlertDialogCloseResponsePropertyInfo = (~) T.Text
type AttrTransferType AlertDialogCloseResponsePropertyInfo = T.Text
type AttrGetType AlertDialogCloseResponsePropertyInfo = T.Text
type AttrLabel AlertDialogCloseResponsePropertyInfo = "close-response"
type AttrOrigin AlertDialogCloseResponsePropertyInfo = AlertDialog
attrGet = getAlertDialogCloseResponse
attrSet = setAlertDialogCloseResponse
attrTransfer _ v = do
return v
attrConstruct = constructAlertDialogCloseResponse
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.closeResponse"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#g:attr:closeResponse"
})
#endif
getAlertDialogDefaultResponse :: (MonadIO m, IsAlertDialog o) => o -> m (Maybe T.Text)
getAlertDialogDefaultResponse :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> m (Maybe Text)
getAlertDialogDefaultResponse o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"default-response"
setAlertDialogDefaultResponse :: (MonadIO m, IsAlertDialog o) => o -> T.Text -> m ()
setAlertDialogDefaultResponse :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> Text -> m ()
setAlertDialogDefaultResponse 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
"default-response" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructAlertDialogDefaultResponse :: (IsAlertDialog o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructAlertDialogDefaultResponse :: forall o (m :: * -> *).
(IsAlertDialog o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructAlertDialogDefaultResponse 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
"default-response" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearAlertDialogDefaultResponse :: (MonadIO m, IsAlertDialog o) => o -> m ()
clearAlertDialogDefaultResponse :: forall (m :: * -> *) o. (MonadIO m, IsAlertDialog o) => o -> m ()
clearAlertDialogDefaultResponse o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"default-response" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data AlertDialogDefaultResponsePropertyInfo
instance AttrInfo AlertDialogDefaultResponsePropertyInfo where
type AttrAllowedOps AlertDialogDefaultResponsePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint AlertDialogDefaultResponsePropertyInfo = IsAlertDialog
type AttrSetTypeConstraint AlertDialogDefaultResponsePropertyInfo = (~) T.Text
type AttrTransferTypeConstraint AlertDialogDefaultResponsePropertyInfo = (~) T.Text
type AttrTransferType AlertDialogDefaultResponsePropertyInfo = T.Text
type AttrGetType AlertDialogDefaultResponsePropertyInfo = (Maybe T.Text)
type AttrLabel AlertDialogDefaultResponsePropertyInfo = "default-response"
type AttrOrigin AlertDialogDefaultResponsePropertyInfo = AlertDialog
attrGet = getAlertDialogDefaultResponse
attrSet = setAlertDialogDefaultResponse
attrTransfer _ v = do
return v
attrConstruct = constructAlertDialogDefaultResponse
attrClear = clearAlertDialogDefaultResponse
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.defaultResponse"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#g:attr:defaultResponse"
})
#endif
getAlertDialogExtraChild :: (MonadIO m, IsAlertDialog o) => o -> m (Maybe Gtk.Widget.Widget)
o
obj = IO (Maybe Widget) -> m (Maybe Widget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Widget -> Widget) -> IO (Maybe Widget)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"extra-child" ManagedPtr Widget -> Widget
Gtk.Widget.Widget
setAlertDialogExtraChild :: (MonadIO m, IsAlertDialog o, Gtk.Widget.IsWidget a) => o -> a -> m ()
o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"extra-child" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)
constructAlertDialogExtraChild :: (IsAlertDialog o, MIO.MonadIO m, Gtk.Widget.IsWidget a) => a -> m (GValueConstruct o)
a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"extra-child" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)
clearAlertDialogExtraChild :: (MonadIO m, IsAlertDialog o) => o -> m ()
o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Widget -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"extra-child" (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget.Widget)
#if defined(ENABLE_OVERLOADING)
data AlertDialogExtraChildPropertyInfo
instance AttrInfo AlertDialogExtraChildPropertyInfo where
type AttrAllowedOps AlertDialogExtraChildPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint AlertDialogExtraChildPropertyInfo = IsAlertDialog
type AttrSetTypeConstraint AlertDialogExtraChildPropertyInfo = Gtk.Widget.IsWidget
type AttrTransferTypeConstraint AlertDialogExtraChildPropertyInfo = Gtk.Widget.IsWidget
type AttrTransferType AlertDialogExtraChildPropertyInfo = Gtk.Widget.Widget
type AttrGetType AlertDialogExtraChildPropertyInfo = (Maybe Gtk.Widget.Widget)
type AttrLabel AlertDialogExtraChildPropertyInfo = "extra-child"
type AttrOrigin AlertDialogExtraChildPropertyInfo = AlertDialog
attrGet = getAlertDialogExtraChild
attrSet = setAlertDialogExtraChild
attrTransfer _ v = do
unsafeCastTo Gtk.Widget.Widget v
attrConstruct = constructAlertDialogExtraChild
attrClear = clearAlertDialogExtraChild
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.extraChild"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#g:attr:extraChild"
})
#endif
getAlertDialogHeading :: (MonadIO m, IsAlertDialog o) => o -> m (Maybe T.Text)
getAlertDialogHeading :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> m (Maybe Text)
getAlertDialogHeading o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"heading"
setAlertDialogHeading :: (MonadIO m, IsAlertDialog o) => o -> T.Text -> m ()
setAlertDialogHeading :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> Text -> m ()
setAlertDialogHeading 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
"heading" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructAlertDialogHeading :: (IsAlertDialog o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructAlertDialogHeading :: forall o (m :: * -> *).
(IsAlertDialog o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructAlertDialogHeading 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
"heading" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearAlertDialogHeading :: (MonadIO m, IsAlertDialog o) => o -> m ()
clearAlertDialogHeading :: forall (m :: * -> *) o. (MonadIO m, IsAlertDialog o) => o -> m ()
clearAlertDialogHeading o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"heading" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data AlertDialogHeadingPropertyInfo
instance AttrInfo AlertDialogHeadingPropertyInfo where
type AttrAllowedOps AlertDialogHeadingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint AlertDialogHeadingPropertyInfo = IsAlertDialog
type AttrSetTypeConstraint AlertDialogHeadingPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint AlertDialogHeadingPropertyInfo = (~) T.Text
type AttrTransferType AlertDialogHeadingPropertyInfo = T.Text
type AttrGetType AlertDialogHeadingPropertyInfo = (Maybe T.Text)
type AttrLabel AlertDialogHeadingPropertyInfo = "heading"
type AttrOrigin AlertDialogHeadingPropertyInfo = AlertDialog
attrGet = getAlertDialogHeading
attrSet = setAlertDialogHeading
attrTransfer _ v = do
return v
attrConstruct = constructAlertDialogHeading
attrClear = clearAlertDialogHeading
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.heading"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#g:attr:heading"
})
#endif
getAlertDialogHeadingUseMarkup :: (MonadIO m, IsAlertDialog o) => o -> m Bool
getAlertDialogHeadingUseMarkup :: forall (m :: * -> *) o. (MonadIO m, IsAlertDialog o) => o -> m Bool
getAlertDialogHeadingUseMarkup 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
"heading-use-markup"
setAlertDialogHeadingUseMarkup :: (MonadIO m, IsAlertDialog o) => o -> Bool -> m ()
setAlertDialogHeadingUseMarkup :: forall (m :: * -> *) o.
(MonadIO m, IsAlertDialog o) =>
o -> Bool -> m ()
setAlertDialogHeadingUseMarkup 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
"heading-use-markup" Bool
val
constructAlertDialogHeadingUseMarkup :: (IsAlertDialog o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructAlertDialogHeadingUseMarkup :: forall o (m :: * -> *).
(IsAlertDialog o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructAlertDialogHeadingUseMarkup 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
"heading-use-markup" Bool
val
#if defined(ENABLE_OVERLOADING)
data AlertDialogHeadingUseMarkupPropertyInfo
instance AttrInfo AlertDialogHeadingUseMarkupPropertyInfo where
type AttrAllowedOps AlertDialogHeadingUseMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint AlertDialogHeadingUseMarkupPropertyInfo = IsAlertDialog
type AttrSetTypeConstraint AlertDialogHeadingUseMarkupPropertyInfo = (~) Bool
type AttrTransferTypeConstraint AlertDialogHeadingUseMarkupPropertyInfo = (~) Bool
type AttrTransferType AlertDialogHeadingUseMarkupPropertyInfo = Bool
type AttrGetType AlertDialogHeadingUseMarkupPropertyInfo = Bool
type AttrLabel AlertDialogHeadingUseMarkupPropertyInfo = "heading-use-markup"
type AttrOrigin AlertDialogHeadingUseMarkupPropertyInfo = AlertDialog
attrGet = getAlertDialogHeadingUseMarkup
attrSet = setAlertDialogHeadingUseMarkup
attrTransfer _ v = do
return v
attrConstruct = constructAlertDialogHeadingUseMarkup
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.headingUseMarkup"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#g:attr:headingUseMarkup"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AlertDialog
type instance O.AttributeList AlertDialog = AlertDialogAttributeList
type AlertDialogAttributeList = ('[ '("accessibleRole", Gtk.Accessible.AccessibleAccessibleRolePropertyInfo), '("body", AlertDialogBodyPropertyInfo), '("bodyUseMarkup", AlertDialogBodyUseMarkupPropertyInfo), '("canClose", Adw.Dialog.DialogCanClosePropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("child", Adw.Dialog.DialogChildPropertyInfo), '("closeResponse", AlertDialogCloseResponsePropertyInfo), '("contentHeight", Adw.Dialog.DialogContentHeightPropertyInfo), '("contentWidth", Adw.Dialog.DialogContentWidthPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("currentBreakpoint", Adw.Dialog.DialogCurrentBreakpointPropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("defaultResponse", AlertDialogDefaultResponsePropertyInfo), '("defaultWidget", Adw.Dialog.DialogDefaultWidgetPropertyInfo), '("extraChild", AlertDialogExtraChildPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusWidget", Adw.Dialog.DialogFocusWidgetPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("followsContentSize", Adw.Dialog.DialogFollowsContentSizePropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heading", AlertDialogHeadingPropertyInfo), '("headingUseMarkup", AlertDialogHeadingUseMarkupPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("presentationMode", Adw.Dialog.DialogPresentationModePropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("title", Adw.Dialog.DialogTitlePropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
alertDialogBody :: AttrLabelProxy "body"
alertDialogBody = AttrLabelProxy
alertDialogBodyUseMarkup :: AttrLabelProxy "bodyUseMarkup"
alertDialogBodyUseMarkup = AttrLabelProxy
alertDialogCloseResponse :: AttrLabelProxy "closeResponse"
alertDialogCloseResponse = AttrLabelProxy
alertDialogDefaultResponse :: AttrLabelProxy "defaultResponse"
alertDialogDefaultResponse = AttrLabelProxy
alertDialogExtraChild :: AttrLabelProxy "extraChild"
alertDialogExtraChild = AttrLabelProxy
alertDialogHeading :: AttrLabelProxy "heading"
alertDialogHeading = AttrLabelProxy
alertDialogHeadingUseMarkup :: AttrLabelProxy "headingUseMarkup"
alertDialogHeadingUseMarkup = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList AlertDialog = AlertDialogSignalList
type AlertDialogSignalList = ('[ '("closeAttempt", Adw.Dialog.DialogCloseAttemptSignalInfo), '("closed", Adw.Dialog.DialogClosedSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("response", AlertDialogResponseSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "adw_alert_dialog_new" adw_alert_dialog_new ::
CString ->
CString ->
IO (Ptr AlertDialog)
alertDialogNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
Maybe (T.Text)
-> Maybe (T.Text)
-> m AlertDialog
alertDialogNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> Maybe Text -> m AlertDialog
alertDialogNew Maybe Text
heading Maybe Text
body = IO AlertDialog -> m AlertDialog
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AlertDialog -> m AlertDialog)
-> IO AlertDialog -> m AlertDialog
forall a b. (a -> b) -> a -> b
$ do
CString
maybeHeading <- case Maybe Text
heading of
Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
Just Text
jHeading -> do
CString
jHeading' <- Text -> IO CString
textToCString Text
jHeading
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jHeading'
CString
maybeBody <- case Maybe Text
body of
Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
Just Text
jBody -> do
CString
jBody' <- Text -> IO CString
textToCString Text
jBody
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jBody'
Ptr AlertDialog
result <- CString -> CString -> IO (Ptr AlertDialog)
adw_alert_dialog_new CString
maybeHeading CString
maybeBody
Text -> Ptr AlertDialog -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"alertDialogNew" Ptr AlertDialog
result
AlertDialog
result' <- ((ManagedPtr AlertDialog -> AlertDialog)
-> Ptr AlertDialog -> IO AlertDialog
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AlertDialog -> AlertDialog
AlertDialog) Ptr AlertDialog
result
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeHeading
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeBody
AlertDialog -> IO AlertDialog
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AlertDialog
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "adw_alert_dialog_add_response" adw_alert_dialog_add_response ::
Ptr AlertDialog ->
CString ->
CString ->
IO ()
alertDialogAddResponse ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> T.Text
-> T.Text
-> m ()
alertDialogAddResponse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Text -> Text -> m ()
alertDialogAddResponse a
self Text
id Text
label = 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
id' <- Text -> IO CString
textToCString Text
id
CString
label' <- Text -> IO CString
textToCString Text
label
Ptr AlertDialog -> CString -> CString -> IO ()
adw_alert_dialog_add_response Ptr AlertDialog
self' CString
id' CString
label'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
id'
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data AlertDialogAddResponseMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogAddResponseMethodInfo a signature where
overloadedMethod = alertDialogAddResponse
instance O.OverloadedMethodInfo AlertDialogAddResponseMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogAddResponse",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogAddResponse"
})
#endif
foreign import ccall "adw_alert_dialog_choose" adw_alert_dialog_choose ::
Ptr AlertDialog ->
Ptr Gtk.Widget.Widget ->
Ptr Gio.Cancellable.Cancellable ->
FunPtr Gio.Callbacks.C_AsyncReadyCallback ->
Ptr () ->
IO ()
alertDialogChoose ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a, Gtk.Widget.IsWidget b, Gio.Cancellable.IsCancellable c) =>
a
-> Maybe (b)
-> Maybe (c)
-> Maybe (Gio.Callbacks.AsyncReadyCallback)
-> m ()
alertDialogChoose :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsAlertDialog a, IsWidget 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 Widget
maybeParent <- case Maybe b
parent of
Maybe b
Nothing -> Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
Just b
jParent -> do
Ptr Widget
jParent' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 Widget
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
adw_alert_dialog_choose Ptr AlertDialog
self' Ptr Widget
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.Widget.IsWidget 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.Adw.Objects.AlertDialog.alertDialogChoose",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogChoose"
})
#endif
foreign import ccall "adw_alert_dialog_choose_finish" adw_alert_dialog_choose_finish ::
Ptr AlertDialog ->
Ptr Gio.AsyncResult.AsyncResult ->
IO CString
alertDialogChooseFinish ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a, Gio.AsyncResult.IsAsyncResult b) =>
a
-> b
-> m T.Text
alertDialogChooseFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAlertDialog a, IsAsyncResult b) =>
a -> b -> m Text
alertDialogChooseFinish a
self b
result_ = 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
Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
CString
result <- Ptr AlertDialog -> Ptr AsyncResult -> IO CString
adw_alert_dialog_choose_finish Ptr AlertDialog
self' Ptr AsyncResult
result_'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"alertDialogChooseFinish" 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
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data AlertDialogChooseFinishMethodInfo
instance (signature ~ (b -> m T.Text), 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.Adw.Objects.AlertDialog.alertDialogChooseFinish",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogChooseFinish"
})
#endif
foreign import ccall "adw_alert_dialog_get_body" adw_alert_dialog_get_body ::
Ptr AlertDialog ->
IO CString
alertDialogGetBody ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> m T.Text
alertDialogGetBody :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> m Text
alertDialogGetBody 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
adw_alert_dialog_get_body Ptr AlertDialog
self'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"alertDialogGetBody" 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 AlertDialogGetBodyMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetBodyMethodInfo a signature where
overloadedMethod = alertDialogGetBody
instance O.OverloadedMethodInfo AlertDialogGetBodyMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogGetBody",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogGetBody"
})
#endif
foreign import ccall "adw_alert_dialog_get_body_use_markup" adw_alert_dialog_get_body_use_markup ::
Ptr AlertDialog ->
IO CInt
alertDialogGetBodyUseMarkup ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> m Bool
alertDialogGetBodyUseMarkup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> m Bool
alertDialogGetBodyUseMarkup 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
adw_alert_dialog_get_body_use_markup 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 AlertDialogGetBodyUseMarkupMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetBodyUseMarkupMethodInfo a signature where
overloadedMethod = alertDialogGetBodyUseMarkup
instance O.OverloadedMethodInfo AlertDialogGetBodyUseMarkupMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogGetBodyUseMarkup",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogGetBodyUseMarkup"
})
#endif
foreign import ccall "adw_alert_dialog_get_close_response" adw_alert_dialog_get_close_response ::
Ptr AlertDialog ->
IO CString
alertDialogGetCloseResponse ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> m T.Text
alertDialogGetCloseResponse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> m Text
alertDialogGetCloseResponse 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
adw_alert_dialog_get_close_response Ptr AlertDialog
self'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"alertDialogGetCloseResponse" 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 AlertDialogGetCloseResponseMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetCloseResponseMethodInfo a signature where
overloadedMethod = alertDialogGetCloseResponse
instance O.OverloadedMethodInfo AlertDialogGetCloseResponseMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogGetCloseResponse",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogGetCloseResponse"
})
#endif
foreign import ccall "adw_alert_dialog_get_default_response" adw_alert_dialog_get_default_response ::
Ptr AlertDialog ->
IO CString
alertDialogGetDefaultResponse ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> m (Maybe T.Text)
alertDialogGetDefaultResponse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> m (Maybe Text)
alertDialogGetDefaultResponse 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
CString
result <- Ptr AlertDialog -> IO CString
adw_alert_dialog_get_default_response Ptr AlertDialog
self'
Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult
#if defined(ENABLE_OVERLOADING)
data AlertDialogGetDefaultResponseMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetDefaultResponseMethodInfo a signature where
overloadedMethod = alertDialogGetDefaultResponse
instance O.OverloadedMethodInfo AlertDialogGetDefaultResponseMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogGetDefaultResponse",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogGetDefaultResponse"
})
#endif
foreign import ccall "adw_alert_dialog_get_extra_child" ::
Ptr AlertDialog ->
IO (Ptr Gtk.Widget.Widget)
alertDialogGetExtraChild ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> m (Maybe Gtk.Widget.Widget)
a
self = IO (Maybe Widget) -> m (Maybe Widget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
Ptr AlertDialog
self' <- a -> IO (Ptr AlertDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr Widget
result <- Ptr AlertDialog -> IO (Ptr Widget)
adw_alert_dialog_get_extra_child Ptr AlertDialog
self'
Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Maybe Widget -> IO (Maybe Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult
#if defined(ENABLE_OVERLOADING)
data AlertDialogGetExtraChildMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetExtraChildMethodInfo a signature where
overloadedMethod = alertDialogGetExtraChild
instance O.OverloadedMethodInfo AlertDialogGetExtraChildMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogGetExtraChild",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogGetExtraChild"
})
#endif
foreign import ccall "adw_alert_dialog_get_heading" adw_alert_dialog_get_heading ::
Ptr AlertDialog ->
IO CString
alertDialogGetHeading ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> m (Maybe T.Text)
alertDialogGetHeading :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> m (Maybe Text)
alertDialogGetHeading 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
CString
result <- Ptr AlertDialog -> IO CString
adw_alert_dialog_get_heading Ptr AlertDialog
self'
Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult
#if defined(ENABLE_OVERLOADING)
data AlertDialogGetHeadingMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetHeadingMethodInfo a signature where
overloadedMethod = alertDialogGetHeading
instance O.OverloadedMethodInfo AlertDialogGetHeadingMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogGetHeading",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogGetHeading"
})
#endif
foreign import ccall "adw_alert_dialog_get_heading_use_markup" adw_alert_dialog_get_heading_use_markup ::
Ptr AlertDialog ->
IO CInt
alertDialogGetHeadingUseMarkup ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> m Bool
alertDialogGetHeadingUseMarkup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> m Bool
alertDialogGetHeadingUseMarkup 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
adw_alert_dialog_get_heading_use_markup 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 AlertDialogGetHeadingUseMarkupMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetHeadingUseMarkupMethodInfo a signature where
overloadedMethod = alertDialogGetHeadingUseMarkup
instance O.OverloadedMethodInfo AlertDialogGetHeadingUseMarkupMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogGetHeadingUseMarkup",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogGetHeadingUseMarkup"
})
#endif
foreign import ccall "adw_alert_dialog_get_response_appearance" adw_alert_dialog_get_response_appearance ::
Ptr AlertDialog ->
CString ->
IO CUInt
alertDialogGetResponseAppearance ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> T.Text
-> m Adw.Enums.ResponseAppearance
alertDialogGetResponseAppearance :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Text -> m ResponseAppearance
alertDialogGetResponseAppearance a
self Text
response = IO ResponseAppearance -> m ResponseAppearance
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ResponseAppearance -> m ResponseAppearance)
-> IO ResponseAppearance -> m ResponseAppearance
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
response' <- Text -> IO CString
textToCString Text
response
CUInt
result <- Ptr AlertDialog -> CString -> IO CUInt
adw_alert_dialog_get_response_appearance Ptr AlertDialog
self' CString
response'
let result' :: ResponseAppearance
result' = (Int -> ResponseAppearance
forall a. Enum a => Int -> a
toEnum (Int -> ResponseAppearance)
-> (CUInt -> Int) -> CUInt -> ResponseAppearance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
response'
ResponseAppearance -> IO ResponseAppearance
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseAppearance
result'
#if defined(ENABLE_OVERLOADING)
data AlertDialogGetResponseAppearanceMethodInfo
instance (signature ~ (T.Text -> m Adw.Enums.ResponseAppearance), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetResponseAppearanceMethodInfo a signature where
overloadedMethod = alertDialogGetResponseAppearance
instance O.OverloadedMethodInfo AlertDialogGetResponseAppearanceMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogGetResponseAppearance",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogGetResponseAppearance"
})
#endif
foreign import ccall "adw_alert_dialog_get_response_enabled" adw_alert_dialog_get_response_enabled ::
Ptr AlertDialog ->
CString ->
IO CInt
alertDialogGetResponseEnabled ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> T.Text
-> m Bool
alertDialogGetResponseEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Text -> m Bool
alertDialogGetResponseEnabled a
self Text
response = 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
CString
response' <- Text -> IO CString
textToCString Text
response
CInt
result <- Ptr AlertDialog -> CString -> IO CInt
adw_alert_dialog_get_response_enabled Ptr AlertDialog
self' CString
response'
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
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
response'
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data AlertDialogGetResponseEnabledMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetResponseEnabledMethodInfo a signature where
overloadedMethod = alertDialogGetResponseEnabled
instance O.OverloadedMethodInfo AlertDialogGetResponseEnabledMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogGetResponseEnabled",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogGetResponseEnabled"
})
#endif
foreign import ccall "adw_alert_dialog_get_response_label" adw_alert_dialog_get_response_label ::
Ptr AlertDialog ->
CString ->
IO CString
alertDialogGetResponseLabel ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> T.Text
-> m T.Text
alertDialogGetResponseLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Text -> m Text
alertDialogGetResponseLabel a
self Text
response = 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
response' <- Text -> IO CString
textToCString Text
response
CString
result <- Ptr AlertDialog -> CString -> IO CString
adw_alert_dialog_get_response_label Ptr AlertDialog
self' CString
response'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"alertDialogGetResponseLabel" 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
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
response'
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data AlertDialogGetResponseLabelMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogGetResponseLabelMethodInfo a signature where
overloadedMethod = alertDialogGetResponseLabel
instance O.OverloadedMethodInfo AlertDialogGetResponseLabelMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogGetResponseLabel",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogGetResponseLabel"
})
#endif
foreign import ccall "adw_alert_dialog_has_response" adw_alert_dialog_has_response ::
Ptr AlertDialog ->
CString ->
IO CInt
alertDialogHasResponse ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> T.Text
-> m Bool
alertDialogHasResponse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Text -> m Bool
alertDialogHasResponse a
self Text
response = 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
CString
response' <- Text -> IO CString
textToCString Text
response
CInt
result <- Ptr AlertDialog -> CString -> IO CInt
adw_alert_dialog_has_response Ptr AlertDialog
self' CString
response'
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
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
response'
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data AlertDialogHasResponseMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogHasResponseMethodInfo a signature where
overloadedMethod = alertDialogHasResponse
instance O.OverloadedMethodInfo AlertDialogHasResponseMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogHasResponse",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogHasResponse"
})
#endif
foreign import ccall "adw_alert_dialog_remove_response" adw_alert_dialog_remove_response ::
Ptr AlertDialog ->
CString ->
IO ()
alertDialogRemoveResponse ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> T.Text
-> m ()
alertDialogRemoveResponse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Text -> m ()
alertDialogRemoveResponse a
self Text
id = 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
id' <- Text -> IO CString
textToCString Text
id
Ptr AlertDialog -> CString -> IO ()
adw_alert_dialog_remove_response Ptr AlertDialog
self' CString
id'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
id'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data AlertDialogRemoveResponseMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogRemoveResponseMethodInfo a signature where
overloadedMethod = alertDialogRemoveResponse
instance O.OverloadedMethodInfo AlertDialogRemoveResponseMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogRemoveResponse",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogRemoveResponse"
})
#endif
foreign import ccall "adw_alert_dialog_set_body" adw_alert_dialog_set_body ::
Ptr AlertDialog ->
CString ->
IO ()
alertDialogSetBody ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> T.Text
-> m ()
alertDialogSetBody :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Text -> m ()
alertDialogSetBody a
self Text
body = 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
body' <- Text -> IO CString
textToCString Text
body
Ptr AlertDialog -> CString -> IO ()
adw_alert_dialog_set_body Ptr AlertDialog
self' CString
body'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
body'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data AlertDialogSetBodyMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogSetBodyMethodInfo a signature where
overloadedMethod = alertDialogSetBody
instance O.OverloadedMethodInfo AlertDialogSetBodyMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogSetBody",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogSetBody"
})
#endif
foreign import ccall "adw_alert_dialog_set_body_use_markup" adw_alert_dialog_set_body_use_markup ::
Ptr AlertDialog ->
CInt ->
IO ()
alertDialogSetBodyUseMarkup ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> Bool
-> m ()
alertDialogSetBodyUseMarkup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Bool -> m ()
alertDialogSetBodyUseMarkup a
self Bool
useMarkup = 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 useMarkup' :: CInt
useMarkup' = (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
useMarkup
Ptr AlertDialog -> CInt -> IO ()
adw_alert_dialog_set_body_use_markup Ptr AlertDialog
self' CInt
useMarkup'
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 AlertDialogSetBodyUseMarkupMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogSetBodyUseMarkupMethodInfo a signature where
overloadedMethod = alertDialogSetBodyUseMarkup
instance O.OverloadedMethodInfo AlertDialogSetBodyUseMarkupMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogSetBodyUseMarkup",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogSetBodyUseMarkup"
})
#endif
foreign import ccall "adw_alert_dialog_set_close_response" adw_alert_dialog_set_close_response ::
Ptr AlertDialog ->
CString ->
IO ()
alertDialogSetCloseResponse ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> T.Text
-> m ()
alertDialogSetCloseResponse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Text -> m ()
alertDialogSetCloseResponse a
self Text
response = 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
response' <- Text -> IO CString
textToCString Text
response
Ptr AlertDialog -> CString -> IO ()
adw_alert_dialog_set_close_response Ptr AlertDialog
self' CString
response'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
response'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data AlertDialogSetCloseResponseMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogSetCloseResponseMethodInfo a signature where
overloadedMethod = alertDialogSetCloseResponse
instance O.OverloadedMethodInfo AlertDialogSetCloseResponseMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogSetCloseResponse",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogSetCloseResponse"
})
#endif
foreign import ccall "adw_alert_dialog_set_default_response" adw_alert_dialog_set_default_response ::
Ptr AlertDialog ->
CString ->
IO ()
alertDialogSetDefaultResponse ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> Maybe (T.Text)
-> m ()
alertDialogSetDefaultResponse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Maybe Text -> m ()
alertDialogSetDefaultResponse a
self Maybe Text
response = 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
maybeResponse <- case Maybe Text
response of
Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
Just Text
jResponse -> do
CString
jResponse' <- Text -> IO CString
textToCString Text
jResponse
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jResponse'
Ptr AlertDialog -> CString -> IO ()
adw_alert_dialog_set_default_response Ptr AlertDialog
self' CString
maybeResponse
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeResponse
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data AlertDialogSetDefaultResponseMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogSetDefaultResponseMethodInfo a signature where
overloadedMethod = alertDialogSetDefaultResponse
instance O.OverloadedMethodInfo AlertDialogSetDefaultResponseMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogSetDefaultResponse",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogSetDefaultResponse"
})
#endif
foreign import ccall "adw_alert_dialog_set_extra_child" ::
Ptr AlertDialog ->
Ptr Gtk.Widget.Widget ->
IO ()
alertDialogSetExtraChild ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a, Gtk.Widget.IsWidget b) =>
a
-> Maybe (b)
-> m ()
a
self Maybe b
child = 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 Widget
maybeChild <- case Maybe b
child of
Maybe b
Nothing -> Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
Just b
jChild -> do
Ptr Widget
jChild' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jChild
Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jChild'
Ptr AlertDialog -> Ptr Widget -> IO ()
adw_alert_dialog_set_extra_child Ptr AlertDialog
self' Ptr Widget
maybeChild
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
child 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 AlertDialogSetExtraChildMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsAlertDialog a, Gtk.Widget.IsWidget b) => O.OverloadedMethod AlertDialogSetExtraChildMethodInfo a signature where
overloadedMethod = alertDialogSetExtraChild
instance O.OverloadedMethodInfo AlertDialogSetExtraChildMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogSetExtraChild",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogSetExtraChild"
})
#endif
foreign import ccall "adw_alert_dialog_set_heading" adw_alert_dialog_set_heading ::
Ptr AlertDialog ->
CString ->
IO ()
alertDialogSetHeading ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> Maybe (T.Text)
-> m ()
alertDialogSetHeading :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Maybe Text -> m ()
alertDialogSetHeading a
self Maybe Text
heading = 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
maybeHeading <- case Maybe Text
heading of
Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
Just Text
jHeading -> do
CString
jHeading' <- Text -> IO CString
textToCString Text
jHeading
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jHeading'
Ptr AlertDialog -> CString -> IO ()
adw_alert_dialog_set_heading Ptr AlertDialog
self' CString
maybeHeading
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeHeading
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data AlertDialogSetHeadingMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogSetHeadingMethodInfo a signature where
overloadedMethod = alertDialogSetHeading
instance O.OverloadedMethodInfo AlertDialogSetHeadingMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogSetHeading",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogSetHeading"
})
#endif
foreign import ccall "adw_alert_dialog_set_heading_use_markup" adw_alert_dialog_set_heading_use_markup ::
Ptr AlertDialog ->
CInt ->
IO ()
alertDialogSetHeadingUseMarkup ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> Bool
-> m ()
alertDialogSetHeadingUseMarkup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Bool -> m ()
alertDialogSetHeadingUseMarkup a
self Bool
useMarkup = 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 useMarkup' :: CInt
useMarkup' = (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
useMarkup
Ptr AlertDialog -> CInt -> IO ()
adw_alert_dialog_set_heading_use_markup Ptr AlertDialog
self' CInt
useMarkup'
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 AlertDialogSetHeadingUseMarkupMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogSetHeadingUseMarkupMethodInfo a signature where
overloadedMethod = alertDialogSetHeadingUseMarkup
instance O.OverloadedMethodInfo AlertDialogSetHeadingUseMarkupMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogSetHeadingUseMarkup",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogSetHeadingUseMarkup"
})
#endif
foreign import ccall "adw_alert_dialog_set_response_appearance" adw_alert_dialog_set_response_appearance ::
Ptr AlertDialog ->
CString ->
CUInt ->
IO ()
alertDialogSetResponseAppearance ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> T.Text
-> Adw.Enums.ResponseAppearance
-> m ()
alertDialogSetResponseAppearance :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Text -> ResponseAppearance -> m ()
alertDialogSetResponseAppearance a
self Text
response ResponseAppearance
appearance = 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
response' <- Text -> IO CString
textToCString Text
response
let appearance' :: CUInt
appearance' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (ResponseAppearance -> Int) -> ResponseAppearance -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResponseAppearance -> Int
forall a. Enum a => a -> Int
fromEnum) ResponseAppearance
appearance
Ptr AlertDialog -> CString -> CUInt -> IO ()
adw_alert_dialog_set_response_appearance Ptr AlertDialog
self' CString
response' CUInt
appearance'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
response'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data AlertDialogSetResponseAppearanceMethodInfo
instance (signature ~ (T.Text -> Adw.Enums.ResponseAppearance -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogSetResponseAppearanceMethodInfo a signature where
overloadedMethod = alertDialogSetResponseAppearance
instance O.OverloadedMethodInfo AlertDialogSetResponseAppearanceMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogSetResponseAppearance",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogSetResponseAppearance"
})
#endif
foreign import ccall "adw_alert_dialog_set_response_enabled" adw_alert_dialog_set_response_enabled ::
Ptr AlertDialog ->
CString ->
CInt ->
IO ()
alertDialogSetResponseEnabled ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> T.Text
-> Bool
-> m ()
alertDialogSetResponseEnabled :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Text -> Bool -> m ()
alertDialogSetResponseEnabled a
self Text
response Bool
enabled = 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
response' <- Text -> IO CString
textToCString Text
response
let enabled' :: CInt
enabled' = (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
enabled
Ptr AlertDialog -> CString -> CInt -> IO ()
adw_alert_dialog_set_response_enabled Ptr AlertDialog
self' CString
response' CInt
enabled'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
response'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data AlertDialogSetResponseEnabledMethodInfo
instance (signature ~ (T.Text -> Bool -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogSetResponseEnabledMethodInfo a signature where
overloadedMethod = alertDialogSetResponseEnabled
instance O.OverloadedMethodInfo AlertDialogSetResponseEnabledMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogSetResponseEnabled",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogSetResponseEnabled"
})
#endif
foreign import ccall "adw_alert_dialog_set_response_label" adw_alert_dialog_set_response_label ::
Ptr AlertDialog ->
CString ->
CString ->
IO ()
alertDialogSetResponseLabel ::
(B.CallStack.HasCallStack, MonadIO m, IsAlertDialog a) =>
a
-> T.Text
-> T.Text
-> m ()
alertDialogSetResponseLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAlertDialog a) =>
a -> Text -> Text -> m ()
alertDialogSetResponseLabel a
self Text
response Text
label = 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
response' <- Text -> IO CString
textToCString Text
response
CString
label' <- Text -> IO CString
textToCString Text
label
Ptr AlertDialog -> CString -> CString -> IO ()
adw_alert_dialog_set_response_label Ptr AlertDialog
self' CString
response' CString
label'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
response'
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data AlertDialogSetResponseLabelMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsAlertDialog a) => O.OverloadedMethod AlertDialogSetResponseLabelMethodInfo a signature where
overloadedMethod = alertDialogSetResponseLabel
instance O.OverloadedMethodInfo AlertDialogSetResponseLabelMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Adw.Objects.AlertDialog.alertDialogSetResponseLabel",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.7/docs/GI-Adw-Objects-AlertDialog.html#v:alertDialogSetResponseLabel"
})
#endif