{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An auxiliary class used by [class/@tabView@/].

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

module GI.Adw.Objects.TabPage
    ( 

-- * Exported types
    TabPage(..)                             ,
    IsTabPage                               ,
    toTabPage                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [invalidateThumbnail]("GI.Adw.Objects.TabPage#g:method:invalidateThumbnail"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [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"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [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"), [getAtContext]("GI.Gtk.Interfaces.Accessible#g:method:getAtContext"), [getBounds]("GI.Gtk.Interfaces.Accessible#g:method:getBounds"), [getChild]("GI.Adw.Objects.TabPage#g:method:getChild"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFirstAccessibleChild]("GI.Gtk.Interfaces.Accessible#g:method:getFirstAccessibleChild"), [getIcon]("GI.Adw.Objects.TabPage#g:method:getIcon"), [getIndicatorActivatable]("GI.Adw.Objects.TabPage#g:method:getIndicatorActivatable"), [getIndicatorIcon]("GI.Adw.Objects.TabPage#g:method:getIndicatorIcon"), [getIndicatorTooltip]("GI.Adw.Objects.TabPage#g:method:getIndicatorTooltip"), [getKeyword]("GI.Adw.Objects.TabPage#g:method:getKeyword"), [getLiveThumbnail]("GI.Adw.Objects.TabPage#g:method:getLiveThumbnail"), [getLoading]("GI.Adw.Objects.TabPage#g:method:getLoading"), [getNeedsAttention]("GI.Adw.Objects.TabPage#g:method:getNeedsAttention"), [getNextAccessibleSibling]("GI.Gtk.Interfaces.Accessible#g:method:getNextAccessibleSibling"), [getParent]("GI.Adw.Objects.TabPage#g:method:getParent"), [getPinned]("GI.Adw.Objects.TabPage#g:method:getPinned"), [getPlatformState]("GI.Gtk.Interfaces.Accessible#g:method:getPlatformState"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSelected]("GI.Adw.Objects.TabPage#g:method:getSelected"), [getThumbnailXalign]("GI.Adw.Objects.TabPage#g:method:getThumbnailXalign"), [getThumbnailYalign]("GI.Adw.Objects.TabPage#g:method:getThumbnailYalign"), [getTitle]("GI.Adw.Objects.TabPage#g:method:getTitle"), [getTooltip]("GI.Adw.Objects.TabPage#g:method:getTooltip").
-- 
-- ==== Setters
-- [setAccessibleParent]("GI.Gtk.Interfaces.Accessible#g:method:setAccessibleParent"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setIcon]("GI.Adw.Objects.TabPage#g:method:setIcon"), [setIndicatorActivatable]("GI.Adw.Objects.TabPage#g:method:setIndicatorActivatable"), [setIndicatorIcon]("GI.Adw.Objects.TabPage#g:method:setIndicatorIcon"), [setIndicatorTooltip]("GI.Adw.Objects.TabPage#g:method:setIndicatorTooltip"), [setKeyword]("GI.Adw.Objects.TabPage#g:method:setKeyword"), [setLiveThumbnail]("GI.Adw.Objects.TabPage#g:method:setLiveThumbnail"), [setLoading]("GI.Adw.Objects.TabPage#g:method:setLoading"), [setNeedsAttention]("GI.Adw.Objects.TabPage#g:method:setNeedsAttention"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setThumbnailXalign]("GI.Adw.Objects.TabPage#g:method:setThumbnailXalign"), [setThumbnailYalign]("GI.Adw.Objects.TabPage#g:method:setThumbnailYalign"), [setTitle]("GI.Adw.Objects.TabPage#g:method:setTitle"), [setTooltip]("GI.Adw.Objects.TabPage#g:method:setTooltip").

#if defined(ENABLE_OVERLOADING)
    ResolveTabPageMethod                    ,
#endif

-- ** getChild #method:getChild#

#if defined(ENABLE_OVERLOADING)
    TabPageGetChildMethodInfo               ,
#endif
    tabPageGetChild                         ,


-- ** getIcon #method:getIcon#

#if defined(ENABLE_OVERLOADING)
    TabPageGetIconMethodInfo                ,
#endif
    tabPageGetIcon                          ,


-- ** getIndicatorActivatable #method:getIndicatorActivatable#

#if defined(ENABLE_OVERLOADING)
    TabPageGetIndicatorActivatableMethodInfo,
#endif
    tabPageGetIndicatorActivatable          ,


-- ** getIndicatorIcon #method:getIndicatorIcon#

#if defined(ENABLE_OVERLOADING)
    TabPageGetIndicatorIconMethodInfo       ,
#endif
    tabPageGetIndicatorIcon                 ,


-- ** getIndicatorTooltip #method:getIndicatorTooltip#

#if defined(ENABLE_OVERLOADING)
    TabPageGetIndicatorTooltipMethodInfo    ,
#endif
    tabPageGetIndicatorTooltip              ,


-- ** getKeyword #method:getKeyword#

#if defined(ENABLE_OVERLOADING)
    TabPageGetKeywordMethodInfo             ,
#endif
    tabPageGetKeyword                       ,


-- ** getLiveThumbnail #method:getLiveThumbnail#

#if defined(ENABLE_OVERLOADING)
    TabPageGetLiveThumbnailMethodInfo       ,
#endif
    tabPageGetLiveThumbnail                 ,


-- ** getLoading #method:getLoading#

#if defined(ENABLE_OVERLOADING)
    TabPageGetLoadingMethodInfo             ,
#endif
    tabPageGetLoading                       ,


-- ** getNeedsAttention #method:getNeedsAttention#

#if defined(ENABLE_OVERLOADING)
    TabPageGetNeedsAttentionMethodInfo      ,
#endif
    tabPageGetNeedsAttention                ,


-- ** getParent #method:getParent#

#if defined(ENABLE_OVERLOADING)
    TabPageGetParentMethodInfo              ,
#endif
    tabPageGetParent                        ,


-- ** getPinned #method:getPinned#

#if defined(ENABLE_OVERLOADING)
    TabPageGetPinnedMethodInfo              ,
#endif
    tabPageGetPinned                        ,


-- ** getSelected #method:getSelected#

#if defined(ENABLE_OVERLOADING)
    TabPageGetSelectedMethodInfo            ,
#endif
    tabPageGetSelected                      ,


-- ** getThumbnailXalign #method:getThumbnailXalign#

#if defined(ENABLE_OVERLOADING)
    TabPageGetThumbnailXalignMethodInfo     ,
#endif
    tabPageGetThumbnailXalign               ,


-- ** getThumbnailYalign #method:getThumbnailYalign#

#if defined(ENABLE_OVERLOADING)
    TabPageGetThumbnailYalignMethodInfo     ,
#endif
    tabPageGetThumbnailYalign               ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    TabPageGetTitleMethodInfo               ,
#endif
    tabPageGetTitle                         ,


-- ** getTooltip #method:getTooltip#

#if defined(ENABLE_OVERLOADING)
    TabPageGetTooltipMethodInfo             ,
#endif
    tabPageGetTooltip                       ,


-- ** invalidateThumbnail #method:invalidateThumbnail#

#if defined(ENABLE_OVERLOADING)
    TabPageInvalidateThumbnailMethodInfo    ,
#endif
    tabPageInvalidateThumbnail              ,


-- ** setIcon #method:setIcon#

#if defined(ENABLE_OVERLOADING)
    TabPageSetIconMethodInfo                ,
#endif
    tabPageSetIcon                          ,


-- ** setIndicatorActivatable #method:setIndicatorActivatable#

#if defined(ENABLE_OVERLOADING)
    TabPageSetIndicatorActivatableMethodInfo,
#endif
    tabPageSetIndicatorActivatable          ,


-- ** setIndicatorIcon #method:setIndicatorIcon#

#if defined(ENABLE_OVERLOADING)
    TabPageSetIndicatorIconMethodInfo       ,
#endif
    tabPageSetIndicatorIcon                 ,


-- ** setIndicatorTooltip #method:setIndicatorTooltip#

#if defined(ENABLE_OVERLOADING)
    TabPageSetIndicatorTooltipMethodInfo    ,
#endif
    tabPageSetIndicatorTooltip              ,


-- ** setKeyword #method:setKeyword#

#if defined(ENABLE_OVERLOADING)
    TabPageSetKeywordMethodInfo             ,
#endif
    tabPageSetKeyword                       ,


-- ** setLiveThumbnail #method:setLiveThumbnail#

#if defined(ENABLE_OVERLOADING)
    TabPageSetLiveThumbnailMethodInfo       ,
#endif
    tabPageSetLiveThumbnail                 ,


-- ** setLoading #method:setLoading#

#if defined(ENABLE_OVERLOADING)
    TabPageSetLoadingMethodInfo             ,
#endif
    tabPageSetLoading                       ,


-- ** setNeedsAttention #method:setNeedsAttention#

#if defined(ENABLE_OVERLOADING)
    TabPageSetNeedsAttentionMethodInfo      ,
#endif
    tabPageSetNeedsAttention                ,


-- ** setThumbnailXalign #method:setThumbnailXalign#

#if defined(ENABLE_OVERLOADING)
    TabPageSetThumbnailXalignMethodInfo     ,
#endif
    tabPageSetThumbnailXalign               ,


-- ** setThumbnailYalign #method:setThumbnailYalign#

#if defined(ENABLE_OVERLOADING)
    TabPageSetThumbnailYalignMethodInfo     ,
#endif
    tabPageSetThumbnailYalign               ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    TabPageSetTitleMethodInfo               ,
#endif
    tabPageSetTitle                         ,


-- ** setTooltip #method:setTooltip#

#if defined(ENABLE_OVERLOADING)
    TabPageSetTooltipMethodInfo             ,
#endif
    tabPageSetTooltip                       ,




 -- * Properties


-- ** child #attr:child#
-- | The child of the page.

#if defined(ENABLE_OVERLOADING)
    TabPageChildPropertyInfo                ,
#endif
    constructTabPageChild                   ,
    getTabPageChild                         ,
#if defined(ENABLE_OVERLOADING)
    tabPageChild                            ,
#endif


-- ** icon #attr:icon#
-- | The icon of the page.
-- 
-- [class/@tabBar@/] and [class/@tabOverview@/] display the icon next to the title,
-- unless [property/@tabPage@/:loading] is set to @TRUE@.
-- 
-- @AdwTabBar@ also won\'t show the icon if the page is pinned and
-- [propertyTabPage:indicator-icon] is set.

#if defined(ENABLE_OVERLOADING)
    TabPageIconPropertyInfo                 ,
#endif
    clearTabPageIcon                        ,
    constructTabPageIcon                    ,
    getTabPageIcon                          ,
    setTabPageIcon                          ,
#if defined(ENABLE_OVERLOADING)
    tabPageIcon                             ,
#endif


-- ** indicatorActivatable #attr:indicatorActivatable#
-- | Whether the indicator icon is activatable.
-- 
-- If set to @TRUE@, [signal/@tabView@/[indicatorActivated](#g:signal:indicatorActivated)] will be emitted
-- when the indicator icon is clicked.
-- 
-- If [property/@tabPage@/:indicator-icon] is not set, does nothing.

#if defined(ENABLE_OVERLOADING)
    TabPageIndicatorActivatablePropertyInfo ,
#endif
    constructTabPageIndicatorActivatable    ,
    getTabPageIndicatorActivatable          ,
    setTabPageIndicatorActivatable          ,
#if defined(ENABLE_OVERLOADING)
    tabPageIndicatorActivatable             ,
#endif


-- ** indicatorIcon #attr:indicatorIcon#
-- | An indicator icon for the page.
-- 
-- A common use case is an audio or camera indicator in a web browser.
-- 
-- [class/@tabBar@/] will show it at the beginning of the tab, alongside icon
-- representing [property/@tabPage@/:icon] or loading spinner.
-- 
-- If the page is pinned, the indicator will be shown instead of icon or
-- spinner.
-- 
-- [class/@tabOverview@/] will show it at the at the top part of the thumbnail.
-- 
-- [property/@tabPage@/:indicator-tooltip] can be used to set the tooltip on the
-- indicator icon.
-- 
-- If [property/@tabPage@/:indicator-activatable] is set to @TRUE@, the
-- indicator icon can act as a button.

#if defined(ENABLE_OVERLOADING)
    TabPageIndicatorIconPropertyInfo        ,
#endif
    clearTabPageIndicatorIcon               ,
    constructTabPageIndicatorIcon           ,
    getTabPageIndicatorIcon                 ,
    setTabPageIndicatorIcon                 ,
#if defined(ENABLE_OVERLOADING)
    tabPageIndicatorIcon                    ,
#endif


-- ** indicatorTooltip #attr:indicatorTooltip#
-- | The tooltip of the indicator icon.
-- 
-- The tooltip can be marked up with the Pango text markup language.
-- 
-- See [property/@tabPage@/:indicator-icon].
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    TabPageIndicatorTooltipPropertyInfo     ,
#endif
    constructTabPageIndicatorTooltip        ,
    getTabPageIndicatorTooltip              ,
    setTabPageIndicatorTooltip              ,
#if defined(ENABLE_OVERLOADING)
    tabPageIndicatorTooltip                 ,
#endif


-- ** keyword #attr:keyword#
-- | The search keyboard of the page.
-- 
-- [class/@tabOverview@/] can search pages by their keywords in addition to their
-- titles and tooltips.
-- 
-- Keywords allow to include e.g. page URLs into tab search in a web browser.
-- 
-- /Since: 1.3/

#if defined(ENABLE_OVERLOADING)
    TabPageKeywordPropertyInfo              ,
#endif
    constructTabPageKeyword                 ,
    getTabPageKeyword                       ,
    setTabPageKeyword                       ,
#if defined(ENABLE_OVERLOADING)
    tabPageKeyword                          ,
#endif


-- ** liveThumbnail #attr:liveThumbnail#
-- | Whether to enable live thumbnail for this page.
-- 
-- When set to @TRUE@, the page\'s thumbnail in [class/@tabOverview@/] will update
-- immediately when the page is redrawn or resized.
-- 
-- If it\'s set to @FALSE@, the thumbnail will only be live when the page is
-- selected, and otherwise it will be static and will only update when
-- [method/@tabPage@/.invalidate_thumbnail] or
-- [method/@tabView@/.invalidate_thumbnails] is called.
-- 
-- /Since: 1.3/

#if defined(ENABLE_OVERLOADING)
    TabPageLiveThumbnailPropertyInfo        ,
#endif
    constructTabPageLiveThumbnail           ,
    getTabPageLiveThumbnail                 ,
    setTabPageLiveThumbnail                 ,
#if defined(ENABLE_OVERLOADING)
    tabPageLiveThumbnail                    ,
#endif


-- ** loading #attr:loading#
-- | Whether the page is loading.
-- 
-- If set to @TRUE@, [class/@tabBar@/] and [class/@tabOverview@/] will display a
-- spinner in place of icon.
-- 
-- If the page is pinned and [property/@tabPage@/:indicator-icon] is set,
-- loading status will not be visible with @AdwTabBar@.

#if defined(ENABLE_OVERLOADING)
    TabPageLoadingPropertyInfo              ,
#endif
    constructTabPageLoading                 ,
    getTabPageLoading                       ,
    setTabPageLoading                       ,
#if defined(ENABLE_OVERLOADING)
    tabPageLoading                          ,
#endif


-- ** needsAttention #attr:needsAttention#
-- | Whether the page needs attention.
-- 
-- [class/@tabBar@/] will display a line under the tab representing the page if
-- set to @TRUE@. If the tab is not visible, the corresponding edge of the tab
-- bar will be highlighted.
-- 
-- [class/@tabOverview@/] will display a dot in the corner of the thumbnail if set
-- to @TRUE@.
-- 
-- [class/@tabButton@/] will display a dot if any of the pages that aren\'t
-- selected have this property set to @TRUE@.

#if defined(ENABLE_OVERLOADING)
    TabPageNeedsAttentionPropertyInfo       ,
#endif
    constructTabPageNeedsAttention          ,
    getTabPageNeedsAttention                ,
    setTabPageNeedsAttention                ,
#if defined(ENABLE_OVERLOADING)
    tabPageNeedsAttention                   ,
#endif


-- ** parent #attr:parent#
-- | The parent page of the page.
-- 
-- See [method/@tabView@/.add_page] and [method/@tabView@/.close_page].

#if defined(ENABLE_OVERLOADING)
    TabPageParentPropertyInfo               ,
#endif
    constructTabPageParent                  ,
    getTabPageParent                        ,
#if defined(ENABLE_OVERLOADING)
    tabPageParent                           ,
#endif


-- ** pinned #attr:pinned#
-- | Whether the page is pinned.
-- 
-- See [method/@tabView@/.set_page_pinned].

#if defined(ENABLE_OVERLOADING)
    TabPagePinnedPropertyInfo               ,
#endif
    getTabPagePinned                        ,
#if defined(ENABLE_OVERLOADING)
    tabPagePinned                           ,
#endif


-- ** selected #attr:selected#
-- | Whether the page is selected.

#if defined(ENABLE_OVERLOADING)
    TabPageSelectedPropertyInfo             ,
#endif
    getTabPageSelected                      ,
#if defined(ENABLE_OVERLOADING)
    tabPageSelected                         ,
#endif


-- ** thumbnailXalign #attr:thumbnailXalign#
-- | The horizontal alignment of the page thumbnail.
-- 
-- If the page is so wide that [class/@tabOverview@/] can\'t display it completely
-- and has to crop it, horizontal alignment will determine which part of the
-- page will be visible.
-- 
-- For example, 0.5 means the center of the page will be visible, 0 means the
-- start edge will be visible and 1 means the end edge will be visible.
-- 
-- The default horizontal alignment is 0.
-- 
-- /Since: 1.3/

#if defined(ENABLE_OVERLOADING)
    TabPageThumbnailXalignPropertyInfo      ,
#endif
    constructTabPageThumbnailXalign         ,
    getTabPageThumbnailXalign               ,
    setTabPageThumbnailXalign               ,
#if defined(ENABLE_OVERLOADING)
    tabPageThumbnailXalign                  ,
#endif


-- ** thumbnailYalign #attr:thumbnailYalign#
-- | The vertical alignment of the page thumbnail.
-- 
-- If the page is so tall that [class/@tabOverview@/] can\'t display it completely
-- and has to crop it, vertical alignment will determine which part of the
-- page will be visible.
-- 
-- For example, 0.5 means the center of the page will be visible, 0 means the
-- top edge will be visible and 1 means the bottom edge will be visible.
-- 
-- The default vertical alignment is 0.
-- 
-- /Since: 1.3/

#if defined(ENABLE_OVERLOADING)
    TabPageThumbnailYalignPropertyInfo      ,
#endif
    constructTabPageThumbnailYalign         ,
    getTabPageThumbnailYalign               ,
    setTabPageThumbnailYalign               ,
#if defined(ENABLE_OVERLOADING)
    tabPageThumbnailYalign                  ,
#endif


-- ** title #attr:title#
-- | The title of the page.
-- 
-- [class/@tabBar@/] will display it in the center of the tab unless it\'s pinned,
-- and will use it as a tooltip unless [property/@tabPage@/:tooltip] is set.
-- 
-- [class/@tabOverview@/] will display it below the thumbnail unless it\'s pinned,
-- or inside the card otherwise, and will use it as a tooltip unless
-- [property/@tabPage@/:tooltip] is set.

#if defined(ENABLE_OVERLOADING)
    TabPageTitlePropertyInfo                ,
#endif
    constructTabPageTitle                   ,
    getTabPageTitle                         ,
    setTabPageTitle                         ,
#if defined(ENABLE_OVERLOADING)
    tabPageTitle                            ,
#endif


-- ** tooltip #attr:tooltip#
-- | The tooltip of the page.
-- 
-- The tooltip can be marked up with the Pango text markup language.
-- 
-- If not set, [class/@tabBar@/] and [class/@tabOverview@/] will use
-- [property/@tabPage@/:title] as a tooltip instead.

#if defined(ENABLE_OVERLOADING)
    TabPageTooltipPropertyInfo              ,
#endif
    constructTabPageTooltip                 ,
    getTabPageTooltip                       ,
    setTabPageTooltip                       ,
#if defined(ENABLE_OVERLOADING)
    tabPageTooltip                          ,
#endif




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

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

foreign import ccall "adw_tab_page_get_type"
    c_adw_tab_page_get_type :: IO B.Types.GType

instance B.Types.TypedObject TabPage where
    glibType :: IO GType
glibType = IO GType
c_adw_tab_page_get_type

instance B.Types.GObject TabPage

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

instance O.HasParentTypes TabPage
type instance O.ParentTypes TabPage = '[GObject.Object.Object, Gtk.Accessible.Accessible]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveTabPageMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTabPageMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTabPageMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTabPageMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTabPageMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTabPageMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTabPageMethod "invalidateThumbnail" o = TabPageInvalidateThumbnailMethodInfo
    ResolveTabPageMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTabPageMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTabPageMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTabPageMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTabPageMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTabPageMethod "resetProperty" o = Gtk.Accessible.AccessibleResetPropertyMethodInfo
    ResolveTabPageMethod "resetRelation" o = Gtk.Accessible.AccessibleResetRelationMethodInfo
    ResolveTabPageMethod "resetState" o = Gtk.Accessible.AccessibleResetStateMethodInfo
    ResolveTabPageMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTabPageMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTabPageMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTabPageMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTabPageMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTabPageMethod "updateNextAccessibleSibling" o = Gtk.Accessible.AccessibleUpdateNextAccessibleSiblingMethodInfo
    ResolveTabPageMethod "updateProperty" o = Gtk.Accessible.AccessibleUpdatePropertyMethodInfo
    ResolveTabPageMethod "updateRelation" o = Gtk.Accessible.AccessibleUpdateRelationMethodInfo
    ResolveTabPageMethod "updateState" o = Gtk.Accessible.AccessibleUpdateStateMethodInfo
    ResolveTabPageMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTabPageMethod "getAccessibleParent" o = Gtk.Accessible.AccessibleGetAccessibleParentMethodInfo
    ResolveTabPageMethod "getAccessibleRole" o = Gtk.Accessible.AccessibleGetAccessibleRoleMethodInfo
    ResolveTabPageMethod "getAtContext" o = Gtk.Accessible.AccessibleGetAtContextMethodInfo
    ResolveTabPageMethod "getBounds" o = Gtk.Accessible.AccessibleGetBoundsMethodInfo
    ResolveTabPageMethod "getChild" o = TabPageGetChildMethodInfo
    ResolveTabPageMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTabPageMethod "getFirstAccessibleChild" o = Gtk.Accessible.AccessibleGetFirstAccessibleChildMethodInfo
    ResolveTabPageMethod "getIcon" o = TabPageGetIconMethodInfo
    ResolveTabPageMethod "getIndicatorActivatable" o = TabPageGetIndicatorActivatableMethodInfo
    ResolveTabPageMethod "getIndicatorIcon" o = TabPageGetIndicatorIconMethodInfo
    ResolveTabPageMethod "getIndicatorTooltip" o = TabPageGetIndicatorTooltipMethodInfo
    ResolveTabPageMethod "getKeyword" o = TabPageGetKeywordMethodInfo
    ResolveTabPageMethod "getLiveThumbnail" o = TabPageGetLiveThumbnailMethodInfo
    ResolveTabPageMethod "getLoading" o = TabPageGetLoadingMethodInfo
    ResolveTabPageMethod "getNeedsAttention" o = TabPageGetNeedsAttentionMethodInfo
    ResolveTabPageMethod "getNextAccessibleSibling" o = Gtk.Accessible.AccessibleGetNextAccessibleSiblingMethodInfo
    ResolveTabPageMethod "getParent" o = TabPageGetParentMethodInfo
    ResolveTabPageMethod "getPinned" o = TabPageGetPinnedMethodInfo
    ResolveTabPageMethod "getPlatformState" o = Gtk.Accessible.AccessibleGetPlatformStateMethodInfo
    ResolveTabPageMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTabPageMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTabPageMethod "getSelected" o = TabPageGetSelectedMethodInfo
    ResolveTabPageMethod "getThumbnailXalign" o = TabPageGetThumbnailXalignMethodInfo
    ResolveTabPageMethod "getThumbnailYalign" o = TabPageGetThumbnailYalignMethodInfo
    ResolveTabPageMethod "getTitle" o = TabPageGetTitleMethodInfo
    ResolveTabPageMethod "getTooltip" o = TabPageGetTooltipMethodInfo
    ResolveTabPageMethod "setAccessibleParent" o = Gtk.Accessible.AccessibleSetAccessibleParentMethodInfo
    ResolveTabPageMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTabPageMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTabPageMethod "setIcon" o = TabPageSetIconMethodInfo
    ResolveTabPageMethod "setIndicatorActivatable" o = TabPageSetIndicatorActivatableMethodInfo
    ResolveTabPageMethod "setIndicatorIcon" o = TabPageSetIndicatorIconMethodInfo
    ResolveTabPageMethod "setIndicatorTooltip" o = TabPageSetIndicatorTooltipMethodInfo
    ResolveTabPageMethod "setKeyword" o = TabPageSetKeywordMethodInfo
    ResolveTabPageMethod "setLiveThumbnail" o = TabPageSetLiveThumbnailMethodInfo
    ResolveTabPageMethod "setLoading" o = TabPageSetLoadingMethodInfo
    ResolveTabPageMethod "setNeedsAttention" o = TabPageSetNeedsAttentionMethodInfo
    ResolveTabPageMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTabPageMethod "setThumbnailXalign" o = TabPageSetThumbnailXalignMethodInfo
    ResolveTabPageMethod "setThumbnailYalign" o = TabPageSetThumbnailYalignMethodInfo
    ResolveTabPageMethod "setTitle" o = TabPageSetTitleMethodInfo
    ResolveTabPageMethod "setTooltip" o = TabPageSetTooltipMethodInfo
    ResolveTabPageMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data TabPageChildPropertyInfo
instance AttrInfo TabPageChildPropertyInfo where
    type AttrAllowedOps TabPageChildPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TabPageChildPropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageChildPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint TabPageChildPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType TabPageChildPropertyInfo = Gtk.Widget.Widget
    type AttrGetType TabPageChildPropertyInfo = Gtk.Widget.Widget
    type AttrLabel TabPageChildPropertyInfo = "child"
    type AttrOrigin TabPageChildPropertyInfo = TabPage
    attrGet = getTabPageChild
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructTabPageChild
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.child"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:child"
        })
#endif

-- VVV Prop "icon"
   -- Type: TInterface (Name {namespace = "Gio", name = "Icon"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

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

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

-- | Set the value of the “@icon@” 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' #icon
-- @
clearTabPageIcon :: (MonadIO m, IsTabPage o) => o -> m ()
clearTabPageIcon :: forall (m :: * -> *) o. (MonadIO m, IsTabPage o) => o -> m ()
clearTabPageIcon 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 Icon -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"icon" (Maybe Icon
forall a. Maybe a
Nothing :: Maybe Gio.Icon.Icon)

#if defined(ENABLE_OVERLOADING)
data TabPageIconPropertyInfo
instance AttrInfo TabPageIconPropertyInfo where
    type AttrAllowedOps TabPageIconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TabPageIconPropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageIconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferTypeConstraint TabPageIconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferType TabPageIconPropertyInfo = Gio.Icon.Icon
    type AttrGetType TabPageIconPropertyInfo = (Maybe Gio.Icon.Icon)
    type AttrLabel TabPageIconPropertyInfo = "icon"
    type AttrOrigin TabPageIconPropertyInfo = TabPage
    attrGet = getTabPageIcon
    attrSet = setTabPageIcon
    attrTransfer _ v = do
        unsafeCastTo Gio.Icon.Icon v
    attrConstruct = constructTabPageIcon
    attrClear = clearTabPageIcon
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.icon"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:icon"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data TabPageIndicatorActivatablePropertyInfo
instance AttrInfo TabPageIndicatorActivatablePropertyInfo where
    type AttrAllowedOps TabPageIndicatorActivatablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TabPageIndicatorActivatablePropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageIndicatorActivatablePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TabPageIndicatorActivatablePropertyInfo = (~) Bool
    type AttrTransferType TabPageIndicatorActivatablePropertyInfo = Bool
    type AttrGetType TabPageIndicatorActivatablePropertyInfo = Bool
    type AttrLabel TabPageIndicatorActivatablePropertyInfo = "indicator-activatable"
    type AttrOrigin TabPageIndicatorActivatablePropertyInfo = TabPage
    attrGet = getTabPageIndicatorActivatable
    attrSet = setTabPageIndicatorActivatable
    attrTransfer _ v = do
        return v
    attrConstruct = constructTabPageIndicatorActivatable
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.indicatorActivatable"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:indicatorActivatable"
        })
#endif

-- VVV Prop "indicator-icon"
   -- Type: TInterface (Name {namespace = "Gio", name = "Icon"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@indicator-icon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' tabPage [ #indicatorIcon 'Data.GI.Base.Attributes.:=' value ]
-- @
setTabPageIndicatorIcon :: (MonadIO m, IsTabPage o, Gio.Icon.IsIcon a) => o -> a -> m ()
setTabPageIndicatorIcon :: forall (m :: * -> *) o a.
(MonadIO m, IsTabPage o, IsIcon a) =>
o -> a -> m ()
setTabPageIndicatorIcon o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"indicator-icon" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

-- | Set the value of the “@indicator-icon@” 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' #indicatorIcon
-- @
clearTabPageIndicatorIcon :: (MonadIO m, IsTabPage o) => o -> m ()
clearTabPageIndicatorIcon :: forall (m :: * -> *) o. (MonadIO m, IsTabPage o) => o -> m ()
clearTabPageIndicatorIcon 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 Icon -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"indicator-icon" (Maybe Icon
forall a. Maybe a
Nothing :: Maybe Gio.Icon.Icon)

#if defined(ENABLE_OVERLOADING)
data TabPageIndicatorIconPropertyInfo
instance AttrInfo TabPageIndicatorIconPropertyInfo where
    type AttrAllowedOps TabPageIndicatorIconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TabPageIndicatorIconPropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageIndicatorIconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferTypeConstraint TabPageIndicatorIconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferType TabPageIndicatorIconPropertyInfo = Gio.Icon.Icon
    type AttrGetType TabPageIndicatorIconPropertyInfo = (Maybe Gio.Icon.Icon)
    type AttrLabel TabPageIndicatorIconPropertyInfo = "indicator-icon"
    type AttrOrigin TabPageIndicatorIconPropertyInfo = TabPage
    attrGet = getTabPageIndicatorIcon
    attrSet = setTabPageIndicatorIcon
    attrTransfer _ v = do
        unsafeCastTo Gio.Icon.Icon v
    attrConstruct = constructTabPageIndicatorIcon
    attrClear = clearTabPageIndicatorIcon
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.indicatorIcon"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:indicatorIcon"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data TabPageIndicatorTooltipPropertyInfo
instance AttrInfo TabPageIndicatorTooltipPropertyInfo where
    type AttrAllowedOps TabPageIndicatorTooltipPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TabPageIndicatorTooltipPropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageIndicatorTooltipPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint TabPageIndicatorTooltipPropertyInfo = (~) T.Text
    type AttrTransferType TabPageIndicatorTooltipPropertyInfo = T.Text
    type AttrGetType TabPageIndicatorTooltipPropertyInfo = T.Text
    type AttrLabel TabPageIndicatorTooltipPropertyInfo = "indicator-tooltip"
    type AttrOrigin TabPageIndicatorTooltipPropertyInfo = TabPage
    attrGet = getTabPageIndicatorTooltip
    attrSet = setTabPageIndicatorTooltip
    attrTransfer _ v = do
        return v
    attrConstruct = constructTabPageIndicatorTooltip
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.indicatorTooltip"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:indicatorTooltip"
        })
#endif

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

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

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

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

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data TabPageLiveThumbnailPropertyInfo
instance AttrInfo TabPageLiveThumbnailPropertyInfo where
    type AttrAllowedOps TabPageLiveThumbnailPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TabPageLiveThumbnailPropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageLiveThumbnailPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TabPageLiveThumbnailPropertyInfo = (~) Bool
    type AttrTransferType TabPageLiveThumbnailPropertyInfo = Bool
    type AttrGetType TabPageLiveThumbnailPropertyInfo = Bool
    type AttrLabel TabPageLiveThumbnailPropertyInfo = "live-thumbnail"
    type AttrOrigin TabPageLiveThumbnailPropertyInfo = TabPage
    attrGet = getTabPageLiveThumbnail
    attrSet = setTabPageLiveThumbnail
    attrTransfer _ v = do
        return v
    attrConstruct = constructTabPageLiveThumbnail
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.liveThumbnail"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:liveThumbnail"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data TabPageLoadingPropertyInfo
instance AttrInfo TabPageLoadingPropertyInfo where
    type AttrAllowedOps TabPageLoadingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TabPageLoadingPropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageLoadingPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TabPageLoadingPropertyInfo = (~) Bool
    type AttrTransferType TabPageLoadingPropertyInfo = Bool
    type AttrGetType TabPageLoadingPropertyInfo = Bool
    type AttrLabel TabPageLoadingPropertyInfo = "loading"
    type AttrOrigin TabPageLoadingPropertyInfo = TabPage
    attrGet = getTabPageLoading
    attrSet = setTabPageLoading
    attrTransfer _ v = do
        return v
    attrConstruct = constructTabPageLoading
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.loading"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:loading"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data TabPageNeedsAttentionPropertyInfo
instance AttrInfo TabPageNeedsAttentionPropertyInfo where
    type AttrAllowedOps TabPageNeedsAttentionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TabPageNeedsAttentionPropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageNeedsAttentionPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TabPageNeedsAttentionPropertyInfo = (~) Bool
    type AttrTransferType TabPageNeedsAttentionPropertyInfo = Bool
    type AttrGetType TabPageNeedsAttentionPropertyInfo = Bool
    type AttrLabel TabPageNeedsAttentionPropertyInfo = "needs-attention"
    type AttrOrigin TabPageNeedsAttentionPropertyInfo = TabPage
    attrGet = getTabPageNeedsAttention
    attrSet = setTabPageNeedsAttention
    attrTransfer _ v = do
        return v
    attrConstruct = constructTabPageNeedsAttention
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.needsAttention"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:needsAttention"
        })
#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data TabPageParentPropertyInfo
instance AttrInfo TabPageParentPropertyInfo where
    type AttrAllowedOps TabPageParentPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TabPageParentPropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageParentPropertyInfo = IsTabPage
    type AttrTransferTypeConstraint TabPageParentPropertyInfo = IsTabPage
    type AttrTransferType TabPageParentPropertyInfo = TabPage
    type AttrGetType TabPageParentPropertyInfo = (Maybe TabPage)
    type AttrLabel TabPageParentPropertyInfo = "parent"
    type AttrOrigin TabPageParentPropertyInfo = TabPage
    attrGet = getTabPageParent
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo TabPage v
    attrConstruct = constructTabPageParent
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.parent"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:parent"
        })
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data TabPagePinnedPropertyInfo
instance AttrInfo TabPagePinnedPropertyInfo where
    type AttrAllowedOps TabPagePinnedPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint TabPagePinnedPropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPagePinnedPropertyInfo = (~) ()
    type AttrTransferTypeConstraint TabPagePinnedPropertyInfo = (~) ()
    type AttrTransferType TabPagePinnedPropertyInfo = ()
    type AttrGetType TabPagePinnedPropertyInfo = Bool
    type AttrLabel TabPagePinnedPropertyInfo = "pinned"
    type AttrOrigin TabPagePinnedPropertyInfo = TabPage
    attrGet = getTabPagePinned
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.pinned"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:pinned"
        })
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data TabPageSelectedPropertyInfo
instance AttrInfo TabPageSelectedPropertyInfo where
    type AttrAllowedOps TabPageSelectedPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint TabPageSelectedPropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageSelectedPropertyInfo = (~) ()
    type AttrTransferTypeConstraint TabPageSelectedPropertyInfo = (~) ()
    type AttrTransferType TabPageSelectedPropertyInfo = ()
    type AttrGetType TabPageSelectedPropertyInfo = Bool
    type AttrLabel TabPageSelectedPropertyInfo = "selected"
    type AttrOrigin TabPageSelectedPropertyInfo = TabPage
    attrGet = getTabPageSelected
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.selected"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:selected"
        })
#endif

-- VVV Prop "thumbnail-xalign"
   -- Type: TBasicType TFloat
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@thumbnail-xalign@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' tabPage [ #thumbnailXalign 'Data.GI.Base.Attributes.:=' value ]
-- @
setTabPageThumbnailXalign :: (MonadIO m, IsTabPage o) => o -> Float -> m ()
setTabPageThumbnailXalign :: forall (m :: * -> *) o.
(MonadIO m, IsTabPage o) =>
o -> Float -> m ()
setTabPageThumbnailXalign o
obj Float
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 -> Float -> IO ()
forall a. GObject a => a -> String -> Float -> IO ()
B.Properties.setObjectPropertyFloat o
obj String
"thumbnail-xalign" Float
val

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

#if defined(ENABLE_OVERLOADING)
data TabPageThumbnailXalignPropertyInfo
instance AttrInfo TabPageThumbnailXalignPropertyInfo where
    type AttrAllowedOps TabPageThumbnailXalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TabPageThumbnailXalignPropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageThumbnailXalignPropertyInfo = (~) Float
    type AttrTransferTypeConstraint TabPageThumbnailXalignPropertyInfo = (~) Float
    type AttrTransferType TabPageThumbnailXalignPropertyInfo = Float
    type AttrGetType TabPageThumbnailXalignPropertyInfo = Float
    type AttrLabel TabPageThumbnailXalignPropertyInfo = "thumbnail-xalign"
    type AttrOrigin TabPageThumbnailXalignPropertyInfo = TabPage
    attrGet = getTabPageThumbnailXalign
    attrSet = setTabPageThumbnailXalign
    attrTransfer _ v = do
        return v
    attrConstruct = constructTabPageThumbnailXalign
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.thumbnailXalign"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:thumbnailXalign"
        })
#endif

-- VVV Prop "thumbnail-yalign"
   -- Type: TBasicType TFloat
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@thumbnail-yalign@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' tabPage [ #thumbnailYalign 'Data.GI.Base.Attributes.:=' value ]
-- @
setTabPageThumbnailYalign :: (MonadIO m, IsTabPage o) => o -> Float -> m ()
setTabPageThumbnailYalign :: forall (m :: * -> *) o.
(MonadIO m, IsTabPage o) =>
o -> Float -> m ()
setTabPageThumbnailYalign o
obj Float
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 -> Float -> IO ()
forall a. GObject a => a -> String -> Float -> IO ()
B.Properties.setObjectPropertyFloat o
obj String
"thumbnail-yalign" Float
val

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

#if defined(ENABLE_OVERLOADING)
data TabPageThumbnailYalignPropertyInfo
instance AttrInfo TabPageThumbnailYalignPropertyInfo where
    type AttrAllowedOps TabPageThumbnailYalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TabPageThumbnailYalignPropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageThumbnailYalignPropertyInfo = (~) Float
    type AttrTransferTypeConstraint TabPageThumbnailYalignPropertyInfo = (~) Float
    type AttrTransferType TabPageThumbnailYalignPropertyInfo = Float
    type AttrGetType TabPageThumbnailYalignPropertyInfo = Float
    type AttrLabel TabPageThumbnailYalignPropertyInfo = "thumbnail-yalign"
    type AttrOrigin TabPageThumbnailYalignPropertyInfo = TabPage
    attrGet = getTabPageThumbnailYalign
    attrSet = setTabPageThumbnailYalign
    attrTransfer _ v = do
        return v
    attrConstruct = constructTabPageThumbnailYalign
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.thumbnailYalign"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:thumbnailYalign"
        })
#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' tabPage #title
-- @
getTabPageTitle :: (MonadIO m, IsTabPage o) => o -> m T.Text
getTabPageTitle :: forall (m :: * -> *) o. (MonadIO m, IsTabPage o) => o -> m Text
getTabPageTitle 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
"getTabPageTitle" (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' tabPage [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setTabPageTitle :: (MonadIO m, IsTabPage o) => o -> T.Text -> m ()
setTabPageTitle :: forall (m :: * -> *) o.
(MonadIO m, IsTabPage o) =>
o -> Text -> m ()
setTabPageTitle 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`.
constructTabPageTitle :: (IsTabPage o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructTabPageTitle :: forall o (m :: * -> *).
(IsTabPage o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructTabPageTitle 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 TabPageTitlePropertyInfo
instance AttrInfo TabPageTitlePropertyInfo where
    type AttrAllowedOps TabPageTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TabPageTitlePropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint TabPageTitlePropertyInfo = (~) T.Text
    type AttrTransferType TabPageTitlePropertyInfo = T.Text
    type AttrGetType TabPageTitlePropertyInfo = T.Text
    type AttrLabel TabPageTitlePropertyInfo = "title"
    type AttrOrigin TabPageTitlePropertyInfo = TabPage
    attrGet = getTabPageTitle
    attrSet = setTabPageTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructTabPageTitle
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TabPage.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TabPage.html#g:attr:title"
        })
#endif

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TabPage
type instance O.AttributeList TabPage = TabPageAttributeList
type TabPageAttributeList = ('[ '("accessibleRole", Gtk.Accessible.AccessibleAccessibleRolePropertyInfo), '("child", TabPageChildPropertyInfo), '("icon", TabPageIconPropertyInfo), '("indicatorActivatable", TabPageIndicatorActivatablePropertyInfo), '("indicatorIcon", TabPageIndicatorIconPropertyInfo), '("indicatorTooltip", TabPageIndicatorTooltipPropertyInfo), '("keyword", TabPageKeywordPropertyInfo), '("liveThumbnail", TabPageLiveThumbnailPropertyInfo), '("loading", TabPageLoadingPropertyInfo), '("needsAttention", TabPageNeedsAttentionPropertyInfo), '("parent", TabPageParentPropertyInfo), '("pinned", TabPagePinnedPropertyInfo), '("selected", TabPageSelectedPropertyInfo), '("thumbnailXalign", TabPageThumbnailXalignPropertyInfo), '("thumbnailYalign", TabPageThumbnailYalignPropertyInfo), '("title", TabPageTitlePropertyInfo), '("tooltip", TabPageTooltipPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
tabPageChild :: AttrLabelProxy "child"
tabPageChild = AttrLabelProxy

tabPageIcon :: AttrLabelProxy "icon"
tabPageIcon = AttrLabelProxy

tabPageIndicatorActivatable :: AttrLabelProxy "indicatorActivatable"
tabPageIndicatorActivatable = AttrLabelProxy

tabPageIndicatorIcon :: AttrLabelProxy "indicatorIcon"
tabPageIndicatorIcon = AttrLabelProxy

tabPageIndicatorTooltip :: AttrLabelProxy "indicatorTooltip"
tabPageIndicatorTooltip = AttrLabelProxy

tabPageKeyword :: AttrLabelProxy "keyword"
tabPageKeyword = AttrLabelProxy

tabPageLiveThumbnail :: AttrLabelProxy "liveThumbnail"
tabPageLiveThumbnail = AttrLabelProxy

tabPageLoading :: AttrLabelProxy "loading"
tabPageLoading = AttrLabelProxy

tabPageNeedsAttention :: AttrLabelProxy "needsAttention"
tabPageNeedsAttention = AttrLabelProxy

tabPageParent :: AttrLabelProxy "parent"
tabPageParent = AttrLabelProxy

tabPagePinned :: AttrLabelProxy "pinned"
tabPagePinned = AttrLabelProxy

tabPageSelected :: AttrLabelProxy "selected"
tabPageSelected = AttrLabelProxy

tabPageThumbnailXalign :: AttrLabelProxy "thumbnailXalign"
tabPageThumbnailXalign = AttrLabelProxy

tabPageThumbnailYalign :: AttrLabelProxy "thumbnailYalign"
tabPageThumbnailYalign = AttrLabelProxy

tabPageTitle :: AttrLabelProxy "title"
tabPageTitle = AttrLabelProxy

tabPageTooltip :: AttrLabelProxy "tooltip"
tabPageTooltip = AttrLabelProxy

#endif

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

#endif

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

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

-- | Gets the child of /@self@/.
tabPageGetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m Gtk.Widget.Widget
    -- ^ __Returns:__ the child of /@self@/
tabPageGetChild :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m Widget
tabPageGetChild a
self = IO Widget -> m Widget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
    Ptr TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr TabPage -> IO (Ptr Widget)
adw_tab_page_get_child Ptr TabPage
self'
    Text -> Ptr Widget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tabPageGetChild" Ptr Widget
result
    Widget
result' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result'

#if defined(ENABLE_OVERLOADING)
data TabPageGetChildMethodInfo
instance (signature ~ (m Gtk.Widget.Widget), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetChildMethodInfo a signature where
    overloadedMethod = tabPageGetChild

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


#endif

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

foreign import ccall "adw_tab_page_get_icon" adw_tab_page_get_icon :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Adw", name = "TabPage"})
    IO (Ptr Gio.Icon.Icon)

-- | Gets the icon of /@self@/.
tabPageGetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m (Maybe Gio.Icon.Icon)
    -- ^ __Returns:__ the icon of /@self@/
tabPageGetIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m (Maybe Icon)
tabPageGetIcon a
self = IO (Maybe Icon) -> m (Maybe Icon)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Icon) -> m (Maybe Icon))
-> IO (Maybe Icon) -> m (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Icon
result <- Ptr TabPage -> IO (Ptr Icon)
adw_tab_page_get_icon Ptr TabPage
self'
    Maybe Icon
maybeResult <- Ptr Icon -> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Icon
result ((Ptr Icon -> IO Icon) -> IO (Maybe Icon))
-> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ \Ptr Icon
result' -> do
        Icon
result'' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result'
        Icon -> IO Icon
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Icon -> IO (Maybe Icon)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Icon
maybeResult

#if defined(ENABLE_OVERLOADING)
data TabPageGetIconMethodInfo
instance (signature ~ (m (Maybe Gio.Icon.Icon)), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetIconMethodInfo a signature where
    overloadedMethod = tabPageGetIcon

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


#endif

-- method TabPage::get_indicator_activatable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tab 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_tab_page_get_indicator_activatable" adw_tab_page_get_indicator_activatable :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Adw", name = "TabPage"})
    IO CInt

-- | Gets whether the indicator of /@self@/ is activatable.
tabPageGetIndicatorActivatable ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m Bool
    -- ^ __Returns:__ whether the indicator is activatable
tabPageGetIndicatorActivatable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m Bool
tabPageGetIndicatorActivatable 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr TabPage -> IO CInt
adw_tab_page_get_indicator_activatable Ptr TabPage
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 TabPageGetIndicatorActivatableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetIndicatorActivatableMethodInfo a signature where
    overloadedMethod = tabPageGetIndicatorActivatable

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


#endif

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

foreign import ccall "adw_tab_page_get_indicator_icon" adw_tab_page_get_indicator_icon :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Adw", name = "TabPage"})
    IO (Ptr Gio.Icon.Icon)

-- | Gets the indicator icon of /@self@/.
tabPageGetIndicatorIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m (Maybe Gio.Icon.Icon)
    -- ^ __Returns:__ the indicator icon of /@self@/
tabPageGetIndicatorIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m (Maybe Icon)
tabPageGetIndicatorIcon a
self = IO (Maybe Icon) -> m (Maybe Icon)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Icon) -> m (Maybe Icon))
-> IO (Maybe Icon) -> m (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Icon
result <- Ptr TabPage -> IO (Ptr Icon)
adw_tab_page_get_indicator_icon Ptr TabPage
self'
    Maybe Icon
maybeResult <- Ptr Icon -> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Icon
result ((Ptr Icon -> IO Icon) -> IO (Maybe Icon))
-> (Ptr Icon -> IO Icon) -> IO (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ \Ptr Icon
result' -> do
        Icon
result'' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result'
        Icon -> IO Icon
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Icon -> IO (Maybe Icon)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Icon
maybeResult

#if defined(ENABLE_OVERLOADING)
data TabPageGetIndicatorIconMethodInfo
instance (signature ~ (m (Maybe Gio.Icon.Icon)), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetIndicatorIconMethodInfo a signature where
    overloadedMethod = tabPageGetIndicatorIcon

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


#endif

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

-- | Gets the tooltip of the indicator icon of /@self@/.
-- 
-- /Since: 1.2/
tabPageGetIndicatorTooltip ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m T.Text
    -- ^ __Returns:__ the indicator tooltip of /@self@/
tabPageGetIndicatorTooltip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m Text
tabPageGetIndicatorTooltip 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr TabPage -> IO CString
adw_tab_page_get_indicator_tooltip Ptr TabPage
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tabPageGetIndicatorTooltip" 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 TabPageGetIndicatorTooltipMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetIndicatorTooltipMethodInfo a signature where
    overloadedMethod = tabPageGetIndicatorTooltip

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


#endif

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

-- | Gets the search keyword of /@self@/.
-- 
-- /Since: 1.3/
tabPageGetKeyword ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the search keyword of /@self@/
tabPageGetKeyword :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m (Maybe Text)
tabPageGetKeyword 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr TabPage -> IO CString
adw_tab_page_get_keyword Ptr TabPage
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 TabPageGetKeywordMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetKeywordMethodInfo a signature where
    overloadedMethod = tabPageGetKeyword

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


#endif

-- method TabPage::get_live_thumbnail
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tab overview" , 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_tab_page_get_live_thumbnail" adw_tab_page_get_live_thumbnail :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Adw", name = "TabPage"})
    IO CInt

-- | Gets whether to live thumbnail is enabled /@self@/.
-- 
-- /Since: 1.3/
tabPageGetLiveThumbnail ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab overview
    -> m Bool
    -- ^ __Returns:__ whether live thumbnail is enabled
tabPageGetLiveThumbnail :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m Bool
tabPageGetLiveThumbnail 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr TabPage -> IO CInt
adw_tab_page_get_live_thumbnail Ptr TabPage
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 TabPageGetLiveThumbnailMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetLiveThumbnailMethodInfo a signature where
    overloadedMethod = tabPageGetLiveThumbnail

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


#endif

-- method TabPage::get_loading
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tab 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_tab_page_get_loading" adw_tab_page_get_loading :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Adw", name = "TabPage"})
    IO CInt

-- | Gets whether /@self@/ is loading.
tabPageGetLoading ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m Bool
    -- ^ __Returns:__ whether /@self@/ is loading
tabPageGetLoading :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m Bool
tabPageGetLoading 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr TabPage -> IO CInt
adw_tab_page_get_loading Ptr TabPage
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 TabPageGetLoadingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetLoadingMethodInfo a signature where
    overloadedMethod = tabPageGetLoading

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


#endif

-- method TabPage::get_needs_attention
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tab 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_tab_page_get_needs_attention" adw_tab_page_get_needs_attention :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Adw", name = "TabPage"})
    IO CInt

-- | Gets whether /@self@/ needs attention.
tabPageGetNeedsAttention ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m Bool
    -- ^ __Returns:__ whether /@self@/ needs attention
tabPageGetNeedsAttention :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m Bool
tabPageGetNeedsAttention 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr TabPage -> IO CInt
adw_tab_page_get_needs_attention Ptr TabPage
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 TabPageGetNeedsAttentionMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetNeedsAttentionMethodInfo a signature where
    overloadedMethod = tabPageGetNeedsAttention

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


#endif

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

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

-- | Gets the parent page of /@self@/.
-- 
-- See [method/@tabView@/.add_page] and [method/@tabView@/.close_page].
tabPageGetParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m (Maybe TabPage)
    -- ^ __Returns:__ the parent page
tabPageGetParent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m (Maybe TabPage)
tabPageGetParent a
self = IO (Maybe TabPage) -> m (Maybe TabPage)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe TabPage) -> m (Maybe TabPage))
-> IO (Maybe TabPage) -> m (Maybe TabPage)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TabPage
result <- Ptr TabPage -> IO (Ptr TabPage)
adw_tab_page_get_parent Ptr TabPage
self'
    Maybe TabPage
maybeResult <- Ptr TabPage -> (Ptr TabPage -> IO TabPage) -> IO (Maybe TabPage)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr TabPage
result ((Ptr TabPage -> IO TabPage) -> IO (Maybe TabPage))
-> (Ptr TabPage -> IO TabPage) -> IO (Maybe TabPage)
forall a b. (a -> b) -> a -> b
$ \Ptr TabPage
result' -> do
        TabPage
result'' <- ((ManagedPtr TabPage -> TabPage) -> Ptr TabPage -> IO TabPage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TabPage -> TabPage
TabPage) Ptr TabPage
result'
        TabPage -> IO TabPage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TabPage
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe TabPage -> IO (Maybe TabPage)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TabPage
maybeResult

#if defined(ENABLE_OVERLOADING)
data TabPageGetParentMethodInfo
instance (signature ~ (m (Maybe TabPage)), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetParentMethodInfo a signature where
    overloadedMethod = tabPageGetParent

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


#endif

-- method TabPage::get_pinned
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tab 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_tab_page_get_pinned" adw_tab_page_get_pinned :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Adw", name = "TabPage"})
    IO CInt

-- | Gets whether /@self@/ is pinned.
-- 
-- See [method/@tabView@/.set_page_pinned].
tabPageGetPinned ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m Bool
    -- ^ __Returns:__ whether /@self@/ is pinned
tabPageGetPinned :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m Bool
tabPageGetPinned 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr TabPage -> IO CInt
adw_tab_page_get_pinned Ptr TabPage
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 TabPageGetPinnedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetPinnedMethodInfo a signature where
    overloadedMethod = tabPageGetPinned

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


#endif

-- method TabPage::get_selected
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tab 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_tab_page_get_selected" adw_tab_page_get_selected :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Adw", name = "TabPage"})
    IO CInt

-- | Gets whether /@self@/ is selected.
tabPageGetSelected ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m Bool
    -- ^ __Returns:__ whether /@self@/ is selected
tabPageGetSelected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m Bool
tabPageGetSelected 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr TabPage -> IO CInt
adw_tab_page_get_selected Ptr TabPage
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 TabPageGetSelectedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetSelectedMethodInfo a signature where
    overloadedMethod = tabPageGetSelected

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


#endif

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

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

-- | Gets the horizontal alignment of the thumbnail for /@self@/.
-- 
-- /Since: 1.3/
tabPageGetThumbnailXalign ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m Float
    -- ^ __Returns:__ the horizontal alignment
tabPageGetThumbnailXalign :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m Float
tabPageGetThumbnailXalign a
self = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CFloat
result <- Ptr TabPage -> IO CFloat
adw_tab_page_get_thumbnail_xalign Ptr TabPage
self'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data TabPageGetThumbnailXalignMethodInfo
instance (signature ~ (m Float), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetThumbnailXalignMethodInfo a signature where
    overloadedMethod = tabPageGetThumbnailXalign

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


#endif

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

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

-- | Gets the vertical alignment of the thumbnail for /@self@/.
-- 
-- /Since: 1.3/
tabPageGetThumbnailYalign ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab overview
    -> m Float
    -- ^ __Returns:__ the vertical alignment
tabPageGetThumbnailYalign :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m Float
tabPageGetThumbnailYalign a
self = IO Float -> m Float
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CFloat
result <- Ptr TabPage -> IO CFloat
adw_tab_page_get_thumbnail_yalign Ptr TabPage
self'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Float -> IO Float
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data TabPageGetThumbnailYalignMethodInfo
instance (signature ~ (m Float), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetThumbnailYalignMethodInfo a signature where
    overloadedMethod = tabPageGetThumbnailYalign

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


#endif

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

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

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


#endif

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

-- | Gets the tooltip of /@self@/.
tabPageGetTooltip ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the tooltip of /@self@/
tabPageGetTooltip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m (Maybe Text)
tabPageGetTooltip 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr TabPage -> IO CString
adw_tab_page_get_tooltip Ptr TabPage
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 TabPageGetTooltipMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageGetTooltipMethodInfo a signature where
    overloadedMethod = tabPageGetTooltip

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


#endif

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

-- | Invalidates thumbnail for /@self@/.
-- 
-- If an [class/@tabOverview@/] is open, the thumbnail representing /@self@/ will be
-- immediately updated. Otherwise it will be update when opening the overview.
-- 
-- Does nothing if [property/@tabPage@/:live-thumbnail] is set to @TRUE@.
-- 
-- See also [method/@tabView@/.invalidate_thumbnails].
-- 
-- /Since: 1.3/
tabPageInvalidateThumbnail ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> m ()
tabPageInvalidateThumbnail :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m ()
tabPageInvalidateThumbnail 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TabPage -> IO ()
adw_tab_page_invalidate_thumbnail Ptr TabPage
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 TabPageInvalidateThumbnailMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageInvalidateThumbnailMethodInfo a signature where
    overloadedMethod = tabPageInvalidateThumbnail

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


#endif

-- method TabPage::set_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tab page" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon"
--           , argType = TInterface Name { namespace = "Gio" , name = "Icon" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the icon of @self" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_tab_page_set_icon" adw_tab_page_set_icon :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Adw", name = "TabPage"})
    Ptr Gio.Icon.Icon ->                    -- icon : TInterface (Name {namespace = "Gio", name = "Icon"})
    IO ()

-- | Sets the icon of /@self@/.
-- 
-- [class/@tabBar@/] and [class/@tabOverview@/] display the icon next to the title,
-- unless [property/@tabPage@/:loading] is set to @TRUE@.
-- 
-- @AdwTabBar@ also won\'t show the icon if the page is pinned and
-- [propertyTabPage:indicator-icon] is set.
tabPageSetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a, Gio.Icon.IsIcon b) =>
    a
    -- ^ /@self@/: a tab page
    -> Maybe (b)
    -- ^ /@icon@/: the icon of /@self@/
    -> m ()
tabPageSetIcon :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTabPage a, IsIcon b) =>
a -> Maybe b -> m ()
tabPageSetIcon a
self Maybe b
icon = 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Icon
maybeIcon <- case Maybe b
icon of
        Maybe b
Nothing -> Ptr Icon -> IO (Ptr Icon)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Icon
forall a. Ptr a
nullPtr
        Just b
jIcon -> do
            Ptr Icon
jIcon' <- b -> IO (Ptr Icon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jIcon
            Ptr Icon -> IO (Ptr Icon)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Icon
jIcon'
    Ptr TabPage -> Ptr Icon -> IO ()
adw_tab_page_set_icon Ptr TabPage
self' Ptr Icon
maybeIcon
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
icon b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TabPageSetIconMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsTabPage a, Gio.Icon.IsIcon b) => O.OverloadedMethod TabPageSetIconMethodInfo a signature where
    overloadedMethod = tabPageSetIcon

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


#endif

-- method TabPage::set_indicator_activatable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tab page" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "activatable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether the indicator is activatable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether the indicator of /@self@/ is activatable.
-- 
-- If set to @TRUE@, [signal/@tabView@/[indicatorActivated](#g:signal:indicatorActivated)] will be emitted
-- when the indicator icon is clicked.
-- 
-- If [property/@tabPage@/:indicator-icon] is not set, does nothing.
tabPageSetIndicatorActivatable ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> Bool
    -- ^ /@activatable@/: whether the indicator is activatable
    -> m ()
tabPageSetIndicatorActivatable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> Bool -> m ()
tabPageSetIndicatorActivatable a
self Bool
activatable = 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let activatable' :: CInt
activatable' = (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
activatable
    Ptr TabPage -> CInt -> IO ()
adw_tab_page_set_indicator_activatable Ptr TabPage
self' CInt
activatable'
    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 TabPageSetIndicatorActivatableMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageSetIndicatorActivatableMethodInfo a signature where
    overloadedMethod = tabPageSetIndicatorActivatable

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


#endif

-- method TabPage::set_indicator_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tab page" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "indicator_icon"
--           , argType = TInterface Name { namespace = "Gio" , name = "Icon" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the indicator icon of @self"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_tab_page_set_indicator_icon" adw_tab_page_set_indicator_icon :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Adw", name = "TabPage"})
    Ptr Gio.Icon.Icon ->                    -- indicator_icon : TInterface (Name {namespace = "Gio", name = "Icon"})
    IO ()

-- | Sets the indicator icon of /@self@/.
-- 
-- A common use case is an audio or camera indicator in a web browser.
-- 
-- [class/@tabBar@/] will show it at the beginning of the tab, alongside icon
-- representing [property/@tabPage@/:icon] or loading spinner.
-- 
-- If the page is pinned, the indicator will be shown instead of icon or
-- spinner.
-- 
-- [class/@tabOverview@/] will show it at the at the top part of the thumbnail.
-- 
-- [property/@tabPage@/:indicator-tooltip] can be used to set the tooltip on the
-- indicator icon.
-- 
-- If [property/@tabPage@/:indicator-activatable] is set to @TRUE@, the
-- indicator icon can act as a button.
tabPageSetIndicatorIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a, Gio.Icon.IsIcon b) =>
    a
    -- ^ /@self@/: a tab page
    -> Maybe (b)
    -- ^ /@indicatorIcon@/: the indicator icon of /@self@/
    -> m ()
tabPageSetIndicatorIcon :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTabPage a, IsIcon b) =>
a -> Maybe b -> m ()
tabPageSetIndicatorIcon a
self Maybe b
indicatorIcon = 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Icon
maybeIndicatorIcon <- case Maybe b
indicatorIcon of
        Maybe b
Nothing -> Ptr Icon -> IO (Ptr Icon)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Icon
forall a. Ptr a
nullPtr
        Just b
jIndicatorIcon -> do
            Ptr Icon
jIndicatorIcon' <- b -> IO (Ptr Icon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jIndicatorIcon
            Ptr Icon -> IO (Ptr Icon)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Icon
jIndicatorIcon'
    Ptr TabPage -> Ptr Icon -> IO ()
adw_tab_page_set_indicator_icon Ptr TabPage
self' Ptr Icon
maybeIndicatorIcon
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
indicatorIcon b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TabPageSetIndicatorIconMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsTabPage a, Gio.Icon.IsIcon b) => O.OverloadedMethod TabPageSetIndicatorIconMethodInfo a signature where
    overloadedMethod = tabPageSetIndicatorIcon

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


#endif

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

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

-- | Sets the tooltip of the indicator icon of /@self@/.
-- 
-- The tooltip can be marked up with the Pango text markup language.
-- 
-- See [property/@tabPage@/:indicator-icon].
-- 
-- /Since: 1.2/
tabPageSetIndicatorTooltip ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> T.Text
    -- ^ /@tooltip@/: the indicator tooltip of /@self@/
    -> m ()
tabPageSetIndicatorTooltip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> Text -> m ()
tabPageSetIndicatorTooltip a
self Text
tooltip = 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
tooltip' <- Text -> IO CString
textToCString Text
tooltip
    Ptr TabPage -> CString -> IO ()
adw_tab_page_set_indicator_tooltip Ptr TabPage
self' CString
tooltip'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tooltip'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

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

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

-- | Sets the search keyword for /@self@/.
-- 
-- [class/@tabOverview@/] can search pages by their keywords in addition to their
-- titles and tooltips.
-- 
-- Keywords allow to include e.g. page URLs into tab search in a web browser.
-- 
-- /Since: 1.3/
tabPageSetKeyword ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> T.Text
    -- ^ /@keyword@/: the search keyword
    -> m ()
tabPageSetKeyword :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> Text -> m ()
tabPageSetKeyword a
self Text
keyword = 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
keyword' <- Text -> IO CString
textToCString Text
keyword
    Ptr TabPage -> CString -> IO ()
adw_tab_page_set_keyword Ptr TabPage
self' CString
keyword'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
keyword'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method TabPage::set_live_thumbnail
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tab page" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "live_thumbnail"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to enable live thumbnail"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether to enable live thumbnail for /@self@/.
-- 
-- When set to @TRUE@, /@self@/\'s thumbnail in [class/@tabOverview@/] will update
-- immediately when /@self@/ is redrawn or resized.
-- 
-- If it\'s set to @FALSE@, the thumbnail will only be live when the /@self@/ is
-- selected, and otherwise it will be static and will only update when
-- [method/@tabPage@/.invalidate_thumbnail] or
-- [method/@tabView@/.invalidate_thumbnails] is called.
-- 
-- /Since: 1.3/
tabPageSetLiveThumbnail ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> Bool
    -- ^ /@liveThumbnail@/: whether to enable live thumbnail
    -> m ()
tabPageSetLiveThumbnail :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> Bool -> m ()
tabPageSetLiveThumbnail a
self Bool
liveThumbnail = 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let liveThumbnail' :: CInt
liveThumbnail' = (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
liveThumbnail
    Ptr TabPage -> CInt -> IO ()
adw_tab_page_set_live_thumbnail Ptr TabPage
self' CInt
liveThumbnail'
    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 TabPageSetLiveThumbnailMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageSetLiveThumbnailMethodInfo a signature where
    overloadedMethod = tabPageSetLiveThumbnail

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


#endif

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

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

-- | Sets whether /@self@/ is loading.
-- 
-- If set to @TRUE@, [class/@tabBar@/] and [class/@tabOverview@/] will display a
-- spinner in place of icon.
-- 
-- If the page is pinned and [property/@tabPage@/:indicator-icon] is set, loading
-- status will not be visible with @AdwTabBar@.
tabPageSetLoading ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> Bool
    -- ^ /@loading@/: whether /@self@/ is loading
    -> m ()
tabPageSetLoading :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> Bool -> m ()
tabPageSetLoading a
self Bool
loading = 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let loading' :: CInt
loading' = (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
loading
    Ptr TabPage -> CInt -> IO ()
adw_tab_page_set_loading Ptr TabPage
self' CInt
loading'
    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 TabPageSetLoadingMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageSetLoadingMethodInfo a signature where
    overloadedMethod = tabPageSetLoading

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


#endif

-- method TabPage::set_needs_attention
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a tab page" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "needs_attention"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether @self needs attention"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether /@self@/ needs attention.
-- 
-- [class/@tabBar@/] will display a line under the tab representing the page if
-- set to @TRUE@. If the tab is not visible, the corresponding edge of the tab
-- bar will be highlighted.
-- 
-- [class/@tabOverview@/] will display a dot in the corner of the thumbnail if set
-- to @TRUE@.
-- 
-- [class/@tabButton@/] will display a dot if any of the pages that aren\'t
-- selected have [property/@tabPage@/:needs-attention] set to @TRUE@.
tabPageSetNeedsAttention ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> Bool
    -- ^ /@needsAttention@/: whether /@self@/ needs attention
    -> m ()
tabPageSetNeedsAttention :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> Bool -> m ()
tabPageSetNeedsAttention a
self Bool
needsAttention = 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let needsAttention' :: CInt
needsAttention' = (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
needsAttention
    Ptr TabPage -> CInt -> IO ()
adw_tab_page_set_needs_attention Ptr TabPage
self' CInt
needsAttention'
    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 TabPageSetNeedsAttentionMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageSetNeedsAttentionMethodInfo a signature where
    overloadedMethod = tabPageSetNeedsAttention

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


#endif

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

foreign import ccall "adw_tab_page_set_thumbnail_xalign" adw_tab_page_set_thumbnail_xalign :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Adw", name = "TabPage"})
    CFloat ->                               -- xalign : TBasicType TFloat
    IO ()

-- | Sets the horizontal alignment of the thumbnail for /@self@/.
-- 
-- If the page is so wide that [class/@tabOverview@/] can\'t display it completely
-- and has to crop it, horizontal alignment will determine which part of the
-- page will be visible.
-- 
-- For example, 0.5 means the center of the page will be visible, 0 means the
-- start edge will be visible and 1 means the end edge will be visible.
-- 
-- The default horizontal alignment is 0.
-- 
-- /Since: 1.3/
tabPageSetThumbnailXalign ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> Float
    -- ^ /@xalign@/: the new value
    -> m ()
tabPageSetThumbnailXalign :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> Float -> m ()
tabPageSetThumbnailXalign a
self Float
xalign = 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let xalign' :: CFloat
xalign' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
xalign
    Ptr TabPage -> CFloat -> IO ()
adw_tab_page_set_thumbnail_xalign Ptr TabPage
self' CFloat
xalign'
    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 TabPageSetThumbnailXalignMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageSetThumbnailXalignMethodInfo a signature where
    overloadedMethod = tabPageSetThumbnailXalign

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


#endif

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

foreign import ccall "adw_tab_page_set_thumbnail_yalign" adw_tab_page_set_thumbnail_yalign :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Adw", name = "TabPage"})
    CFloat ->                               -- yalign : TBasicType TFloat
    IO ()

-- | Sets the vertical alignment of the thumbnail for /@self@/.
-- 
-- If the page is so tall that [class/@tabOverview@/] can\'t display it completely
-- and has to crop it, vertical alignment will determine which part of the page
-- will be visible.
-- 
-- For example, 0.5 means the center of the page will be visible, 0 means the
-- top edge will be visible and 1 means the bottom edge will be visible.
-- 
-- The default vertical alignment is 0.
-- 
-- /Since: 1.3/
tabPageSetThumbnailYalign ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> Float
    -- ^ /@yalign@/: the new value
    -> m ()
tabPageSetThumbnailYalign :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> Float -> m ()
tabPageSetThumbnailYalign a
self Float
yalign = 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let yalign' :: CFloat
yalign' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
yalign
    Ptr TabPage -> CFloat -> IO ()
adw_tab_page_set_thumbnail_yalign Ptr TabPage
self' CFloat
yalign'
    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 TabPageSetThumbnailYalignMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageSetThumbnailYalignMethodInfo a signature where
    overloadedMethod = tabPageSetThumbnailYalign

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


#endif

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

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

-- | [class/@tabBar@/] will display it in the center of the tab unless it\'s pinned,
-- and will use it as a tooltip unless [property/@tabPage@/:tooltip] is set.
-- 
-- [class/@tabOverview@/] will display it below the thumbnail unless it\'s pinned,
-- or inside the card otherwise, and will use it as a tooltip unless
-- [property/@tabPage@/:tooltip] is set.
-- 
-- Sets the title of /@self@/.
tabPageSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> T.Text
    -- ^ /@title@/: the title of /@self@/
    -> m ()
tabPageSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> Text -> m ()
tabPageSetTitle 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr TabPage -> CString -> IO ()
adw_tab_page_set_title Ptr TabPage
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 TabPageSetTitleMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsTabPage a) => O.OverloadedMethod TabPageSetTitleMethodInfo a signature where
    overloadedMethod = tabPageSetTitle

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


#endif

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

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

-- | Sets the tooltip of /@self@/.
-- 
-- The tooltip can be marked up with the Pango text markup language.
-- 
-- If not set, [class/@tabBar@/] and [class/@tabOverview@/] will use
-- [property/@tabPage@/:title] as a tooltip instead.
tabPageSetTooltip ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a tab page
    -> T.Text
    -- ^ /@tooltip@/: the tooltip of /@self@/
    -> m ()
tabPageSetTooltip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> Text -> m ()
tabPageSetTooltip a
self Text
tooltip = 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 TabPage
self' <- a -> IO (Ptr TabPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
tooltip' <- Text -> IO CString
textToCString Text
tooltip
    Ptr TabPage -> CString -> IO ()
adw_tab_page_set_tooltip Ptr TabPage
self' CString
tooltip'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tooltip'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif