{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A page from [class/@preferencesWindow@/].
-- 
-- \<picture>
--   \<source srcset=\"preferences-page-dark.png\" media=\"(prefers-color-scheme: dark)\">
--   \<img src=\"preferences-page.png\" alt=\"preferences-page\">
-- \<\/picture>
-- 
-- The @AdwPreferencesPage@ widget gathers preferences groups into a single page
-- of a preferences window.
-- 
-- == CSS nodes
-- 
-- @AdwPreferencesPage@ has a single CSS node with name @preferencespage@.
-- 
-- == Accessibility
-- 
-- @AdwPreferencesPage@ uses the @GTK_ACCESSIBLE_ROLE_GROUP@ role.

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

module GI.Adw.Objects.PreferencesPage
    ( 

-- * Exported types
    PreferencesPage(..)                     ,
    IsPreferencesPage                       ,
    toPreferencesPage                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [actionSetEnabled]("GI.Gtk.Objects.Widget#g:method:actionSetEnabled"), [activate]("GI.Gtk.Objects.Widget#g:method:activate"), [activateAction]("GI.Gtk.Objects.Widget#g:method:activateAction"), [activateDefault]("GI.Gtk.Objects.Widget#g:method:activateDefault"), [add]("GI.Adw.Objects.PreferencesPage#g:method:add"), [addController]("GI.Gtk.Objects.Widget#g:method:addController"), [addCssClass]("GI.Gtk.Objects.Widget#g:method:addCssClass"), [addMnemonicLabel]("GI.Gtk.Objects.Widget#g:method:addMnemonicLabel"), [addTickCallback]("GI.Gtk.Objects.Widget#g:method:addTickCallback"), [allocate]("GI.Gtk.Objects.Widget#g:method:allocate"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [childFocus]("GI.Gtk.Objects.Widget#g:method:childFocus"), [computeBounds]("GI.Gtk.Objects.Widget#g:method:computeBounds"), [computeExpand]("GI.Gtk.Objects.Widget#g:method:computeExpand"), [computePoint]("GI.Gtk.Objects.Widget#g:method:computePoint"), [computeTransform]("GI.Gtk.Objects.Widget#g:method:computeTransform"), [contains]("GI.Gtk.Objects.Widget#g:method:contains"), [createPangoContext]("GI.Gtk.Objects.Widget#g:method:createPangoContext"), [createPangoLayout]("GI.Gtk.Objects.Widget#g:method:createPangoLayout"), [disposeTemplate]("GI.Gtk.Objects.Widget#g:method:disposeTemplate"), [dragCheckThreshold]("GI.Gtk.Objects.Widget#g:method:dragCheckThreshold"), [errorBell]("GI.Gtk.Objects.Widget#g:method:errorBell"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [grabFocus]("GI.Gtk.Objects.Widget#g:method:grabFocus"), [hasCssClass]("GI.Gtk.Objects.Widget#g:method:hasCssClass"), [hasDefault]("GI.Gtk.Objects.Widget#g:method:hasDefault"), [hasFocus]("GI.Gtk.Objects.Widget#g:method:hasFocus"), [hasVisibleFocus]("GI.Gtk.Objects.Widget#g:method:hasVisibleFocus"), [hide]("GI.Gtk.Objects.Widget#g:method:hide"), [inDestruction]("GI.Gtk.Objects.Widget#g:method:inDestruction"), [initTemplate]("GI.Gtk.Objects.Widget#g:method:initTemplate"), [insertActionGroup]("GI.Gtk.Objects.Widget#g:method:insertActionGroup"), [insertAfter]("GI.Gtk.Objects.Widget#g:method:insertAfter"), [insertBefore]("GI.Gtk.Objects.Widget#g:method:insertBefore"), [isAncestor]("GI.Gtk.Objects.Widget#g:method:isAncestor"), [isDrawable]("GI.Gtk.Objects.Widget#g:method:isDrawable"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isFocus]("GI.Gtk.Objects.Widget#g:method:isFocus"), [isSensitive]("GI.Gtk.Objects.Widget#g:method:isSensitive"), [isVisible]("GI.Gtk.Objects.Widget#g:method:isVisible"), [keynavFailed]("GI.Gtk.Objects.Widget#g:method:keynavFailed"), [listMnemonicLabels]("GI.Gtk.Objects.Widget#g:method:listMnemonicLabels"), [map]("GI.Gtk.Objects.Widget#g:method:map"), [measure]("GI.Gtk.Objects.Widget#g:method:measure"), [mnemonicActivate]("GI.Gtk.Objects.Widget#g:method:mnemonicActivate"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [observeChildren]("GI.Gtk.Objects.Widget#g:method:observeChildren"), [observeControllers]("GI.Gtk.Objects.Widget#g:method:observeControllers"), [pick]("GI.Gtk.Objects.Widget#g:method:pick"), [queueAllocate]("GI.Gtk.Objects.Widget#g:method:queueAllocate"), [queueDraw]("GI.Gtk.Objects.Widget#g:method:queueDraw"), [queueResize]("GI.Gtk.Objects.Widget#g:method:queueResize"), [realize]("GI.Gtk.Objects.Widget#g:method:realize"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [remove]("GI.Adw.Objects.PreferencesPage#g:method:remove"), [removeController]("GI.Gtk.Objects.Widget#g:method:removeController"), [removeCssClass]("GI.Gtk.Objects.Widget#g:method:removeCssClass"), [removeMnemonicLabel]("GI.Gtk.Objects.Widget#g:method:removeMnemonicLabel"), [removeTickCallback]("GI.Gtk.Objects.Widget#g:method:removeTickCallback"), [resetProperty]("GI.Gtk.Interfaces.Accessible#g:method:resetProperty"), [resetRelation]("GI.Gtk.Interfaces.Accessible#g:method:resetRelation"), [resetState]("GI.Gtk.Interfaces.Accessible#g:method:resetState"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [scrollToTop]("GI.Adw.Objects.PreferencesPage#g:method:scrollToTop"), [shouldLayout]("GI.Gtk.Objects.Widget#g:method:shouldLayout"), [show]("GI.Gtk.Objects.Widget#g:method:show"), [sizeAllocate]("GI.Gtk.Objects.Widget#g:method:sizeAllocate"), [snapshotChild]("GI.Gtk.Objects.Widget#g:method:snapshotChild"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [translateCoordinates]("GI.Gtk.Objects.Widget#g:method:translateCoordinates"), [triggerTooltipQuery]("GI.Gtk.Objects.Widget#g:method:triggerTooltipQuery"), [unmap]("GI.Gtk.Objects.Widget#g:method:unmap"), [unparent]("GI.Gtk.Objects.Widget#g:method:unparent"), [unrealize]("GI.Gtk.Objects.Widget#g:method:unrealize"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unsetStateFlags]("GI.Gtk.Objects.Widget#g:method:unsetStateFlags"), [updateNextAccessibleSibling]("GI.Gtk.Interfaces.Accessible#g:method:updateNextAccessibleSibling"), [updateProperty]("GI.Gtk.Interfaces.Accessible#g:method:updateProperty"), [updateRelation]("GI.Gtk.Interfaces.Accessible#g:method:updateRelation"), [updateState]("GI.Gtk.Interfaces.Accessible#g:method:updateState"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAccessibleParent]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleParent"), [getAccessibleRole]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleRole"), [getAllocatedBaseline]("GI.Gtk.Objects.Widget#g:method:getAllocatedBaseline"), [getAllocatedHeight]("GI.Gtk.Objects.Widget#g:method:getAllocatedHeight"), [getAllocatedWidth]("GI.Gtk.Objects.Widget#g:method:getAllocatedWidth"), [getAllocation]("GI.Gtk.Objects.Widget#g:method:getAllocation"), [getAncestor]("GI.Gtk.Objects.Widget#g:method:getAncestor"), [getAtContext]("GI.Gtk.Interfaces.Accessible#g:method:getAtContext"), [getBounds]("GI.Gtk.Interfaces.Accessible#g:method:getBounds"), [getBuildableId]("GI.Gtk.Interfaces.Buildable#g:method:getBuildableId"), [getCanFocus]("GI.Gtk.Objects.Widget#g:method:getCanFocus"), [getCanTarget]("GI.Gtk.Objects.Widget#g:method:getCanTarget"), [getChildVisible]("GI.Gtk.Objects.Widget#g:method:getChildVisible"), [getClipboard]("GI.Gtk.Objects.Widget#g:method:getClipboard"), [getColor]("GI.Gtk.Objects.Widget#g:method:getColor"), [getCssClasses]("GI.Gtk.Objects.Widget#g:method:getCssClasses"), [getCssName]("GI.Gtk.Objects.Widget#g:method:getCssName"), [getCursor]("GI.Gtk.Objects.Widget#g:method:getCursor"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDirection]("GI.Gtk.Objects.Widget#g:method:getDirection"), [getDisplay]("GI.Gtk.Objects.Widget#g:method:getDisplay"), [getFirstAccessibleChild]("GI.Gtk.Interfaces.Accessible#g:method:getFirstAccessibleChild"), [getFirstChild]("GI.Gtk.Objects.Widget#g:method:getFirstChild"), [getFocusChild]("GI.Gtk.Objects.Widget#g:method:getFocusChild"), [getFocusOnClick]("GI.Gtk.Objects.Widget#g:method:getFocusOnClick"), [getFocusable]("GI.Gtk.Objects.Widget#g:method:getFocusable"), [getFontMap]("GI.Gtk.Objects.Widget#g:method:getFontMap"), [getFontOptions]("GI.Gtk.Objects.Widget#g:method:getFontOptions"), [getFrameClock]("GI.Gtk.Objects.Widget#g:method:getFrameClock"), [getHalign]("GI.Gtk.Objects.Widget#g:method:getHalign"), [getHasTooltip]("GI.Gtk.Objects.Widget#g:method:getHasTooltip"), [getHeight]("GI.Gtk.Objects.Widget#g:method:getHeight"), [getHexpand]("GI.Gtk.Objects.Widget#g:method:getHexpand"), [getHexpandSet]("GI.Gtk.Objects.Widget#g:method:getHexpandSet"), [getIconName]("GI.Adw.Objects.PreferencesPage#g:method:getIconName"), [getLastChild]("GI.Gtk.Objects.Widget#g:method:getLastChild"), [getLayoutManager]("GI.Gtk.Objects.Widget#g:method:getLayoutManager"), [getMapped]("GI.Gtk.Objects.Widget#g:method:getMapped"), [getMarginBottom]("GI.Gtk.Objects.Widget#g:method:getMarginBottom"), [getMarginEnd]("GI.Gtk.Objects.Widget#g:method:getMarginEnd"), [getMarginStart]("GI.Gtk.Objects.Widget#g:method:getMarginStart"), [getMarginTop]("GI.Gtk.Objects.Widget#g:method:getMarginTop"), [getName]("GI.Adw.Objects.PreferencesPage#g:method:getName"), [getNative]("GI.Gtk.Objects.Widget#g:method:getNative"), [getNextAccessibleSibling]("GI.Gtk.Interfaces.Accessible#g:method:getNextAccessibleSibling"), [getNextSibling]("GI.Gtk.Objects.Widget#g:method:getNextSibling"), [getOpacity]("GI.Gtk.Objects.Widget#g:method:getOpacity"), [getOverflow]("GI.Gtk.Objects.Widget#g:method:getOverflow"), [getPangoContext]("GI.Gtk.Objects.Widget#g:method:getPangoContext"), [getParent]("GI.Gtk.Objects.Widget#g:method:getParent"), [getPlatformState]("GI.Gtk.Interfaces.Accessible#g:method:getPlatformState"), [getPreferredSize]("GI.Gtk.Objects.Widget#g:method:getPreferredSize"), [getPrevSibling]("GI.Gtk.Objects.Widget#g:method:getPrevSibling"), [getPrimaryClipboard]("GI.Gtk.Objects.Widget#g:method:getPrimaryClipboard"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRealized]("GI.Gtk.Objects.Widget#g:method:getRealized"), [getReceivesDefault]("GI.Gtk.Objects.Widget#g:method:getReceivesDefault"), [getRequestMode]("GI.Gtk.Objects.Widget#g:method:getRequestMode"), [getRoot]("GI.Gtk.Objects.Widget#g:method:getRoot"), [getScaleFactor]("GI.Gtk.Objects.Widget#g:method:getScaleFactor"), [getSensitive]("GI.Gtk.Objects.Widget#g:method:getSensitive"), [getSettings]("GI.Gtk.Objects.Widget#g:method:getSettings"), [getSize]("GI.Gtk.Objects.Widget#g:method:getSize"), [getSizeRequest]("GI.Gtk.Objects.Widget#g:method:getSizeRequest"), [getStateFlags]("GI.Gtk.Objects.Widget#g:method:getStateFlags"), [getStyleContext]("GI.Gtk.Objects.Widget#g:method:getStyleContext"), [getTemplateChild]("GI.Gtk.Objects.Widget#g:method:getTemplateChild"), [getTitle]("GI.Adw.Objects.PreferencesPage#g:method:getTitle"), [getTooltipMarkup]("GI.Gtk.Objects.Widget#g:method:getTooltipMarkup"), [getTooltipText]("GI.Gtk.Objects.Widget#g:method:getTooltipText"), [getUseUnderline]("GI.Adw.Objects.PreferencesPage#g:method:getUseUnderline"), [getValign]("GI.Gtk.Objects.Widget#g:method:getValign"), [getVexpand]("GI.Gtk.Objects.Widget#g:method:getVexpand"), [getVexpandSet]("GI.Gtk.Objects.Widget#g:method:getVexpandSet"), [getVisible]("GI.Gtk.Objects.Widget#g:method:getVisible"), [getWidth]("GI.Gtk.Objects.Widget#g:method:getWidth").
-- 
-- ==== Setters
-- [setAccessibleParent]("GI.Gtk.Interfaces.Accessible#g:method:setAccessibleParent"), [setCanFocus]("GI.Gtk.Objects.Widget#g:method:setCanFocus"), [setCanTarget]("GI.Gtk.Objects.Widget#g:method:setCanTarget"), [setChildVisible]("GI.Gtk.Objects.Widget#g:method:setChildVisible"), [setCssClasses]("GI.Gtk.Objects.Widget#g:method:setCssClasses"), [setCursor]("GI.Gtk.Objects.Widget#g:method:setCursor"), [setCursorFromName]("GI.Gtk.Objects.Widget#g:method:setCursorFromName"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDirection]("GI.Gtk.Objects.Widget#g:method:setDirection"), [setFocusChild]("GI.Gtk.Objects.Widget#g:method:setFocusChild"), [setFocusOnClick]("GI.Gtk.Objects.Widget#g:method:setFocusOnClick"), [setFocusable]("GI.Gtk.Objects.Widget#g:method:setFocusable"), [setFontMap]("GI.Gtk.Objects.Widget#g:method:setFontMap"), [setFontOptions]("GI.Gtk.Objects.Widget#g:method:setFontOptions"), [setHalign]("GI.Gtk.Objects.Widget#g:method:setHalign"), [setHasTooltip]("GI.Gtk.Objects.Widget#g:method:setHasTooltip"), [setHexpand]("GI.Gtk.Objects.Widget#g:method:setHexpand"), [setHexpandSet]("GI.Gtk.Objects.Widget#g:method:setHexpandSet"), [setIconName]("GI.Adw.Objects.PreferencesPage#g:method:setIconName"), [setLayoutManager]("GI.Gtk.Objects.Widget#g:method:setLayoutManager"), [setMarginBottom]("GI.Gtk.Objects.Widget#g:method:setMarginBottom"), [setMarginEnd]("GI.Gtk.Objects.Widget#g:method:setMarginEnd"), [setMarginStart]("GI.Gtk.Objects.Widget#g:method:setMarginStart"), [setMarginTop]("GI.Gtk.Objects.Widget#g:method:setMarginTop"), [setName]("GI.Adw.Objects.PreferencesPage#g:method:setName"), [setOpacity]("GI.Gtk.Objects.Widget#g:method:setOpacity"), [setOverflow]("GI.Gtk.Objects.Widget#g:method:setOverflow"), [setParent]("GI.Gtk.Objects.Widget#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setReceivesDefault]("GI.Gtk.Objects.Widget#g:method:setReceivesDefault"), [setSensitive]("GI.Gtk.Objects.Widget#g:method:setSensitive"), [setSizeRequest]("GI.Gtk.Objects.Widget#g:method:setSizeRequest"), [setStateFlags]("GI.Gtk.Objects.Widget#g:method:setStateFlags"), [setTitle]("GI.Adw.Objects.PreferencesPage#g:method:setTitle"), [setTooltipMarkup]("GI.Gtk.Objects.Widget#g:method:setTooltipMarkup"), [setTooltipText]("GI.Gtk.Objects.Widget#g:method:setTooltipText"), [setUseUnderline]("GI.Adw.Objects.PreferencesPage#g:method:setUseUnderline"), [setValign]("GI.Gtk.Objects.Widget#g:method:setValign"), [setVexpand]("GI.Gtk.Objects.Widget#g:method:setVexpand"), [setVexpandSet]("GI.Gtk.Objects.Widget#g:method:setVexpandSet"), [setVisible]("GI.Gtk.Objects.Widget#g:method:setVisible").

#if defined(ENABLE_OVERLOADING)
    ResolvePreferencesPageMethod            ,
#endif

-- ** add #method:add#

#if defined(ENABLE_OVERLOADING)
    PreferencesPageAddMethodInfo            ,
#endif
    preferencesPageAdd                      ,


-- ** getIconName #method:getIconName#

#if defined(ENABLE_OVERLOADING)
    PreferencesPageGetIconNameMethodInfo    ,
#endif
    preferencesPageGetIconName              ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    PreferencesPageGetNameMethodInfo        ,
#endif
    preferencesPageGetName                  ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    PreferencesPageGetTitleMethodInfo       ,
#endif
    preferencesPageGetTitle                 ,


-- ** getUseUnderline #method:getUseUnderline#

#if defined(ENABLE_OVERLOADING)
    PreferencesPageGetUseUnderlineMethodInfo,
#endif
    preferencesPageGetUseUnderline          ,


-- ** new #method:new#

    preferencesPageNew                      ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    PreferencesPageRemoveMethodInfo         ,
#endif
    preferencesPageRemove                   ,


-- ** scrollToTop #method:scrollToTop#

#if defined(ENABLE_OVERLOADING)
    PreferencesPageScrollToTopMethodInfo    ,
#endif
    preferencesPageScrollToTop              ,


-- ** setIconName #method:setIconName#

#if defined(ENABLE_OVERLOADING)
    PreferencesPageSetIconNameMethodInfo    ,
#endif
    preferencesPageSetIconName              ,


-- ** setName #method:setName#

#if defined(ENABLE_OVERLOADING)
    PreferencesPageSetNameMethodInfo        ,
#endif
    preferencesPageSetName                  ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    PreferencesPageSetTitleMethodInfo       ,
#endif
    preferencesPageSetTitle                 ,


-- ** setUseUnderline #method:setUseUnderline#

#if defined(ENABLE_OVERLOADING)
    PreferencesPageSetUseUnderlineMethodInfo,
#endif
    preferencesPageSetUseUnderline          ,




 -- * Properties


-- ** iconName #attr:iconName#
-- | The icon name for this page.

#if defined(ENABLE_OVERLOADING)
    PreferencesPageIconNamePropertyInfo     ,
#endif
    clearPreferencesPageIconName            ,
    constructPreferencesPageIconName        ,
    getPreferencesPageIconName              ,
#if defined(ENABLE_OVERLOADING)
    preferencesPageIconName                 ,
#endif
    setPreferencesPageIconName              ,


-- ** name #attr:name#
-- | The name of this page.

#if defined(ENABLE_OVERLOADING)
    PreferencesPageNamePropertyInfo         ,
#endif
    clearPreferencesPageName                ,
    constructPreferencesPageName            ,
    getPreferencesPageName                  ,
#if defined(ENABLE_OVERLOADING)
    preferencesPageName                     ,
#endif
    setPreferencesPageName                  ,


-- ** title #attr:title#
-- | The title for this page.

#if defined(ENABLE_OVERLOADING)
    PreferencesPageTitlePropertyInfo        ,
#endif
    constructPreferencesPageTitle           ,
    getPreferencesPageTitle                 ,
#if defined(ENABLE_OVERLOADING)
    preferencesPageTitle                    ,
#endif
    setPreferencesPageTitle                 ,


-- ** useUnderline #attr:useUnderline#
-- | Whether an embedded underline in the title indicates a mnemonic.

#if defined(ENABLE_OVERLOADING)
    PreferencesPageUseUnderlinePropertyInfo ,
#endif
    constructPreferencesPageUseUnderline    ,
    getPreferencesPageUseUnderline          ,
#if defined(ENABLE_OVERLOADING)
    preferencesPageUseUnderline             ,
#endif
    setPreferencesPageUseUnderline          ,




    ) where

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

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

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

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

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

foreign import ccall "adw_preferences_page_get_type"
    c_adw_preferences_page_get_type :: IO B.Types.GType

instance B.Types.TypedObject PreferencesPage where
    glibType :: IO GType
glibType = IO GType
c_adw_preferences_page_get_type

instance B.Types.GObject PreferencesPage

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

instance O.HasParentTypes PreferencesPage
type instance O.ParentTypes PreferencesPage = '[Gtk.Widget.Widget, GObject.Object.Object, Gtk.Accessible.Accessible, Gtk.Buildable.Buildable, Gtk.ConstraintTarget.ConstraintTarget]

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

-- | Convert 'PreferencesPage' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe PreferencesPage) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_adw_preferences_page_get_type
    gvalueSet_ :: Ptr GValue -> Maybe PreferencesPage -> IO ()
gvalueSet_ Ptr GValue
gv Maybe PreferencesPage
P.Nothing = Ptr GValue -> Ptr PreferencesPage -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr PreferencesPage
forall a. Ptr a
FP.nullPtr :: FP.Ptr PreferencesPage)
    gvalueSet_ Ptr GValue
gv (P.Just PreferencesPage
obj) = PreferencesPage -> (Ptr PreferencesPage -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr PreferencesPage
obj (Ptr GValue -> Ptr PreferencesPage -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe PreferencesPage)
gvalueGet_ Ptr GValue
gv = do
        Ptr PreferencesPage
ptr <- Ptr GValue -> IO (Ptr PreferencesPage)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr PreferencesPage)
        if Ptr PreferencesPage
ptr Ptr PreferencesPage -> Ptr PreferencesPage -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr PreferencesPage
forall a. Ptr a
FP.nullPtr
        then PreferencesPage -> Maybe PreferencesPage
forall a. a -> Maybe a
P.Just (PreferencesPage -> Maybe PreferencesPage)
-> IO PreferencesPage -> IO (Maybe PreferencesPage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr PreferencesPage -> PreferencesPage)
-> Ptr PreferencesPage -> IO PreferencesPage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr PreferencesPage -> PreferencesPage
PreferencesPage Ptr PreferencesPage
ptr
        else Maybe PreferencesPage -> IO (Maybe PreferencesPage)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PreferencesPage
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolvePreferencesPageMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePreferencesPageMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolvePreferencesPageMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolvePreferencesPageMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolvePreferencesPageMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolvePreferencesPageMethod "add" o = PreferencesPageAddMethodInfo
    ResolvePreferencesPageMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolvePreferencesPageMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    ResolvePreferencesPageMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolvePreferencesPageMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolvePreferencesPageMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolvePreferencesPageMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePreferencesPageMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePreferencesPageMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolvePreferencesPageMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolvePreferencesPageMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolvePreferencesPageMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolvePreferencesPageMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolvePreferencesPageMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolvePreferencesPageMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolvePreferencesPageMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolvePreferencesPageMethod "disposeTemplate" o = Gtk.Widget.WidgetDisposeTemplateMethodInfo
    ResolvePreferencesPageMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolvePreferencesPageMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolvePreferencesPageMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePreferencesPageMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePreferencesPageMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePreferencesPageMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolvePreferencesPageMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolvePreferencesPageMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolvePreferencesPageMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolvePreferencesPageMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolvePreferencesPageMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolvePreferencesPageMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolvePreferencesPageMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolvePreferencesPageMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolvePreferencesPageMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolvePreferencesPageMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolvePreferencesPageMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolvePreferencesPageMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolvePreferencesPageMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePreferencesPageMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolvePreferencesPageMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolvePreferencesPageMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolvePreferencesPageMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolvePreferencesPageMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolvePreferencesPageMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolvePreferencesPageMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolvePreferencesPageMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolvePreferencesPageMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePreferencesPageMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePreferencesPageMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolvePreferencesPageMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolvePreferencesPageMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolvePreferencesPageMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolvePreferencesPageMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolvePreferencesPageMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolvePreferencesPageMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolvePreferencesPageMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePreferencesPageMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePreferencesPageMethod "remove" o = PreferencesPageRemoveMethodInfo
    ResolvePreferencesPageMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolvePreferencesPageMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolvePreferencesPageMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolvePreferencesPageMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolvePreferencesPageMethod "resetProperty" o = Gtk.Accessible.AccessibleResetPropertyMethodInfo
    ResolvePreferencesPageMethod "resetRelation" o = Gtk.Accessible.AccessibleResetRelationMethodInfo
    ResolvePreferencesPageMethod "resetState" o = Gtk.Accessible.AccessibleResetStateMethodInfo
    ResolvePreferencesPageMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePreferencesPageMethod "scrollToTop" o = PreferencesPageScrollToTopMethodInfo
    ResolvePreferencesPageMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    ResolvePreferencesPageMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolvePreferencesPageMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolvePreferencesPageMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolvePreferencesPageMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePreferencesPageMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePreferencesPageMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePreferencesPageMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolvePreferencesPageMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolvePreferencesPageMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolvePreferencesPageMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolvePreferencesPageMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolvePreferencesPageMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePreferencesPageMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolvePreferencesPageMethod "updateNextAccessibleSibling" o = Gtk.Accessible.AccessibleUpdateNextAccessibleSiblingMethodInfo
    ResolvePreferencesPageMethod "updateProperty" o = Gtk.Accessible.AccessibleUpdatePropertyMethodInfo
    ResolvePreferencesPageMethod "updateRelation" o = Gtk.Accessible.AccessibleUpdateRelationMethodInfo
    ResolvePreferencesPageMethod "updateState" o = Gtk.Accessible.AccessibleUpdateStateMethodInfo
    ResolvePreferencesPageMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePreferencesPageMethod "getAccessibleParent" o = Gtk.Accessible.AccessibleGetAccessibleParentMethodInfo
    ResolvePreferencesPageMethod "getAccessibleRole" o = Gtk.Accessible.AccessibleGetAccessibleRoleMethodInfo
    ResolvePreferencesPageMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolvePreferencesPageMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolvePreferencesPageMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolvePreferencesPageMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolvePreferencesPageMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolvePreferencesPageMethod "getAtContext" o = Gtk.Accessible.AccessibleGetAtContextMethodInfo
    ResolvePreferencesPageMethod "getBounds" o = Gtk.Accessible.AccessibleGetBoundsMethodInfo
    ResolvePreferencesPageMethod "getBuildableId" o = Gtk.Buildable.BuildableGetBuildableIdMethodInfo
    ResolvePreferencesPageMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolvePreferencesPageMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolvePreferencesPageMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolvePreferencesPageMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolvePreferencesPageMethod "getColor" o = Gtk.Widget.WidgetGetColorMethodInfo
    ResolvePreferencesPageMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolvePreferencesPageMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    ResolvePreferencesPageMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolvePreferencesPageMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePreferencesPageMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolvePreferencesPageMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolvePreferencesPageMethod "getFirstAccessibleChild" o = Gtk.Accessible.AccessibleGetFirstAccessibleChildMethodInfo
    ResolvePreferencesPageMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolvePreferencesPageMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolvePreferencesPageMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolvePreferencesPageMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    ResolvePreferencesPageMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolvePreferencesPageMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolvePreferencesPageMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolvePreferencesPageMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolvePreferencesPageMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolvePreferencesPageMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolvePreferencesPageMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolvePreferencesPageMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolvePreferencesPageMethod "getIconName" o = PreferencesPageGetIconNameMethodInfo
    ResolvePreferencesPageMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolvePreferencesPageMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolvePreferencesPageMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolvePreferencesPageMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolvePreferencesPageMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolvePreferencesPageMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolvePreferencesPageMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolvePreferencesPageMethod "getName" o = PreferencesPageGetNameMethodInfo
    ResolvePreferencesPageMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    ResolvePreferencesPageMethod "getNextAccessibleSibling" o = Gtk.Accessible.AccessibleGetNextAccessibleSiblingMethodInfo
    ResolvePreferencesPageMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolvePreferencesPageMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolvePreferencesPageMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolvePreferencesPageMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolvePreferencesPageMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolvePreferencesPageMethod "getPlatformState" o = Gtk.Accessible.AccessibleGetPlatformStateMethodInfo
    ResolvePreferencesPageMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolvePreferencesPageMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolvePreferencesPageMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolvePreferencesPageMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePreferencesPageMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePreferencesPageMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolvePreferencesPageMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolvePreferencesPageMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolvePreferencesPageMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolvePreferencesPageMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolvePreferencesPageMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolvePreferencesPageMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolvePreferencesPageMethod "getSize" o = Gtk.Widget.WidgetGetSizeMethodInfo
    ResolvePreferencesPageMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolvePreferencesPageMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolvePreferencesPageMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolvePreferencesPageMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolvePreferencesPageMethod "getTitle" o = PreferencesPageGetTitleMethodInfo
    ResolvePreferencesPageMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolvePreferencesPageMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolvePreferencesPageMethod "getUseUnderline" o = PreferencesPageGetUseUnderlineMethodInfo
    ResolvePreferencesPageMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolvePreferencesPageMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolvePreferencesPageMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolvePreferencesPageMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolvePreferencesPageMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolvePreferencesPageMethod "setAccessibleParent" o = Gtk.Accessible.AccessibleSetAccessibleParentMethodInfo
    ResolvePreferencesPageMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolvePreferencesPageMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolvePreferencesPageMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolvePreferencesPageMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    ResolvePreferencesPageMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolvePreferencesPageMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolvePreferencesPageMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePreferencesPageMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePreferencesPageMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolvePreferencesPageMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolvePreferencesPageMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolvePreferencesPageMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolvePreferencesPageMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolvePreferencesPageMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolvePreferencesPageMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolvePreferencesPageMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolvePreferencesPageMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolvePreferencesPageMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolvePreferencesPageMethod "setIconName" o = PreferencesPageSetIconNameMethodInfo
    ResolvePreferencesPageMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolvePreferencesPageMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolvePreferencesPageMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolvePreferencesPageMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolvePreferencesPageMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolvePreferencesPageMethod "setName" o = PreferencesPageSetNameMethodInfo
    ResolvePreferencesPageMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolvePreferencesPageMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolvePreferencesPageMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolvePreferencesPageMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePreferencesPageMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolvePreferencesPageMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolvePreferencesPageMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolvePreferencesPageMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolvePreferencesPageMethod "setTitle" o = PreferencesPageSetTitleMethodInfo
    ResolvePreferencesPageMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolvePreferencesPageMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolvePreferencesPageMethod "setUseUnderline" o = PreferencesPageSetUseUnderlineMethodInfo
    ResolvePreferencesPageMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolvePreferencesPageMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolvePreferencesPageMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolvePreferencesPageMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolvePreferencesPageMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

--- XXX Duplicated object with different types:
  --- Name {namespace = "Adw", name = "PreferencesPage"} -> Property {propName = "name", propType = TBasicType TUTF8, propFlags = [PropertyReadable,PropertyWritable], propReadNullable = Just True, propWriteNullable = Just True, propTransfer = TransferNothing, propDoc = Documentation {rawDocText = Just "The name of this page.", sinceVersion = Nothing}, propDeprecated = Nothing}
  --- Name {namespace = "Gtk", name = "Widget"} -> Property {propName = "name", propType = TBasicType TUTF8, propFlags = [PropertyReadable,PropertyWritable], propReadNullable = Just False, propWriteNullable = Just False, propTransfer = TransferNothing, propDoc = Documentation {rawDocText = Just "The name of the widget.", sinceVersion = Nothing}, propDeprecated = Nothing}
-- VVV Prop "icon-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Set the value of the “@use-underline@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' preferencesPage [ #useUnderline 'Data.GI.Base.Attributes.:=' value ]
-- @
setPreferencesPageUseUnderline :: (MonadIO m, IsPreferencesPage o) => o -> Bool -> m ()
setPreferencesPageUseUnderline :: forall (m :: * -> *) o.
(MonadIO m, IsPreferencesPage o) =>
o -> Bool -> m ()
setPreferencesPageUseUnderline 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
"use-underline" Bool
val

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

#if defined(ENABLE_OVERLOADING)
data PreferencesPageUseUnderlinePropertyInfo
instance AttrInfo PreferencesPageUseUnderlinePropertyInfo where
    type AttrAllowedOps PreferencesPageUseUnderlinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PreferencesPageUseUnderlinePropertyInfo = IsPreferencesPage
    type AttrSetTypeConstraint PreferencesPageUseUnderlinePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PreferencesPageUseUnderlinePropertyInfo = (~) Bool
    type AttrTransferType PreferencesPageUseUnderlinePropertyInfo = Bool
    type AttrGetType PreferencesPageUseUnderlinePropertyInfo = Bool
    type AttrLabel PreferencesPageUseUnderlinePropertyInfo = "use-underline"
    type AttrOrigin PreferencesPageUseUnderlinePropertyInfo = PreferencesPage
    attrGet = getPreferencesPageUseUnderline
    attrSet = setPreferencesPageUseUnderline
    attrTransfer _ v = do
        return v
    attrConstruct = constructPreferencesPageUseUnderline
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.PreferencesPage.useUnderline"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-PreferencesPage.html#g:attr:useUnderline"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PreferencesPage
type instance O.AttributeList PreferencesPage = PreferencesPageAttributeList
type PreferencesPageAttributeList = ('[ '("accessibleRole", Gtk.Accessible.AccessibleAccessibleRolePropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("iconName", PreferencesPageIconNamePropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("name", PreferencesPageNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("title", PreferencesPageTitlePropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("useUnderline", PreferencesPageUseUnderlinePropertyInfo), '("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)
preferencesPageIconName :: AttrLabelProxy "iconName"
preferencesPageIconName = AttrLabelProxy

preferencesPageName :: AttrLabelProxy "name"
preferencesPageName = AttrLabelProxy

preferencesPageTitle :: AttrLabelProxy "title"
preferencesPageTitle = AttrLabelProxy

preferencesPageUseUnderline :: AttrLabelProxy "useUnderline"
preferencesPageUseUnderline = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList PreferencesPage = PreferencesPageSignalList
type PreferencesPageSignalList = ('[ '("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), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method PreferencesPage::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Adw" , name = "PreferencesPage" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_preferences_page_new" adw_preferences_page_new :: 
    IO (Ptr PreferencesPage)

-- | Creates a new @AdwPreferencesPage@.
preferencesPageNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m PreferencesPage
    -- ^ __Returns:__ the newly created @AdwPreferencesPage@
preferencesPageNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m PreferencesPage
preferencesPageNew  = IO PreferencesPage -> m PreferencesPage
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PreferencesPage -> m PreferencesPage)
-> IO PreferencesPage -> m PreferencesPage
forall a b. (a -> b) -> a -> b
$ do
    Ptr PreferencesPage
result <- IO (Ptr PreferencesPage)
adw_preferences_page_new
    Text -> Ptr PreferencesPage -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"preferencesPageNew" Ptr PreferencesPage
result
    PreferencesPage
result' <- ((ManagedPtr PreferencesPage -> PreferencesPage)
-> Ptr PreferencesPage -> IO PreferencesPage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PreferencesPage -> PreferencesPage
PreferencesPage) Ptr PreferencesPage
result
    PreferencesPage -> IO PreferencesPage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PreferencesPage
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "adw_preferences_page_add" adw_preferences_page_add :: 
    Ptr PreferencesPage ->                  -- self : TInterface (Name {namespace = "Adw", name = "PreferencesPage"})
    Ptr Adw.PreferencesGroup.PreferencesGroup -> -- group : TInterface (Name {namespace = "Adw", name = "PreferencesGroup"})
    IO ()

-- | Adds a preferences group to /@self@/.
preferencesPageAdd ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferencesPage a, Adw.PreferencesGroup.IsPreferencesGroup b) =>
    a
    -- ^ /@self@/: a preferences page
    -> b
    -- ^ /@group@/: the group to add
    -> m ()
preferencesPageAdd :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPreferencesPage a,
 IsPreferencesGroup b) =>
a -> b -> m ()
preferencesPageAdd a
self b
group = 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 PreferencesPage
self' <- a -> IO (Ptr PreferencesPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr PreferencesGroup
group' <- b -> IO (Ptr PreferencesGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
group
    Ptr PreferencesPage -> Ptr PreferencesGroup -> IO ()
adw_preferences_page_add Ptr PreferencesPage
self' Ptr PreferencesGroup
group'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
group
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PreferencesPageAddMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPreferencesPage a, Adw.PreferencesGroup.IsPreferencesGroup b) => O.OverloadedMethod PreferencesPageAddMethodInfo a signature where
    overloadedMethod = preferencesPageAdd

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


#endif

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

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

-- | Gets the icon name for /@self@/.
preferencesPageGetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferencesPage a) =>
    a
    -- ^ /@self@/: a preferences page
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the icon name for /@self@/
preferencesPageGetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferencesPage a) =>
a -> m (Maybe Text)
preferencesPageGetIconName 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 PreferencesPage
self' <- a -> IO (Ptr PreferencesPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr PreferencesPage -> IO CString
adw_preferences_page_get_icon_name Ptr PreferencesPage
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 PreferencesPageGetIconNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsPreferencesPage a) => O.OverloadedMethod PreferencesPageGetIconNameMethodInfo a signature where
    overloadedMethod = preferencesPageGetIconName

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


#endif

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

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

-- | Gets the name of /@self@/.
preferencesPageGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferencesPage a) =>
    a
    -- ^ /@self@/: a preferences page
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of /@self@/
preferencesPageGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferencesPage a) =>
a -> m (Maybe Text)
preferencesPageGetName 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 PreferencesPage
self' <- a -> IO (Ptr PreferencesPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr PreferencesPage -> IO CString
adw_preferences_page_get_name Ptr PreferencesPage
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 PreferencesPageGetNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsPreferencesPage a) => O.OverloadedMethod PreferencesPageGetNameMethodInfo a signature where
    overloadedMethod = preferencesPageGetName

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


#endif

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

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

-- | Gets the title of /@self@/.
preferencesPageGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferencesPage a) =>
    a
    -- ^ /@self@/: a preferences page
    -> m T.Text
    -- ^ __Returns:__ the title of /@self@/.
preferencesPageGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferencesPage a) =>
a -> m Text
preferencesPageGetTitle 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 PreferencesPage
self' <- a -> IO (Ptr PreferencesPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr PreferencesPage -> IO CString
adw_preferences_page_get_title Ptr PreferencesPage
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"preferencesPageGetTitle" 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 PreferencesPageGetTitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPreferencesPage a) => O.OverloadedMethod PreferencesPageGetTitleMethodInfo a signature where
    overloadedMethod = preferencesPageGetTitle

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


#endif

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

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

-- | Gets whether an embedded underline in the title indicates a mnemonic.
preferencesPageGetUseUnderline ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferencesPage a) =>
    a
    -- ^ /@self@/: a preferences page
    -> m Bool
    -- ^ __Returns:__ whether an embedded underline in the title indicates a mnemonic
preferencesPageGetUseUnderline :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferencesPage a) =>
a -> m Bool
preferencesPageGetUseUnderline 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 PreferencesPage
self' <- a -> IO (Ptr PreferencesPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr PreferencesPage -> IO CInt
adw_preferences_page_get_use_underline Ptr PreferencesPage
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 PreferencesPageGetUseUnderlineMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPreferencesPage a) => O.OverloadedMethod PreferencesPageGetUseUnderlineMethodInfo a signature where
    overloadedMethod = preferencesPageGetUseUnderline

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


#endif

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

foreign import ccall "adw_preferences_page_remove" adw_preferences_page_remove :: 
    Ptr PreferencesPage ->                  -- self : TInterface (Name {namespace = "Adw", name = "PreferencesPage"})
    Ptr Adw.PreferencesGroup.PreferencesGroup -> -- group : TInterface (Name {namespace = "Adw", name = "PreferencesGroup"})
    IO ()

-- | Removes a group from /@self@/.
preferencesPageRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferencesPage a, Adw.PreferencesGroup.IsPreferencesGroup b) =>
    a
    -- ^ /@self@/: a preferences page
    -> b
    -- ^ /@group@/: the group to remove
    -> m ()
preferencesPageRemove :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPreferencesPage a,
 IsPreferencesGroup b) =>
a -> b -> m ()
preferencesPageRemove a
self b
group = 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 PreferencesPage
self' <- a -> IO (Ptr PreferencesPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr PreferencesGroup
group' <- b -> IO (Ptr PreferencesGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
group
    Ptr PreferencesPage -> Ptr PreferencesGroup -> IO ()
adw_preferences_page_remove Ptr PreferencesPage
self' Ptr PreferencesGroup
group'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
group
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PreferencesPageRemoveMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPreferencesPage a, Adw.PreferencesGroup.IsPreferencesGroup b) => O.OverloadedMethod PreferencesPageRemoveMethodInfo a signature where
    overloadedMethod = preferencesPageRemove

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


#endif

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

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

-- | Scrolls the scrolled window of /@self@/ to the top.
-- 
-- /Since: 1.3/
preferencesPageScrollToTop ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferencesPage a) =>
    a
    -- ^ /@self@/: a preferences page
    -> m ()
preferencesPageScrollToTop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferencesPage a) =>
a -> m ()
preferencesPageScrollToTop a
self = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PreferencesPage
self' <- a -> IO (Ptr PreferencesPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr PreferencesPage -> IO ()
adw_preferences_page_scroll_to_top Ptr PreferencesPage
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PreferencesPageScrollToTopMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPreferencesPage a) => O.OverloadedMethod PreferencesPageScrollToTopMethodInfo a signature where
    overloadedMethod = preferencesPageScrollToTop

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


#endif

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

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

-- | Sets the icon name for /@self@/.
preferencesPageSetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferencesPage a) =>
    a
    -- ^ /@self@/: a preferences page
    -> Maybe (T.Text)
    -- ^ /@iconName@/: the icon name
    -> m ()
preferencesPageSetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferencesPage a) =>
a -> Maybe Text -> m ()
preferencesPageSetIconName a
self Maybe Text
iconName = 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 PreferencesPage
self' <- a -> IO (Ptr PreferencesPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeIconName <- case Maybe Text
iconName 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
jIconName -> do
            CString
jIconName' <- Text -> IO CString
textToCString Text
jIconName
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jIconName'
    Ptr PreferencesPage -> CString -> IO ()
adw_preferences_page_set_icon_name Ptr PreferencesPage
self' CString
maybeIconName
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeIconName
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

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

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

-- | Sets the name of /@self@/.
preferencesPageSetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferencesPage a) =>
    a
    -- ^ /@self@/: a preferences page
    -> Maybe (T.Text)
    -- ^ /@name@/: the name
    -> m ()
preferencesPageSetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferencesPage a) =>
a -> Maybe Text -> m ()
preferencesPageSetName a
self Maybe Text
name = 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 PreferencesPage
self' <- a -> IO (Ptr PreferencesPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeName <- case Maybe Text
name 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
jName -> do
            CString
jName' <- Text -> IO CString
textToCString Text
jName
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jName'
    Ptr PreferencesPage -> CString -> IO ()
adw_preferences_page_set_name Ptr PreferencesPage
self' CString
maybeName
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeName
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

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

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

-- | Sets the title of /@self@/.
preferencesPageSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferencesPage a) =>
    a
    -- ^ /@self@/: a preferences page
    -> T.Text
    -- ^ /@title@/: the title
    -> m ()
preferencesPageSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferencesPage a) =>
a -> Text -> m ()
preferencesPageSetTitle a
self Text
title = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PreferencesPage
self' <- a -> IO (Ptr PreferencesPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr PreferencesPage -> CString -> IO ()
adw_preferences_page_set_title Ptr PreferencesPage
self' CString
title'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method PreferencesPage::set_use_underline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "PreferencesPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a preferences page" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "use_underline"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "`TRUE` if underlines in the text indicate mnemonics"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_preferences_page_set_use_underline" adw_preferences_page_set_use_underline :: 
    Ptr PreferencesPage ->                  -- self : TInterface (Name {namespace = "Adw", name = "PreferencesPage"})
    CInt ->                                 -- use_underline : TBasicType TBoolean
    IO ()

-- | Sets whether an embedded underline in the title indicates a mnemonic.
preferencesPageSetUseUnderline ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferencesPage a) =>
    a
    -- ^ /@self@/: a preferences page
    -> Bool
    -- ^ /@useUnderline@/: @TRUE@ if underlines in the text indicate mnemonics
    -> m ()
preferencesPageSetUseUnderline :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferencesPage a) =>
a -> Bool -> m ()
preferencesPageSetUseUnderline a
self Bool
useUnderline = 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 PreferencesPage
self' <- a -> IO (Ptr PreferencesPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let useUnderline' :: CInt
useUnderline' = (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
useUnderline
    Ptr PreferencesPage -> CInt -> IO ()
adw_preferences_page_set_use_underline Ptr PreferencesPage
self' CInt
useUnderline'
    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 PreferencesPageSetUseUnderlineMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsPreferencesPage a) => O.OverloadedMethod PreferencesPageSetUseUnderlineMethodInfo a signature where
    overloadedMethod = preferencesPageSetUseUnderline

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


#endif