{-# LANGUAGE TypeApplications #-}


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

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

module GI.Adw.Objects.ViewStackPage
    ( 

-- * Exported types
    ViewStackPage(..)                       ,
    IsViewStackPage                         ,
    toViewStackPage                         ,


 -- * 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"), [resetProperty]("GI.Gtk.Interfaces.Accessible#g:method:resetProperty"), [resetRelation]("GI.Gtk.Interfaces.Accessible#g:method:resetRelation"), [resetState]("GI.Gtk.Interfaces.Accessible#g:method:resetState"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [updateNextAccessibleSibling]("GI.Gtk.Interfaces.Accessible#g:method:updateNextAccessibleSibling"), [updateProperty]("GI.Gtk.Interfaces.Accessible#g:method:updateProperty"), [updateRelation]("GI.Gtk.Interfaces.Accessible#g:method:updateRelation"), [updateState]("GI.Gtk.Interfaces.Accessible#g:method:updateState"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAccessibleParent]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleParent"), [getAccessibleRole]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleRole"), [getAtContext]("GI.Gtk.Interfaces.Accessible#g:method:getAtContext"), [getBadgeNumber]("GI.Adw.Objects.ViewStackPage#g:method:getBadgeNumber"), [getBounds]("GI.Gtk.Interfaces.Accessible#g:method:getBounds"), [getChild]("GI.Adw.Objects.ViewStackPage#g:method:getChild"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFirstAccessibleChild]("GI.Gtk.Interfaces.Accessible#g:method:getFirstAccessibleChild"), [getIconName]("GI.Adw.Objects.ViewStackPage#g:method:getIconName"), [getName]("GI.Adw.Objects.ViewStackPage#g:method:getName"), [getNeedsAttention]("GI.Adw.Objects.ViewStackPage#g:method:getNeedsAttention"), [getNextAccessibleSibling]("GI.Gtk.Interfaces.Accessible#g:method:getNextAccessibleSibling"), [getPlatformState]("GI.Gtk.Interfaces.Accessible#g:method:getPlatformState"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTitle]("GI.Adw.Objects.ViewStackPage#g:method:getTitle"), [getUseUnderline]("GI.Adw.Objects.ViewStackPage#g:method:getUseUnderline"), [getVisible]("GI.Adw.Objects.ViewStackPage#g:method:getVisible").
-- 
-- ==== Setters
-- [setAccessibleParent]("GI.Gtk.Interfaces.Accessible#g:method:setAccessibleParent"), [setBadgeNumber]("GI.Adw.Objects.ViewStackPage#g:method:setBadgeNumber"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setIconName]("GI.Adw.Objects.ViewStackPage#g:method:setIconName"), [setName]("GI.Adw.Objects.ViewStackPage#g:method:setName"), [setNeedsAttention]("GI.Adw.Objects.ViewStackPage#g:method:setNeedsAttention"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTitle]("GI.Adw.Objects.ViewStackPage#g:method:setTitle"), [setUseUnderline]("GI.Adw.Objects.ViewStackPage#g:method:setUseUnderline"), [setVisible]("GI.Adw.Objects.ViewStackPage#g:method:setVisible").

#if defined(ENABLE_OVERLOADING)
    ResolveViewStackPageMethod              ,
#endif

-- ** getBadgeNumber #method:getBadgeNumber#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageGetBadgeNumberMethodInfo   ,
#endif
    viewStackPageGetBadgeNumber             ,


-- ** getChild #method:getChild#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageGetChildMethodInfo         ,
#endif
    viewStackPageGetChild                   ,


-- ** getIconName #method:getIconName#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageGetIconNameMethodInfo      ,
#endif
    viewStackPageGetIconName                ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageGetNameMethodInfo          ,
#endif
    viewStackPageGetName                    ,


-- ** getNeedsAttention #method:getNeedsAttention#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageGetNeedsAttentionMethodInfo,
#endif
    viewStackPageGetNeedsAttention          ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageGetTitleMethodInfo         ,
#endif
    viewStackPageGetTitle                   ,


-- ** getUseUnderline #method:getUseUnderline#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageGetUseUnderlineMethodInfo  ,
#endif
    viewStackPageGetUseUnderline            ,


-- ** getVisible #method:getVisible#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageGetVisibleMethodInfo       ,
#endif
    viewStackPageGetVisible                 ,


-- ** setBadgeNumber #method:setBadgeNumber#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageSetBadgeNumberMethodInfo   ,
#endif
    viewStackPageSetBadgeNumber             ,


-- ** setIconName #method:setIconName#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageSetIconNameMethodInfo      ,
#endif
    viewStackPageSetIconName                ,


-- ** setName #method:setName#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageSetNameMethodInfo          ,
#endif
    viewStackPageSetName                    ,


-- ** setNeedsAttention #method:setNeedsAttention#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageSetNeedsAttentionMethodInfo,
#endif
    viewStackPageSetNeedsAttention          ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageSetTitleMethodInfo         ,
#endif
    viewStackPageSetTitle                   ,


-- ** setUseUnderline #method:setUseUnderline#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageSetUseUnderlineMethodInfo  ,
#endif
    viewStackPageSetUseUnderline            ,


-- ** setVisible #method:setVisible#

#if defined(ENABLE_OVERLOADING)
    ViewStackPageSetVisibleMethodInfo       ,
#endif
    viewStackPageSetVisible                 ,




 -- * Properties


-- ** badgeNumber #attr:badgeNumber#
-- | The badge number for this page.
-- 
-- [class/@viewSwitcher@/] can display it as a badge next to the page icon. It is
-- commonly used to display a number of unread items within the page.
-- 
-- It can be used together with [property/@viewStack@/{age}:needs-attention].

#if defined(ENABLE_OVERLOADING)
    ViewStackPageBadgeNumberPropertyInfo    ,
#endif
    constructViewStackPageBadgeNumber       ,
    getViewStackPageBadgeNumber             ,
    setViewStackPageBadgeNumber             ,
#if defined(ENABLE_OVERLOADING)
    viewStackPageBadgeNumber                ,
#endif


-- ** child #attr:child#
-- | The stack child to which the page belongs.

#if defined(ENABLE_OVERLOADING)
    ViewStackPageChildPropertyInfo          ,
#endif
    constructViewStackPageChild             ,
    getViewStackPageChild                   ,
#if defined(ENABLE_OVERLOADING)
    viewStackPageChild                      ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    ViewStackPageIconNamePropertyInfo       ,
#endif
    clearViewStackPageIconName              ,
    constructViewStackPageIconName          ,
    getViewStackPageIconName                ,
    setViewStackPageIconName                ,
#if defined(ENABLE_OVERLOADING)
    viewStackPageIconName                   ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    ViewStackPageNamePropertyInfo           ,
#endif
    clearViewStackPageName                  ,
    constructViewStackPageName              ,
    getViewStackPageName                    ,
    setViewStackPageName                    ,
#if defined(ENABLE_OVERLOADING)
    viewStackPageName                       ,
#endif


-- ** needsAttention #attr:needsAttention#
-- | Whether the page requires the user attention.
-- 
-- [class/@viewSwitcher@/] will display it as a dot next to the page icon.

#if defined(ENABLE_OVERLOADING)
    ViewStackPageNeedsAttentionPropertyInfo ,
#endif
    constructViewStackPageNeedsAttention    ,
    getViewStackPageNeedsAttention          ,
    setViewStackPageNeedsAttention          ,
#if defined(ENABLE_OVERLOADING)
    viewStackPageNeedsAttention             ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    ViewStackPageTitlePropertyInfo          ,
#endif
    clearViewStackPageTitle                 ,
    constructViewStackPageTitle             ,
    getViewStackPageTitle                   ,
    setViewStackPageTitle                   ,
#if defined(ENABLE_OVERLOADING)
    viewStackPageTitle                      ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    ViewStackPageUseUnderlinePropertyInfo   ,
#endif
    constructViewStackPageUseUnderline      ,
    getViewStackPageUseUnderline            ,
    setViewStackPageUseUnderline            ,
#if defined(ENABLE_OVERLOADING)
    viewStackPageUseUnderline               ,
#endif


-- ** visible #attr:visible#
-- | Whether this page is visible.
-- 
-- This is independent from the [Widget:visible]("GI.Gtk.Objects.Widget#g:attr:visible") property of
-- [property/@viewStackPage@/:child].

#if defined(ENABLE_OVERLOADING)
    ViewStackPageVisiblePropertyInfo        ,
#endif
    constructViewStackPageVisible           ,
    getViewStackPageVisible                 ,
    setViewStackPageVisible                 ,
#if defined(ENABLE_OVERLOADING)
    viewStackPageVisible                    ,
#endif




    ) where

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

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

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

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

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

foreign import ccall "adw_view_stack_page_get_type"
    c_adw_view_stack_page_get_type :: IO B.Types.GType

instance B.Types.TypedObject ViewStackPage where
    glibType :: IO GType
glibType = IO GType
c_adw_view_stack_page_get_type

instance B.Types.GObject ViewStackPage

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveViewStackPageMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveViewStackPageMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveViewStackPageMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveViewStackPageMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveViewStackPageMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveViewStackPageMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveViewStackPageMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveViewStackPageMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveViewStackPageMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveViewStackPageMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveViewStackPageMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveViewStackPageMethod "resetProperty" o = Gtk.Accessible.AccessibleResetPropertyMethodInfo
    ResolveViewStackPageMethod "resetRelation" o = Gtk.Accessible.AccessibleResetRelationMethodInfo
    ResolveViewStackPageMethod "resetState" o = Gtk.Accessible.AccessibleResetStateMethodInfo
    ResolveViewStackPageMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveViewStackPageMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveViewStackPageMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveViewStackPageMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveViewStackPageMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveViewStackPageMethod "updateNextAccessibleSibling" o = Gtk.Accessible.AccessibleUpdateNextAccessibleSiblingMethodInfo
    ResolveViewStackPageMethod "updateProperty" o = Gtk.Accessible.AccessibleUpdatePropertyMethodInfo
    ResolveViewStackPageMethod "updateRelation" o = Gtk.Accessible.AccessibleUpdateRelationMethodInfo
    ResolveViewStackPageMethod "updateState" o = Gtk.Accessible.AccessibleUpdateStateMethodInfo
    ResolveViewStackPageMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveViewStackPageMethod "getAccessibleParent" o = Gtk.Accessible.AccessibleGetAccessibleParentMethodInfo
    ResolveViewStackPageMethod "getAccessibleRole" o = Gtk.Accessible.AccessibleGetAccessibleRoleMethodInfo
    ResolveViewStackPageMethod "getAtContext" o = Gtk.Accessible.AccessibleGetAtContextMethodInfo
    ResolveViewStackPageMethod "getBadgeNumber" o = ViewStackPageGetBadgeNumberMethodInfo
    ResolveViewStackPageMethod "getBounds" o = Gtk.Accessible.AccessibleGetBoundsMethodInfo
    ResolveViewStackPageMethod "getChild" o = ViewStackPageGetChildMethodInfo
    ResolveViewStackPageMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveViewStackPageMethod "getFirstAccessibleChild" o = Gtk.Accessible.AccessibleGetFirstAccessibleChildMethodInfo
    ResolveViewStackPageMethod "getIconName" o = ViewStackPageGetIconNameMethodInfo
    ResolveViewStackPageMethod "getName" o = ViewStackPageGetNameMethodInfo
    ResolveViewStackPageMethod "getNeedsAttention" o = ViewStackPageGetNeedsAttentionMethodInfo
    ResolveViewStackPageMethod "getNextAccessibleSibling" o = Gtk.Accessible.AccessibleGetNextAccessibleSiblingMethodInfo
    ResolveViewStackPageMethod "getPlatformState" o = Gtk.Accessible.AccessibleGetPlatformStateMethodInfo
    ResolveViewStackPageMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveViewStackPageMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveViewStackPageMethod "getTitle" o = ViewStackPageGetTitleMethodInfo
    ResolveViewStackPageMethod "getUseUnderline" o = ViewStackPageGetUseUnderlineMethodInfo
    ResolveViewStackPageMethod "getVisible" o = ViewStackPageGetVisibleMethodInfo
    ResolveViewStackPageMethod "setAccessibleParent" o = Gtk.Accessible.AccessibleSetAccessibleParentMethodInfo
    ResolveViewStackPageMethod "setBadgeNumber" o = ViewStackPageSetBadgeNumberMethodInfo
    ResolveViewStackPageMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveViewStackPageMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveViewStackPageMethod "setIconName" o = ViewStackPageSetIconNameMethodInfo
    ResolveViewStackPageMethod "setName" o = ViewStackPageSetNameMethodInfo
    ResolveViewStackPageMethod "setNeedsAttention" o = ViewStackPageSetNeedsAttentionMethodInfo
    ResolveViewStackPageMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveViewStackPageMethod "setTitle" o = ViewStackPageSetTitleMethodInfo
    ResolveViewStackPageMethod "setUseUnderline" o = ViewStackPageSetUseUnderlineMethodInfo
    ResolveViewStackPageMethod "setVisible" o = ViewStackPageSetVisibleMethodInfo
    ResolveViewStackPageMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "badge-number"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

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

#if defined(ENABLE_OVERLOADING)
data ViewStackPageBadgeNumberPropertyInfo
instance AttrInfo ViewStackPageBadgeNumberPropertyInfo where
    type AttrAllowedOps ViewStackPageBadgeNumberPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ViewStackPageBadgeNumberPropertyInfo = IsViewStackPage
    type AttrSetTypeConstraint ViewStackPageBadgeNumberPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint ViewStackPageBadgeNumberPropertyInfo = (~) Word32
    type AttrTransferType ViewStackPageBadgeNumberPropertyInfo = Word32
    type AttrGetType ViewStackPageBadgeNumberPropertyInfo = Word32
    type AttrLabel ViewStackPageBadgeNumberPropertyInfo = "badge-number"
    type AttrOrigin ViewStackPageBadgeNumberPropertyInfo = ViewStackPage
    attrGet = getViewStackPageBadgeNumber
    attrSet = setViewStackPageBadgeNumber
    attrTransfer _ v = do
        return v
    attrConstruct = constructViewStackPageBadgeNumber
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.ViewStackPage.badgeNumber"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-ViewStackPage.html#g:attr:badgeNumber"
        })
#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' viewStackPage #child
-- @
getViewStackPageChild :: (MonadIO m, IsViewStackPage o) => o -> m Gtk.Widget.Widget
getViewStackPageChild :: forall (m :: * -> *) o.
(MonadIO m, IsViewStackPage o) =>
o -> m Widget
getViewStackPageChild o
obj = IO Widget -> m Widget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Widget) -> IO Widget
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getViewStackPageChild" (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`.
constructViewStackPageChild :: (IsViewStackPage o, MIO.MonadIO m, Gtk.Widget.IsWidget a) => a -> m (GValueConstruct o)
constructViewStackPageChild :: forall o (m :: * -> *) a.
(IsViewStackPage o, MonadIO m, IsWidget a) =>
a -> m (GValueConstruct o)
constructViewStackPageChild a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"child" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

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

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

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

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

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

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

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

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data ViewStackPageNamePropertyInfo
instance AttrInfo ViewStackPageNamePropertyInfo where
    type AttrAllowedOps ViewStackPageNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ViewStackPageNamePropertyInfo = IsViewStackPage
    type AttrSetTypeConstraint ViewStackPageNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ViewStackPageNamePropertyInfo = (~) T.Text
    type AttrTransferType ViewStackPageNamePropertyInfo = T.Text
    type AttrGetType ViewStackPageNamePropertyInfo = (Maybe T.Text)
    type AttrLabel ViewStackPageNamePropertyInfo = "name"
    type AttrOrigin ViewStackPageNamePropertyInfo = ViewStackPage
    attrGet = getViewStackPageName
    attrSet = setViewStackPageName
    attrTransfer _ v = do
        return v
    attrConstruct = constructViewStackPageName
    attrClear = clearViewStackPageName
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.ViewStackPage.name"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-ViewStackPage.html#g:attr:name"
        })
#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' viewStackPage #needsAttention
-- @
getViewStackPageNeedsAttention :: (MonadIO m, IsViewStackPage o) => o -> m Bool
getViewStackPageNeedsAttention :: forall (m :: * -> *) o.
(MonadIO m, IsViewStackPage o) =>
o -> m Bool
getViewStackPageNeedsAttention o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"needs-attention"

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

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

#if defined(ENABLE_OVERLOADING)
data ViewStackPageNeedsAttentionPropertyInfo
instance AttrInfo ViewStackPageNeedsAttentionPropertyInfo where
    type AttrAllowedOps ViewStackPageNeedsAttentionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ViewStackPageNeedsAttentionPropertyInfo = IsViewStackPage
    type AttrSetTypeConstraint ViewStackPageNeedsAttentionPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ViewStackPageNeedsAttentionPropertyInfo = (~) Bool
    type AttrTransferType ViewStackPageNeedsAttentionPropertyInfo = Bool
    type AttrGetType ViewStackPageNeedsAttentionPropertyInfo = Bool
    type AttrLabel ViewStackPageNeedsAttentionPropertyInfo = "needs-attention"
    type AttrOrigin ViewStackPageNeedsAttentionPropertyInfo = ViewStackPage
    attrGet = getViewStackPageNeedsAttention
    attrSet = setViewStackPageNeedsAttention
    attrTransfer _ v = do
        return v
    attrConstruct = constructViewStackPageNeedsAttention
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.ViewStackPage.needsAttention"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-ViewStackPage.html#g:attr:needsAttention"
        })
#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' viewStackPage #title
-- @
getViewStackPageTitle :: (MonadIO m, IsViewStackPage o) => o -> m (Maybe T.Text)
getViewStackPageTitle :: forall (m :: * -> *) o.
(MonadIO m, IsViewStackPage o) =>
o -> m (Maybe Text)
getViewStackPageTitle o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"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' viewStackPage [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setViewStackPageTitle :: (MonadIO m, IsViewStackPage o) => o -> T.Text -> m ()
setViewStackPageTitle :: forall (m :: * -> *) o.
(MonadIO m, IsViewStackPage o) =>
o -> Text -> m ()
setViewStackPageTitle o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"title" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | 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
-- @
clearViewStackPageTitle :: (MonadIO m, IsViewStackPage o) => o -> m ()
clearViewStackPageTitle :: forall (m :: * -> *) o. (MonadIO m, IsViewStackPage o) => o -> m ()
clearViewStackPageTitle o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"title" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

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

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

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

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

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

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

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ViewStackPage
type instance O.AttributeList ViewStackPage = ViewStackPageAttributeList
type ViewStackPageAttributeList = ('[ '("accessibleRole", Gtk.Accessible.AccessibleAccessibleRolePropertyInfo), '("badgeNumber", ViewStackPageBadgeNumberPropertyInfo), '("child", ViewStackPageChildPropertyInfo), '("iconName", ViewStackPageIconNamePropertyInfo), '("name", ViewStackPageNamePropertyInfo), '("needsAttention", ViewStackPageNeedsAttentionPropertyInfo), '("title", ViewStackPageTitlePropertyInfo), '("useUnderline", ViewStackPageUseUnderlinePropertyInfo), '("visible", ViewStackPageVisiblePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
viewStackPageBadgeNumber :: AttrLabelProxy "badgeNumber"
viewStackPageBadgeNumber = AttrLabelProxy

viewStackPageChild :: AttrLabelProxy "child"
viewStackPageChild = AttrLabelProxy

viewStackPageIconName :: AttrLabelProxy "iconName"
viewStackPageIconName = AttrLabelProxy

viewStackPageName :: AttrLabelProxy "name"
viewStackPageName = AttrLabelProxy

viewStackPageNeedsAttention :: AttrLabelProxy "needsAttention"
viewStackPageNeedsAttention = AttrLabelProxy

viewStackPageTitle :: AttrLabelProxy "title"
viewStackPageTitle = AttrLabelProxy

viewStackPageUseUnderline :: AttrLabelProxy "useUnderline"
viewStackPageUseUnderline = AttrLabelProxy

viewStackPageVisible :: AttrLabelProxy "visible"
viewStackPageVisible = AttrLabelProxy

#endif

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

#endif

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

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

-- | Gets the badge number for this page.
viewStackPageGetBadgeNumber ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> m Word32
    -- ^ __Returns:__ the badge number for this page
viewStackPageGetBadgeNumber :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> m Word32
viewStackPageGetBadgeNumber a
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr ViewStackPage -> IO Word32
adw_view_stack_page_get_badge_number Ptr ViewStackPage
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ViewStackPageGetBadgeNumberMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsViewStackPage a) => O.OverloadedMethod ViewStackPageGetBadgeNumberMethodInfo a signature where
    overloadedMethod = viewStackPageGetBadgeNumber

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


#endif

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

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

-- | Gets the stack child to which /@self@/ belongs.
viewStackPageGetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> m Gtk.Widget.Widget
    -- ^ __Returns:__ the child to which /@self@/ belongs
viewStackPageGetChild :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> m Widget
viewStackPageGetChild a
self = IO Widget -> m Widget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr ViewStackPage -> IO (Ptr Widget)
adw_view_stack_page_get_child Ptr ViewStackPage
self'
    Text -> Ptr Widget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"viewStackPageGetChild" Ptr Widget
result
    Widget
result' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result'

#if defined(ENABLE_OVERLOADING)
data ViewStackPageGetChildMethodInfo
instance (signature ~ (m Gtk.Widget.Widget), MonadIO m, IsViewStackPage a) => O.OverloadedMethod ViewStackPageGetChildMethodInfo a signature where
    overloadedMethod = viewStackPageGetChild

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


#endif

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

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

-- | Gets the icon name of the page.
viewStackPageGetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the icon name of the page
viewStackPageGetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> m (Maybe Text)
viewStackPageGetIconName a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ViewStackPage -> IO CString
adw_view_stack_page_get_icon_name Ptr ViewStackPage
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ViewStackPageGetIconNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsViewStackPage a) => O.OverloadedMethod ViewStackPageGetIconNameMethodInfo a signature where
    overloadedMethod = viewStackPageGetIconName

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


#endif

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

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

-- | Gets the name of the page.
viewStackPageGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of the page
viewStackPageGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> m (Maybe Text)
viewStackPageGetName a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ViewStackPage -> IO CString
adw_view_stack_page_get_name Ptr ViewStackPage
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ViewStackPageGetNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsViewStackPage a) => O.OverloadedMethod ViewStackPageGetNameMethodInfo a signature where
    overloadedMethod = viewStackPageGetName

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


#endif

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

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

-- | Gets whether the page requires the user attention.
viewStackPageGetNeedsAttention ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> m Bool
    -- ^ __Returns:__ whether the page needs attention
viewStackPageGetNeedsAttention :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> m Bool
viewStackPageGetNeedsAttention a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr ViewStackPage -> IO CInt
adw_view_stack_page_get_needs_attention Ptr ViewStackPage
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ViewStackPageGetNeedsAttentionMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsViewStackPage a) => O.OverloadedMethod ViewStackPageGetNeedsAttentionMethodInfo a signature where
    overloadedMethod = viewStackPageGetNeedsAttention

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


#endif

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

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

-- | Gets the page title.
viewStackPageGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the page title
viewStackPageGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> m (Maybe Text)
viewStackPageGetTitle a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ViewStackPage -> IO CString
adw_view_stack_page_get_title Ptr ViewStackPage
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ViewStackPageGetTitleMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsViewStackPage a) => O.OverloadedMethod ViewStackPageGetTitleMethodInfo a signature where
    overloadedMethod = viewStackPageGetTitle

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


#endif

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

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

-- | Gets whether underlines in the page title indicate mnemonics.
viewStackPageGetUseUnderline ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> m Bool
    -- ^ __Returns:__ whether underlines in the page title indicate mnemonics
viewStackPageGetUseUnderline :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> m Bool
viewStackPageGetUseUnderline a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr ViewStackPage -> IO CInt
adw_view_stack_page_get_use_underline Ptr ViewStackPage
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ViewStackPageGetUseUnderlineMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsViewStackPage a) => O.OverloadedMethod ViewStackPageGetUseUnderlineMethodInfo a signature where
    overloadedMethod = viewStackPageGetUseUnderline

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


#endif

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

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

-- | Gets whether /@self@/ is visible in its @AdwViewStack@.
-- 
-- This is independent from the [Widget:visible]("GI.Gtk.Objects.Widget#g:attr:visible")
-- property of its widget.
viewStackPageGetVisible ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> m Bool
    -- ^ __Returns:__ whether /@self@/ is visible
viewStackPageGetVisible :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> m Bool
viewStackPageGetVisible a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr ViewStackPage -> IO CInt
adw_view_stack_page_get_visible Ptr ViewStackPage
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ViewStackPageGetVisibleMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsViewStackPage a) => O.OverloadedMethod ViewStackPageGetVisibleMethodInfo a signature where
    overloadedMethod = viewStackPageGetVisible

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


#endif

-- method ViewStackPage::set_badge_number
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "ViewStackPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a view stack page" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "badge_number"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_view_stack_page_set_badge_number" adw_view_stack_page_set_badge_number :: 
    Ptr ViewStackPage ->                    -- self : TInterface (Name {namespace = "Adw", name = "ViewStackPage"})
    Word32 ->                               -- badge_number : TBasicType TUInt
    IO ()

-- | Sets the badge number for this page.
-- 
-- [class/@viewSwitcher@/] can display it as a badge next to the page icon. It is
-- commonly used to display a number of unread items within the page.
-- 
-- It can be used together with [property/@viewStack@/{age}:needs-attention].
viewStackPageSetBadgeNumber ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> Word32
    -- ^ /@badgeNumber@/: the new value to set
    -> m ()
viewStackPageSetBadgeNumber :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> Word32 -> m ()
viewStackPageSetBadgeNumber a
self Word32
badgeNumber = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ViewStackPage -> Word32 -> IO ()
adw_view_stack_page_set_badge_number Ptr ViewStackPage
self' Word32
badgeNumber
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ViewStackPageSetBadgeNumberMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsViewStackPage a) => O.OverloadedMethod ViewStackPageSetBadgeNumberMethodInfo a signature where
    overloadedMethod = viewStackPageSetBadgeNumber

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


#endif

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

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

-- | Sets the icon name of the page.
viewStackPageSetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> Maybe (T.Text)
    -- ^ /@iconName@/: the icon name
    -> m ()
viewStackPageSetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> Maybe Text -> m ()
viewStackPageSetIconName a
self Maybe Text
iconName = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeIconName <- case Maybe Text
iconName of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jIconName -> do
            CString
jIconName' <- Text -> IO CString
textToCString Text
jIconName
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jIconName'
    Ptr ViewStackPage -> CString -> IO ()
adw_view_stack_page_set_icon_name Ptr ViewStackPage
self' CString
maybeIconName
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeIconName
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

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

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

-- | Sets the name of the page.
viewStackPageSetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> Maybe (T.Text)
    -- ^ /@name@/: the page name
    -> m ()
viewStackPageSetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> Maybe Text -> m ()
viewStackPageSetName a
self Maybe Text
name = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jName -> do
            CString
jName' <- Text -> IO CString
textToCString Text
jName
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jName'
    Ptr ViewStackPage -> CString -> IO ()
adw_view_stack_page_set_name Ptr ViewStackPage
self' CString
maybeName
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeName
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method ViewStackPage::set_needs_attention
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "ViewStackPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a view stack page" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "needs_attention"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether the page requires the user attention.
-- 
-- [class/@viewSwitcher@/] will display it as a dot next to the page icon.
viewStackPageSetNeedsAttention ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> Bool
    -- ^ /@needsAttention@/: the new value to set
    -> m ()
viewStackPageSetNeedsAttention :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> Bool -> m ()
viewStackPageSetNeedsAttention a
self Bool
needsAttention = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let needsAttention' :: CInt
needsAttention' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
needsAttention
    Ptr ViewStackPage -> CInt -> IO ()
adw_view_stack_page_set_needs_attention Ptr ViewStackPage
self' CInt
needsAttention'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ViewStackPageSetNeedsAttentionMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsViewStackPage a) => O.OverloadedMethod ViewStackPageSetNeedsAttentionMethodInfo a signature where
    overloadedMethod = viewStackPageSetNeedsAttention

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


#endif

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

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

-- | Sets the page title.
viewStackPageSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> Maybe (T.Text)
    -- ^ /@title@/: the page title
    -> m ()
viewStackPageSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> Maybe Text -> m ()
viewStackPageSetTitle a
self Maybe Text
title = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
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 a. a -> IO a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTitle'
    Ptr ViewStackPage -> CString -> IO ()
adw_view_stack_page_set_title Ptr ViewStackPage
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method ViewStackPage::set_use_underline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "ViewStackPage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a view stack page" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "use_underline"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether underlines in the page title indicate mnemonics.
viewStackPageSetUseUnderline ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> Bool
    -- ^ /@useUnderline@/: the new value to set
    -> m ()
viewStackPageSetUseUnderline :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> Bool -> m ()
viewStackPageSetUseUnderline a
self Bool
useUnderline = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let useUnderline' :: CInt
useUnderline' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
useUnderline
    Ptr ViewStackPage -> CInt -> IO ()
adw_view_stack_page_set_use_underline Ptr ViewStackPage
self' CInt
useUnderline'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ViewStackPageSetUseUnderlineMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsViewStackPage a) => O.OverloadedMethod ViewStackPageSetUseUnderlineMethodInfo a signature where
    overloadedMethod = viewStackPageSetUseUnderline

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


#endif

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

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

-- | Sets whether /@page@/ is visible in its @AdwViewStack@.
-- 
-- This is independent from the [Widget:visible]("GI.Gtk.Objects.Widget#g:attr:visible") property of
-- [property/@viewStackPage@/:child].
viewStackPageSetVisible ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewStackPage a) =>
    a
    -- ^ /@self@/: a view stack page
    -> Bool
    -- ^ /@visible@/: whether /@self@/ is visible
    -> m ()
viewStackPageSetVisible :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewStackPage a) =>
a -> Bool -> m ()
viewStackPageSetVisible a
self Bool
visible = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewStackPage
self' <- a -> IO (Ptr ViewStackPage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let visible' :: CInt
visible' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
visible
    Ptr ViewStackPage -> CInt -> IO ()
adw_view_stack_page_set_visible Ptr ViewStackPage
self' CInt
visible'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ViewStackPageSetVisibleMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsViewStackPage a) => O.OverloadedMethod ViewStackPageSetVisibleMethodInfo a signature where
    overloadedMethod = viewStackPageSetVisible

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


#endif