{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An adaptive view switcher.
-- 
-- \<picture>
--   \<source srcset=\"view-switcher-dark.png\" media=\"(prefers-color-scheme: dark)\">
--   \<img src=\"view-switcher.png\" alt=\"view-switcher\">
-- \<\/picture>
-- 
-- An adaptive view switcher designed to switch between multiple views
-- contained in a [class/@viewStack@/] in a similar fashion to
-- t'GI.Gtk.Objects.StackSwitcher.StackSwitcher'.
-- 
-- @AdwViewSwitcher@ buttons always have an icon and a label. They can be
-- displayed side by side, or icon on top of the label. This can be controlled
-- via the [property/@viewSwitcher@/:policy] property.
-- 
-- Most applications should be using [class/@viewSwitcherBar@/] and
-- [class/@viewSwitcherTitle@/].
-- 
-- == CSS nodes
-- 
-- @AdwViewSwitcher@ has a single CSS node with name @viewswitcher@. It can have
-- the style classes @.wide@ and @.narrow@, matching its policy.
-- 
-- == Accessibility
-- 
-- @AdwViewSwitcher@ uses the @GTK_ACCESSIBLE_ROLE_TAB_LIST@ role and uses the
-- @GTK_ACCESSIBLE_ROLE_TAB@ for its buttons.

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

module GI.Adw.Objects.ViewSwitcher
    ( 

-- * Exported types
    ViewSwitcher(..)                        ,
    IsViewSwitcher                          ,
    toViewSwitcher                          ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveViewSwitcherMethod               ,
#endif

-- ** getPolicy #method:getPolicy#

#if defined(ENABLE_OVERLOADING)
    ViewSwitcherGetPolicyMethodInfo         ,
#endif
    viewSwitcherGetPolicy                   ,


-- ** getStack #method:getStack#

#if defined(ENABLE_OVERLOADING)
    ViewSwitcherGetStackMethodInfo          ,
#endif
    viewSwitcherGetStack                    ,


-- ** new #method:new#

    viewSwitcherNew                         ,


-- ** setPolicy #method:setPolicy#

#if defined(ENABLE_OVERLOADING)
    ViewSwitcherSetPolicyMethodInfo         ,
#endif
    viewSwitcherSetPolicy                   ,


-- ** setStack #method:setStack#

#if defined(ENABLE_OVERLOADING)
    ViewSwitcherSetStackMethodInfo          ,
#endif
    viewSwitcherSetStack                    ,




 -- * Properties


-- ** policy #attr:policy#
-- | The policy to determine which mode to use.

#if defined(ENABLE_OVERLOADING)
    ViewSwitcherPolicyPropertyInfo          ,
#endif
    constructViewSwitcherPolicy             ,
    getViewSwitcherPolicy                   ,
    setViewSwitcherPolicy                   ,
#if defined(ENABLE_OVERLOADING)
    viewSwitcherPolicy                      ,
#endif


-- ** stack #attr:stack#
-- | The stack the view switcher controls.

#if defined(ENABLE_OVERLOADING)
    ViewSwitcherStackPropertyInfo           ,
#endif
    clearViewSwitcherStack                  ,
    constructViewSwitcherStack              ,
    getViewSwitcherStack                    ,
    setViewSwitcherStack                    ,
#if defined(ENABLE_OVERLOADING)
    viewSwitcherStack                       ,
#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 {-# SOURCE #-} qualified GI.Adw.Enums as Adw.Enums
import {-# SOURCE #-} qualified GI.Adw.Objects.ViewStack as Adw.ViewStack
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

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

foreign import ccall "adw_view_switcher_get_type"
    c_adw_view_switcher_get_type :: IO B.Types.GType

instance B.Types.TypedObject ViewSwitcher where
    glibType :: IO GType
glibType = IO GType
c_adw_view_switcher_get_type

instance B.Types.GObject ViewSwitcher

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

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

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

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

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

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

#endif

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

#endif

-- VVV Prop "policy"
   -- Type: TInterface (Name {namespace = "Adw", name = "ViewSwitcherPolicy"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@policy@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' viewSwitcher #policy
-- @
getViewSwitcherPolicy :: (MonadIO m, IsViewSwitcher o) => o -> m Adw.Enums.ViewSwitcherPolicy
getViewSwitcherPolicy :: forall (m :: * -> *) o.
(MonadIO m, IsViewSwitcher o) =>
o -> m ViewSwitcherPolicy
getViewSwitcherPolicy o
obj = IO ViewSwitcherPolicy -> m ViewSwitcherPolicy
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ViewSwitcherPolicy -> m ViewSwitcherPolicy)
-> IO ViewSwitcherPolicy -> m ViewSwitcherPolicy
forall a b. (a -> b) -> a -> b
$ o -> String -> IO ViewSwitcherPolicy
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"policy"

-- | Set the value of the “@policy@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' viewSwitcher [ #policy 'Data.GI.Base.Attributes.:=' value ]
-- @
setViewSwitcherPolicy :: (MonadIO m, IsViewSwitcher o) => o -> Adw.Enums.ViewSwitcherPolicy -> m ()
setViewSwitcherPolicy :: forall (m :: * -> *) o.
(MonadIO m, IsViewSwitcher o) =>
o -> ViewSwitcherPolicy -> m ()
setViewSwitcherPolicy o
obj ViewSwitcherPolicy
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 -> ViewSwitcherPolicy -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"policy" ViewSwitcherPolicy
val

-- | Construct a `GValueConstruct` with valid value for the “@policy@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructViewSwitcherPolicy :: (IsViewSwitcher o, MIO.MonadIO m) => Adw.Enums.ViewSwitcherPolicy -> m (GValueConstruct o)
constructViewSwitcherPolicy :: forall o (m :: * -> *).
(IsViewSwitcher o, MonadIO m) =>
ViewSwitcherPolicy -> m (GValueConstruct o)
constructViewSwitcherPolicy ViewSwitcherPolicy
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 -> ViewSwitcherPolicy -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"policy" ViewSwitcherPolicy
val

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

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data ViewSwitcherStackPropertyInfo
instance AttrInfo ViewSwitcherStackPropertyInfo where
    type AttrAllowedOps ViewSwitcherStackPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ViewSwitcherStackPropertyInfo = IsViewSwitcher
    type AttrSetTypeConstraint ViewSwitcherStackPropertyInfo = Adw.ViewStack.IsViewStack
    type AttrTransferTypeConstraint ViewSwitcherStackPropertyInfo = Adw.ViewStack.IsViewStack
    type AttrTransferType ViewSwitcherStackPropertyInfo = Adw.ViewStack.ViewStack
    type AttrGetType ViewSwitcherStackPropertyInfo = (Maybe Adw.ViewStack.ViewStack)
    type AttrLabel ViewSwitcherStackPropertyInfo = "stack"
    type AttrOrigin ViewSwitcherStackPropertyInfo = ViewSwitcher
    attrGet = getViewSwitcherStack
    attrSet = setViewSwitcherStack
    attrTransfer _ v = do
        unsafeCastTo Adw.ViewStack.ViewStack v
    attrConstruct = constructViewSwitcherStack
    attrClear = clearViewSwitcherStack
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.ViewSwitcher.stack"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-ViewSwitcher.html#g:attr:stack"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ViewSwitcher
type instance O.AttributeList ViewSwitcher = ViewSwitcherAttributeList
type ViewSwitcherAttributeList = ('[ '("accessibleRole", Gtk.Accessible.AccessibleAccessibleRolePropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("policy", ViewSwitcherPolicyPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("stack", ViewSwitcherStackPropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
viewSwitcherPolicy :: AttrLabelProxy "policy"
viewSwitcherPolicy = AttrLabelProxy

viewSwitcherStack :: AttrLabelProxy "stack"
viewSwitcherStack = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ViewSwitcher = ViewSwitcherSignalList
type ViewSwitcherSignalList = ('[ '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

foreign import ccall "adw_view_switcher_new" adw_view_switcher_new :: 
    IO (Ptr ViewSwitcher)

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

#if defined(ENABLE_OVERLOADING)
#endif

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

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

-- | Gets the policy of /@self@/.
viewSwitcherGetPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewSwitcher a) =>
    a
    -- ^ /@self@/: a view switcher
    -> m Adw.Enums.ViewSwitcherPolicy
    -- ^ __Returns:__ the policy of /@self@/
viewSwitcherGetPolicy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewSwitcher a) =>
a -> m ViewSwitcherPolicy
viewSwitcherGetPolicy a
self = IO ViewSwitcherPolicy -> m ViewSwitcherPolicy
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ViewSwitcherPolicy -> m ViewSwitcherPolicy)
-> IO ViewSwitcherPolicy -> m ViewSwitcherPolicy
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewSwitcher
self' <- a -> IO (Ptr ViewSwitcher)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr ViewSwitcher -> IO CUInt
adw_view_switcher_get_policy Ptr ViewSwitcher
self'
    let result' :: ViewSwitcherPolicy
result' = (Int -> ViewSwitcherPolicy
forall a. Enum a => Int -> a
toEnum (Int -> ViewSwitcherPolicy)
-> (CUInt -> Int) -> CUInt -> ViewSwitcherPolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    ViewSwitcherPolicy -> IO ViewSwitcherPolicy
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ViewSwitcherPolicy
result'

#if defined(ENABLE_OVERLOADING)
data ViewSwitcherGetPolicyMethodInfo
instance (signature ~ (m Adw.Enums.ViewSwitcherPolicy), MonadIO m, IsViewSwitcher a) => O.OverloadedMethod ViewSwitcherGetPolicyMethodInfo a signature where
    overloadedMethod = viewSwitcherGetPolicy

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


#endif

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

foreign import ccall "adw_view_switcher_get_stack" adw_view_switcher_get_stack :: 
    Ptr ViewSwitcher ->                     -- self : TInterface (Name {namespace = "Adw", name = "ViewSwitcher"})
    IO (Ptr Adw.ViewStack.ViewStack)

-- | Gets the stack controlled by /@self@/.
viewSwitcherGetStack ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewSwitcher a) =>
    a
    -- ^ /@self@/: a view switcher
    -> m (Maybe Adw.ViewStack.ViewStack)
    -- ^ __Returns:__ the stack
viewSwitcherGetStack :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewSwitcher a) =>
a -> m (Maybe ViewStack)
viewSwitcherGetStack a
self = IO (Maybe ViewStack) -> m (Maybe ViewStack)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ViewStack) -> m (Maybe ViewStack))
-> IO (Maybe ViewStack) -> m (Maybe ViewStack)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ViewSwitcher
self' <- a -> IO (Ptr ViewSwitcher)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ViewStack
result <- Ptr ViewSwitcher -> IO (Ptr ViewStack)
adw_view_switcher_get_stack Ptr ViewSwitcher
self'
    Maybe ViewStack
maybeResult <- Ptr ViewStack
-> (Ptr ViewStack -> IO ViewStack) -> IO (Maybe ViewStack)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ViewStack
result ((Ptr ViewStack -> IO ViewStack) -> IO (Maybe ViewStack))
-> (Ptr ViewStack -> IO ViewStack) -> IO (Maybe ViewStack)
forall a b. (a -> b) -> a -> b
$ \Ptr ViewStack
result' -> do
        ViewStack
result'' <- ((ManagedPtr ViewStack -> ViewStack)
-> Ptr ViewStack -> IO ViewStack
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ViewStack -> ViewStack
Adw.ViewStack.ViewStack) Ptr ViewStack
result'
        ViewStack -> IO ViewStack
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ViewStack
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ViewStack -> IO (Maybe ViewStack)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ViewStack
maybeResult

#if defined(ENABLE_OVERLOADING)
data ViewSwitcherGetStackMethodInfo
instance (signature ~ (m (Maybe Adw.ViewStack.ViewStack)), MonadIO m, IsViewSwitcher a) => O.OverloadedMethod ViewSwitcherGetStackMethodInfo a signature where
    overloadedMethod = viewSwitcherGetStack

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


#endif

-- method ViewSwitcher::set_policy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "ViewSwitcher" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a view switcher" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "policy"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "ViewSwitcherPolicy" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new policy" , 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_switcher_set_policy" adw_view_switcher_set_policy :: 
    Ptr ViewSwitcher ->                     -- self : TInterface (Name {namespace = "Adw", name = "ViewSwitcher"})
    CUInt ->                                -- policy : TInterface (Name {namespace = "Adw", name = "ViewSwitcherPolicy"})
    IO ()

-- | Sets the policy of /@self@/.
viewSwitcherSetPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewSwitcher a) =>
    a
    -- ^ /@self@/: a view switcher
    -> Adw.Enums.ViewSwitcherPolicy
    -- ^ /@policy@/: the new policy
    -> m ()
viewSwitcherSetPolicy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewSwitcher a) =>
a -> ViewSwitcherPolicy -> m ()
viewSwitcherSetPolicy a
self ViewSwitcherPolicy
policy = 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 ViewSwitcher
self' <- a -> IO (Ptr ViewSwitcher)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let policy' :: CUInt
policy' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (ViewSwitcherPolicy -> Int) -> ViewSwitcherPolicy -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewSwitcherPolicy -> Int
forall a. Enum a => a -> Int
fromEnum) ViewSwitcherPolicy
policy
    Ptr ViewSwitcher -> CUInt -> IO ()
adw_view_switcher_set_policy Ptr ViewSwitcher
self' CUInt
policy'
    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 ViewSwitcherSetPolicyMethodInfo
instance (signature ~ (Adw.Enums.ViewSwitcherPolicy -> m ()), MonadIO m, IsViewSwitcher a) => O.OverloadedMethod ViewSwitcherSetPolicyMethodInfo a signature where
    overloadedMethod = viewSwitcherSetPolicy

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


#endif

-- method ViewSwitcher::set_stack
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "ViewSwitcher" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a view switcher" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stack"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "ViewStack" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a stack" , 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_switcher_set_stack" adw_view_switcher_set_stack :: 
    Ptr ViewSwitcher ->                     -- self : TInterface (Name {namespace = "Adw", name = "ViewSwitcher"})
    Ptr Adw.ViewStack.ViewStack ->          -- stack : TInterface (Name {namespace = "Adw", name = "ViewStack"})
    IO ()

-- | Sets the stack controlled by /@self@/.
viewSwitcherSetStack ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewSwitcher a, Adw.ViewStack.IsViewStack b) =>
    a
    -- ^ /@self@/: a view switcher
    -> Maybe (b)
    -- ^ /@stack@/: a stack
    -> m ()
viewSwitcherSetStack :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsViewSwitcher a, IsViewStack b) =>
a -> Maybe b -> m ()
viewSwitcherSetStack a
self Maybe b
stack = 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 ViewSwitcher
self' <- a -> IO (Ptr ViewSwitcher)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ViewStack
maybeStack <- case Maybe b
stack of
        Maybe b
Nothing -> Ptr ViewStack -> IO (Ptr ViewStack)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ViewStack
forall a. Ptr a
nullPtr
        Just b
jStack -> do
            Ptr ViewStack
jStack' <- b -> IO (Ptr ViewStack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jStack
            Ptr ViewStack -> IO (Ptr ViewStack)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ViewStack
jStack'
    Ptr ViewSwitcher -> Ptr ViewStack -> IO ()
adw_view_switcher_set_stack Ptr ViewSwitcher
self' Ptr ViewStack
maybeStack
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
stack b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ViewSwitcherSetStackMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsViewSwitcher a, Adw.ViewStack.IsViewStack b) => O.OverloadedMethod ViewSwitcherSetStackMethodInfo a signature where
    overloadedMethod = viewSwitcherSetStack

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


#endif