{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Handy.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"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getChild]("GI.Handy.Objects.TabPage#g:method:getChild"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getIcon]("GI.Handy.Objects.TabPage#g:method:getIcon"), [getIndicatorActivatable]("GI.Handy.Objects.TabPage#g:method:getIndicatorActivatable"), [getIndicatorIcon]("GI.Handy.Objects.TabPage#g:method:getIndicatorIcon"), [getLoading]("GI.Handy.Objects.TabPage#g:method:getLoading"), [getNeedsAttention]("GI.Handy.Objects.TabPage#g:method:getNeedsAttention"), [getParent]("GI.Handy.Objects.TabPage#g:method:getParent"), [getPinned]("GI.Handy.Objects.TabPage#g:method:getPinned"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSelected]("GI.Handy.Objects.TabPage#g:method:getSelected"), [getTitle]("GI.Handy.Objects.TabPage#g:method:getTitle"), [getTooltip]("GI.Handy.Objects.TabPage#g:method:getTooltip").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setIcon]("GI.Handy.Objects.TabPage#g:method:setIcon"), [setIndicatorActivatable]("GI.Handy.Objects.TabPage#g:method:setIndicatorActivatable"), [setIndicatorIcon]("GI.Handy.Objects.TabPage#g:method:setIndicatorIcon"), [setLoading]("GI.Handy.Objects.TabPage#g:method:setLoading"), [setNeedsAttention]("GI.Handy.Objects.TabPage#g:method:setNeedsAttention"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTitle]("GI.Handy.Objects.TabPage#g:method:setTitle"), [setTooltip]("GI.Handy.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                 ,


-- ** 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                      ,


-- ** getTitle #method:getTitle#

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


-- ** getTooltip #method:getTooltip#

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


-- ** 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                 ,


-- ** setLoading #method:setLoading#

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


-- ** setNeedsAttention #method:setNeedsAttention#

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


-- ** 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.
-- 
-- /Since: 1.2/

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


-- ** icon #attr:icon#
-- | The icon of the page, displayed next to the title.
-- 
-- t'GI.Handy.Objects.TabBar.TabBar' will not show the icon if t'GI.Handy.Objects.TabPage.TabPage':@/loading/@ is set to 'P.True',
-- or if the page is pinned and t'GI.Handy.Objects.TabPage.TabPage':@/indicator-icon/@ is set.
-- 
-- /Since: 1.2/

#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 'P.True', [indicatorActivated]("GI.Handy.Objects.TabView#g:signal:indicatorActivated") will be emitted when
-- the indicator icon is clicked.
-- 
-- If t'GI.Handy.Objects.TabPage.TabPage':@/indicator-icon/@ is not set, does nothing.
-- 
-- /Since: 1.2/

#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.
-- 
-- t'GI.Handy.Objects.TabPage.TabPage' will show it at the beginning of the tab, alongside icon
-- representing t'GI.Handy.Objects.TabPage.TabPage':@/icon/@ or loading spinner.
-- 
-- If the page is pinned, the indicator will be shown instead of icon or
-- spinner.
-- 
-- If t'GI.Handy.Objects.TabPage.TabPage':@/indicator-activatable/@ is set to 'P.True', the indicator icon
-- can act as a button.
-- 
-- /Since: 1.2/

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


-- ** loading #attr:loading#
-- | Whether the page is loading.
-- 
-- If set to 'P.True', t'GI.Handy.Objects.TabBar.TabBar' will display a spinner in place of icon.
-- 
-- If the page is pinned and t'GI.Handy.Objects.TabPage.TabPage':@/indicator-icon/@ is set, the loading
-- status will not be visible.
-- 
-- /Since: 1.2/

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


-- ** needsAttention #attr:needsAttention#
-- | Whether the page needs attention.
-- 
-- t'GI.Handy.Objects.TabBar.TabBar' will display a glow under the tab representing the page if set
-- to 'P.True'. If the tab is not visible, the corresponding edge of the tab bar
-- will be highlighted.
-- 
-- /Since: 1.2/

#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 'GI.Handy.Objects.TabView.tabViewAddPage' and 'GI.Handy.Objects.TabView.tabViewClosePage'.
-- 
-- /Since: 1.2/

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


-- ** pinned #attr:pinned#
-- | Whether the page is pinned. See 'GI.Handy.Objects.TabView.tabViewSetPagePinned'.
-- 
-- /Since: 1.2/

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


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

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


-- ** title #attr:title#
-- | The title of the page.
-- 
-- t'GI.Handy.Objects.TabBar.TabBar' will display it in the center of the tab unless it\'s pinned,
-- and will use it as a tooltip unless t'GI.Handy.Objects.TabPage.TabPage':@/tooltip/@ is set.
-- 
-- /Since: 1.2/

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


-- ** tooltip #attr:tooltip#
-- | The tooltip of the page, marked up with the Pango text markup language.
-- 
-- If not set, t'GI.Handy.Objects.TabBar.TabBar' will use t'GI.Handy.Objects.TabPage.TabPage':@/title/@ as a tooltip instead.
-- 
-- /Since: 1.2/

#if defined(ENABLE_OVERLOADING)
    TabPageTooltipPropertyInfo              ,
#endif
    clearTabPageTooltip                     ,
    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.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.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.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
/= :: TabPage -> TabPage -> Bool
$c/= :: TabPage -> TabPage -> Bool
== :: TabPage -> TabPage -> Bool
$c== :: TabPage -> TabPage -> Bool
Eq)

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

foreign import ccall "hdy_tab_page_get_type"
    c_hdy_tab_page_get_type :: IO B.Types.GType

instance B.Types.TypedObject TabPage where
    glibType :: IO GType
glibType = IO GType
c_hdy_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]

-- | 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 (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_hdy_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 (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 :: *) :: * 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 "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 "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 "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTabPageMethod "getChild" o = TabPageGetChildMethodInfo
    ResolveTabPageMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTabPageMethod "getIcon" o = TabPageGetIconMethodInfo
    ResolveTabPageMethod "getIndicatorActivatable" o = TabPageGetIndicatorActivatableMethodInfo
    ResolveTabPageMethod "getIndicatorIcon" o = TabPageGetIndicatorIconMethodInfo
    ResolveTabPageMethod "getLoading" o = TabPageGetLoadingMethodInfo
    ResolveTabPageMethod "getNeedsAttention" o = TabPageGetNeedsAttentionMethodInfo
    ResolveTabPageMethod "getParent" o = TabPageGetParentMethodInfo
    ResolveTabPageMethod "getPinned" o = TabPageGetPinnedMethodInfo
    ResolveTabPageMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTabPageMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTabPageMethod "getSelected" o = TabPageGetSelectedMethodInfo
    ResolveTabPageMethod "getTitle" o = TabPageGetTitleMethodInfo
    ResolveTabPageMethod "getTooltip" o = TabPageGetTooltipMethodInfo
    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 "setLoading" o = TabPageSetLoadingMethodInfo
    ResolveTabPageMethod "setNeedsAttention" o = TabPageSetNeedsAttentionMethodInfo
    ResolveTabPageMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    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 (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 (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 (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.Handy.Objects.TabPage.child"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-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 (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 (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 (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 (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 (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.Handy.Objects.TabPage.icon"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-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 (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 (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 (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 (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.Handy.Objects.TabPage.indicatorActivatable"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-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 (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 (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 (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 (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 (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.Handy.Objects.TabPage.indicatorIcon"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#g:attr:indicatorIcon"
        })
#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 (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 (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 (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 (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.Handy.Objects.TabPage.loading"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-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 (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 (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 (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 (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.Handy.Objects.TabPage.needsAttention"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#g:attr:needsAttention"
        })
#endif

-- VVV Prop "parent"
   -- Type: TInterface (Name {namespace = "Handy", 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 (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 (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 (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.Handy.Objects.TabPage.parent"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-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 (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.Handy.Objects.TabPage.pinned"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-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 (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.Handy.Objects.TabPage.selected"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#g:attr:selected"
        })
#endif

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

-- | 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 (Maybe T.Text)
getTabPageTitle :: forall (m :: * -> *) o.
(MonadIO m, IsTabPage o) =>
o -> m (Maybe Text)
getTabPageTitle o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"title"

-- | Set the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' 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 (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 (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 (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)

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

#if defined(ENABLE_OVERLOADING)
data TabPageTitlePropertyInfo
instance AttrInfo TabPageTitlePropertyInfo where
    type AttrAllowedOps TabPageTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint TabPageTitlePropertyInfo = IsTabPage
    type AttrSetTypeConstraint TabPageTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint TabPageTitlePropertyInfo = (~) T.Text
    type AttrTransferType TabPageTitlePropertyInfo = T.Text
    type AttrGetType TabPageTitlePropertyInfo = (Maybe T.Text)
    type AttrLabel TabPageTitlePropertyInfo = "title"
    type AttrOrigin TabPageTitlePropertyInfo = TabPage
    attrGet = getTabPageTitle
    attrSet = setTabPageTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructTabPageTitle
    attrClear = clearTabPageTitle
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.TabPage.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#g:attr:title"
        })
#endif

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

-- | 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 (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 (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 (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 (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)

-- | Set the value of the “@tooltip@” 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' #tooltip
-- @
clearTabPageTooltip :: (MonadIO m, IsTabPage o) => o -> m ()
clearTabPageTooltip :: forall (m :: * -> *) o. (MonadIO m, IsTabPage o) => o -> m ()
clearTabPageTooltip o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"tooltip" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data TabPageTooltipPropertyInfo
instance AttrInfo TabPageTooltipPropertyInfo where
    type AttrAllowedOps TabPageTooltipPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    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 = clearTabPageTooltip
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.TabPage.tooltip"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#g:attr:tooltip"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TabPage
type instance O.AttributeList TabPage = TabPageAttributeList
type TabPageAttributeList = ('[ '("child", TabPageChildPropertyInfo), '("icon", TabPageIconPropertyInfo), '("indicatorActivatable", TabPageIndicatorActivatablePropertyInfo), '("indicatorIcon", TabPageIndicatorIconPropertyInfo), '("loading", TabPageLoadingPropertyInfo), '("needsAttention", TabPageNeedsAttentionPropertyInfo), '("parent", TabPageParentPropertyInfo), '("pinned", TabPagePinnedPropertyInfo), '("selected", TabPageSelectedPropertyInfo), '("title", TabPageTitlePropertyInfo), '("tooltip", TabPageTooltipPropertyInfo)] :: [(Symbol, *)])
#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

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

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, *)])

#endif

-- method TabPage::get_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdyTabPage" , 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 "hdy_tab_page_get_child" hdy_tab_page_get_child :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Handy", name = "TabPage"})
    IO (Ptr Gtk.Widget.Widget)

-- | Gets the child of /@self@/.
-- 
-- /Since: 1.2/
tabPageGetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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)
hdy_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 (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.Handy.Objects.TabPage.tabPageGetChild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageGetChild"
        })


#endif

-- method TabPage::get_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdyTabPage" , 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 "hdy_tab_page_get_icon" hdy_tab_page_get_icon :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Handy", name = "TabPage"})
    IO (Ptr Gio.Icon.Icon)

-- | Gets the icon of /@self@/, see 'GI.Handy.Objects.TabPage.tabPageSetIcon'.
-- 
-- /Since: 1.2/
tabPageGetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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)
hdy_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 (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 (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.Handy.Objects.TabPage.tabPageGetIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageGetIcon"
        })


#endif

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

-- | Gets whether the indicator of /@self@/ is activatable, see
-- 'GI.Handy.Objects.TabPage.tabPageSetIndicatorActivatable'.
-- 
-- /Since: 1.2/
tabPageGetIndicatorActivatable ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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
hdy_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 (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.Handy.Objects.TabPage.tabPageGetIndicatorActivatable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageGetIndicatorActivatable"
        })


#endif

-- method TabPage::get_indicator_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdyTabPage" , 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 "hdy_tab_page_get_indicator_icon" hdy_tab_page_get_indicator_icon :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Handy", name = "TabPage"})
    IO (Ptr Gio.Icon.Icon)

-- | Gets the indicator icon of /@self@/, see 'GI.Handy.Objects.TabPage.tabPageSetIndicatorIcon'.
-- 
-- /Since: 1.2/
tabPageGetIndicatorIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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)
hdy_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 (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 (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.Handy.Objects.TabPage.tabPageGetIndicatorIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageGetIndicatorIcon"
        })


#endif

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

-- | Gets whether /@self@/ is loading, see 'GI.Handy.Objects.TabPage.tabPageSetLoading'.
-- 
-- /Since: 1.2/
tabPageGetLoading ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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
hdy_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 (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.Handy.Objects.TabPage.tabPageGetLoading",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageGetLoading"
        })


#endif

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

-- | Gets whether /@self@/ needs attention, see 'GI.Handy.Objects.TabPage.tabPageSetNeedsAttention'.
-- 
-- /Since: 1.2/
tabPageGetNeedsAttention ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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
hdy_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 (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.Handy.Objects.TabPage.tabPageGetNeedsAttention",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageGetNeedsAttention"
        })


#endif

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

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

-- | Gets the parent page of /@self@/, or 'P.Nothing' if the /@self@/ does not have a parent.
-- 
-- See 'GI.Handy.Objects.TabView.tabViewAddPage' and 'GI.Handy.Objects.TabView.tabViewClosePage'.
-- 
-- /Since: 1.2/
tabPageGetParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> m (Maybe TabPage)
    -- ^ __Returns:__ the parent page of /@self@/, or 'P.Nothing'
tabPageGetParent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m (Maybe TabPage)
tabPageGetParent a
self = IO (Maybe TabPage) -> m (Maybe TabPage)
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)
hdy_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 (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 (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.Handy.Objects.TabPage.tabPageGetParent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageGetParent"
        })


#endif

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

-- | Gets whether /@self@/ is pinned. See 'GI.Handy.Objects.TabView.tabViewSetPagePinned'.
-- 
-- /Since: 1.2/
tabPageGetPinned ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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
hdy_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 (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.Handy.Objects.TabPage.tabPageGetPinned",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageGetPinned"
        })


#endif

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

-- | Gets whether /@self@/ is selected. See 'GI.Handy.Objects.TabView.tabViewSetSelectedPage'.
-- 
-- /Since: 1.2/
tabPageGetSelected ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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
hdy_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 (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.Handy.Objects.TabPage.tabPageGetSelected",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageGetSelected"
        })


#endif

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

-- | Gets the title of /@self@/, see 'GI.Handy.Objects.TabPage.tabPageSetTitle'.
-- 
-- /Since: 1.2/
tabPageGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the title of /@self@/
tabPageGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> m (Maybe Text)
tabPageGetTitle a
self = IO (Maybe Text) -> m (Maybe Text)
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
hdy_tab_page_get_title 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 (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 (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data TabPageGetTitleMethodInfo
instance (signature ~ (m (Maybe 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.Handy.Objects.TabPage.tabPageGetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageGetTitle"
        })


#endif

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

-- | Gets the tooltip of /@self@/, see 'GI.Handy.Objects.TabPage.tabPageSetTooltip'.
-- 
-- /Since: 1.2/
tabPageGetTooltip ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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
hdy_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 (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 (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.Handy.Objects.TabPage.tabPageGetTooltip",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageGetTooltip"
        })


#endif

-- method TabPage::set_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdyTabPage" , 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 "hdy_tab_page_set_icon" hdy_tab_page_set_icon :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Handy", name = "TabPage"})
    Ptr Gio.Icon.Icon ->                    -- icon : TInterface (Name {namespace = "Gio", name = "Icon"})
    IO ()

-- | Sets the icon of /@self@/, displayed next to the title.
-- 
-- t'GI.Handy.Objects.TabBar.TabBar' will not show the icon if t'GI.Handy.Objects.TabPage.TabPage':@/loading/@ is set to 'P.True',
-- or if /@self@/ is pinned and t'GI.Handy.Objects.TabPage.TabPage':@/indicator-icon/@ is set.
-- 
-- /Since: 1.2/
tabPageSetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a, Gio.Icon.IsIcon b) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Icon
jIcon'
    Ptr TabPage -> Ptr Icon -> IO ()
hdy_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 (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.Handy.Objects.TabPage.tabPageSetIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageSetIcon"
        })


#endif

-- method TabPage::set_indicator_activatable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdyTabPage" , 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 "hdy_tab_page_set_indicator_activatable" hdy_tab_page_set_indicator_activatable :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Handy", name = "TabPage"})
    CInt ->                                 -- activatable : TBasicType TBoolean
    IO ()

-- | sets whether the indicator of /@self@/ is activatable.
-- 
-- If set to 'P.True', [indicatorActivated]("GI.Handy.Objects.TabView#g:signal:indicatorActivated") will be emitted when
-- the indicator is clicked.
-- 
-- If t'GI.Handy.Objects.TabPage.TabPage':@/indicator-icon/@ is not set, does nothing.
-- 
-- /Since: 1.2/
tabPageSetIndicatorActivatable ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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
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
fromEnum) Bool
activatable
    Ptr TabPage -> CInt -> IO ()
hdy_tab_page_set_indicator_activatable Ptr TabPage
self' CInt
activatable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
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.Handy.Objects.TabPage.tabPageSetIndicatorActivatable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageSetIndicatorActivatable"
        })


#endif

-- method TabPage::set_indicator_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdyTabPage" , 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 "hdy_tab_page_set_indicator_icon" hdy_tab_page_set_indicator_icon :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Handy", 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.
-- 
-- t'GI.Handy.Objects.TabPage.TabPage' will show it at the beginning of the tab, alongside icon
-- representing t'GI.Handy.Objects.TabPage.TabPage':@/icon/@ or loading spinner.
-- 
-- If the page is pinned, the indicator will be shown instead of icon or spinner.
-- 
-- If t'GI.Handy.Objects.TabPage.TabPage':@/indicator-activatable/@ is set to 'P.True', indicator icon
-- can act as a button.
-- 
-- /Since: 1.2/
tabPageSetIndicatorIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a, Gio.Icon.IsIcon b) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Icon
jIndicatorIcon'
    Ptr TabPage -> Ptr Icon -> IO ()
hdy_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 (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.Handy.Objects.TabPage.tabPageSetIndicatorIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageSetIndicatorIcon"
        })


#endif

-- method TabPage::set_loading
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdyTabPage" , 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 "hdy_tab_page_set_loading" hdy_tab_page_set_loading :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Handy", name = "TabPage"})
    CInt ->                                 -- loading : TBasicType TBoolean
    IO ()

-- | Sets wether /@self@/ is loading.
-- 
-- If set to 'P.True', t'GI.Handy.Objects.TabBar.TabBar' will display a spinner in place of icon.
-- 
-- If /@self@/ is pinned and t'GI.Handy.Objects.TabPage.TabPage':@/indicator-icon/@ is set, the loading status
-- will not be visible.
-- 
-- /Since: 1.2/
tabPageSetLoading ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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
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
fromEnum) Bool
loading
    Ptr TabPage -> CInt -> IO ()
hdy_tab_page_set_loading Ptr TabPage
self' CInt
loading'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
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.Handy.Objects.TabPage.tabPageSetLoading",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageSetLoading"
        })


#endif

-- method TabPage::set_needs_attention
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdyTabPage" , 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 "hdy_tab_page_set_needs_attention" hdy_tab_page_set_needs_attention :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Handy", name = "TabPage"})
    CInt ->                                 -- needs_attention : TBasicType TBoolean
    IO ()

-- | Sets whether /@self@/ needs attention.
-- 
-- t'GI.Handy.Objects.TabBar.TabBar' will display a glow under the tab representing /@self@/ if set to
-- 'P.True'. If the tab is not visible, the corresponding edge of the tab bar will
-- be highlighted.
-- 
-- /Since: 1.2/
tabPageSetNeedsAttention ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> 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 (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
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
fromEnum) Bool
needsAttention
    Ptr TabPage -> CInt -> IO ()
hdy_tab_page_set_needs_attention Ptr TabPage
self' CInt
needsAttention'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
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.Handy.Objects.TabPage.tabPageSetNeedsAttention",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageSetNeedsAttention"
        })


#endif

-- method TabPage::set_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdyTabPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , 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 "hdy_tab_page_set_title" hdy_tab_page_set_title :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Handy", name = "TabPage"})
    CString ->                              -- title : TBasicType TUTF8
    IO ()

-- | Sets the title of /@self@/.
-- 
-- t'GI.Handy.Objects.TabBar.TabBar' will display it in the center of the tab representing /@self@/
-- unless it\'s pinned, and will use it as a tooltip unless t'GI.Handy.Objects.TabPage.TabPage':@/tooltip/@
-- is set.
-- 
-- /Since: 1.2/
tabPageSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> Maybe (T.Text)
    -- ^ /@title@/: the title of /@self@/
    -> m ()
tabPageSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> Maybe Text -> m ()
tabPageSetTitle a
self Maybe Text
title = IO () -> m ()
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
maybeTitle <- case Maybe Text
title of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jTitle -> do
            CString
jTitle' <- Text -> IO CString
textToCString Text
jTitle
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTitle'
    Ptr TabPage -> CString -> IO ()
hdy_tab_page_set_title Ptr TabPage
self' CString
maybeTitle
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTitle
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TabPageSetTitleMethodInfo
instance (signature ~ (Maybe (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.Handy.Objects.TabPage.tabPageSetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageSetTitle"
        })


#endif

-- method TabPage::set_tooltip
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "TabPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdyTabPage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tooltip"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , 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 "hdy_tab_page_set_tooltip" hdy_tab_page_set_tooltip :: 
    Ptr TabPage ->                          -- self : TInterface (Name {namespace = "Handy", name = "TabPage"})
    CString ->                              -- tooltip : TBasicType TUTF8
    IO ()

-- | Sets the tooltip of /@self@/, marked up with the Pango text markup language.
-- 
-- If not set, t'GI.Handy.Objects.TabBar.TabBar' will use t'GI.Handy.Objects.TabPage.TabPage':@/title/@ as a tooltip instead.
-- 
-- /Since: 1.2/
tabPageSetTooltip ::
    (B.CallStack.HasCallStack, MonadIO m, IsTabPage a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.TabPage.TabPage'
    -> Maybe (T.Text)
    -- ^ /@tooltip@/: the tooltip of /@self@/
    -> m ()
tabPageSetTooltip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTabPage a) =>
a -> Maybe Text -> m ()
tabPageSetTooltip a
self Maybe Text
tooltip = IO () -> m ()
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
maybeTooltip <- case Maybe Text
tooltip of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jTooltip -> do
            CString
jTooltip' <- Text -> IO CString
textToCString Text
jTooltip
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTooltip'
    Ptr TabPage -> CString -> IO ()
hdy_tab_page_set_tooltip Ptr TabPage
self' CString
maybeTooltip
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTooltip
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TabPageSetTooltipMethodInfo
instance (signature ~ (Maybe (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.Handy.Objects.TabPage.tabPageSetTooltip",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.1/docs/GI-Handy-Objects-TabPage.html#v:tabPageSetTooltip"
        })


#endif