{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An object handling composite title bars.
-- 
-- The @HdyHeaderGroup@ object handles the header bars of a composite title bar.
-- It splits the window decoration across the header bars, giving the left side
-- of the decorations to the leftmost header bar, and the right side of the
-- decorations to the rightmost header bar. See
-- [method/@headerBar@/.set_decoration_layout].
-- 
-- The [property/@headerGroup@/:decorate-all] property can be used in conjunction
-- with [property/@leaflet@/:folded] when the title bar is split across the pages
-- of a [class/@leaflet@/] to automatically display the decorations on all the
-- pages when the leaflet is folded.
-- 
-- You can nest header groups, which is convenient when you nest leaflets too:
-- 
-- 
-- === /xml code/
-- ><object class="HdyHeaderGroup" id="inner_header_group">
-- >  <property name="decorate-all" bind-source="inner_leaflet" bind-property="folded" bind-flags="sync-create"/>
-- >  <headerbars>
-- >    <headerbar name="inner_header_bar_1"/>
-- >    <headerbar name="inner_header_bar_2"/>
-- >  </headerbars>
-- ></object>
-- ><object class="HdyHeaderGroup" id="outer_header_group">
-- >  <property name="decorate-all" bind-source="outer_leaflet" bind-property="folded" bind-flags="sync-create"/>
-- >  <headerbars>
-- >    <headerbar name="inner_header_group"/>
-- >    <headerbar name="outer_header_bar"/>
-- >  </headerbars>
-- ></object>
-- 
-- 
-- /Since: 1.0/

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

module GI.Handy.Objects.HeaderGroup
    ( 

-- * Exported types
    HeaderGroup(..)                         ,
    IsHeaderGroup                           ,
    toHeaderGroup                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addChild]("GI.Gtk.Interfaces.Buildable#g:method:addChild"), [addGtkHeaderBar]("GI.Handy.Objects.HeaderGroup#g:method:addGtkHeaderBar"), [addHeaderBar]("GI.Handy.Objects.HeaderGroup#g:method:addHeaderBar"), [addHeaderGroup]("GI.Handy.Objects.HeaderGroup#g:method:addHeaderGroup"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [constructChild]("GI.Gtk.Interfaces.Buildable#g:method:constructChild"), [customFinished]("GI.Gtk.Interfaces.Buildable#g:method:customFinished"), [customTagEnd]("GI.Gtk.Interfaces.Buildable#g:method:customTagEnd"), [customTagStart]("GI.Gtk.Interfaces.Buildable#g:method:customTagStart"), [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"), [parserFinished]("GI.Gtk.Interfaces.Buildable#g:method:parserFinished"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeChild]("GI.Handy.Objects.HeaderGroup#g:method:removeChild"), [removeGtkHeaderBar]("GI.Handy.Objects.HeaderGroup#g:method:removeGtkHeaderBar"), [removeHeaderBar]("GI.Handy.Objects.HeaderGroup#g:method:removeHeaderBar"), [removeHeaderGroup]("GI.Handy.Objects.HeaderGroup#g:method:removeHeaderGroup"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getChildren]("GI.Handy.Objects.HeaderGroup#g:method:getChildren"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDecorateAll]("GI.Handy.Objects.HeaderGroup#g:method:getDecorateAll"), [getInternalChild]("GI.Gtk.Interfaces.Buildable#g:method:getInternalChild"), [getName]("GI.Gtk.Interfaces.Buildable#g:method:getName"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setBuildableProperty]("GI.Gtk.Interfaces.Buildable#g:method:setBuildableProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDecorateAll]("GI.Handy.Objects.HeaderGroup#g:method:setDecorateAll"), [setName]("GI.Gtk.Interfaces.Buildable#g:method:setName"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveHeaderGroupMethod                ,
#endif

-- ** addGtkHeaderBar #method:addGtkHeaderBar#

#if defined(ENABLE_OVERLOADING)
    HeaderGroupAddGtkHeaderBarMethodInfo    ,
#endif
    headerGroupAddGtkHeaderBar              ,


-- ** addHeaderBar #method:addHeaderBar#

#if defined(ENABLE_OVERLOADING)
    HeaderGroupAddHeaderBarMethodInfo       ,
#endif
    headerGroupAddHeaderBar                 ,


-- ** addHeaderGroup #method:addHeaderGroup#

#if defined(ENABLE_OVERLOADING)
    HeaderGroupAddHeaderGroupMethodInfo     ,
#endif
    headerGroupAddHeaderGroup               ,


-- ** getChildren #method:getChildren#

#if defined(ENABLE_OVERLOADING)
    HeaderGroupGetChildrenMethodInfo        ,
#endif
    headerGroupGetChildren                  ,


-- ** getDecorateAll #method:getDecorateAll#

#if defined(ENABLE_OVERLOADING)
    HeaderGroupGetDecorateAllMethodInfo     ,
#endif
    headerGroupGetDecorateAll               ,


-- ** new #method:new#

    headerGroupNew                          ,


-- ** removeChild #method:removeChild#

#if defined(ENABLE_OVERLOADING)
    HeaderGroupRemoveChildMethodInfo        ,
#endif
    headerGroupRemoveChild                  ,


-- ** removeGtkHeaderBar #method:removeGtkHeaderBar#

#if defined(ENABLE_OVERLOADING)
    HeaderGroupRemoveGtkHeaderBarMethodInfo ,
#endif
    headerGroupRemoveGtkHeaderBar           ,


-- ** removeHeaderBar #method:removeHeaderBar#

#if defined(ENABLE_OVERLOADING)
    HeaderGroupRemoveHeaderBarMethodInfo    ,
#endif
    headerGroupRemoveHeaderBar              ,


-- ** removeHeaderGroup #method:removeHeaderGroup#

#if defined(ENABLE_OVERLOADING)
    HeaderGroupRemoveHeaderGroupMethodInfo  ,
#endif
    headerGroupRemoveHeaderGroup            ,


-- ** setDecorateAll #method:setDecorateAll#

#if defined(ENABLE_OVERLOADING)
    HeaderGroupSetDecorateAllMethodInfo     ,
#endif
    headerGroupSetDecorateAll               ,




 -- * Properties


-- ** decorateAll #attr:decorateAll#
-- | Whether the elements of the group should all receive the full decoration.
-- 
-- This is useful in conjunction with [property/@leaflet@/:folded] when the
-- leaflet contains the header bars of the group, as you want them all to
-- display the complete decoration when the leaflet is folded.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    HeaderGroupDecorateAllPropertyInfo      ,
#endif
    constructHeaderGroupDecorateAll         ,
    getHeaderGroupDecorateAll               ,
#if defined(ENABLE_OVERLOADING)
    headerGroupDecorateAll                  ,
#endif
    setHeaderGroupDecorateAll               ,




 -- * Signals


-- ** updateDecorationLayouts #signal:updateDecorationLayouts#

    HeaderGroupUpdateDecorationLayoutsCallback,
#if defined(ENABLE_OVERLOADING)
    HeaderGroupUpdateDecorationLayoutsSignalInfo,
#endif
    afterHeaderGroupUpdateDecorationLayouts ,
    onHeaderGroupUpdateDecorationLayouts    ,




    ) 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.Buildable as Gtk.Buildable
import qualified GI.Gtk.Objects.HeaderBar as Gtk.HeaderBar
import {-# SOURCE #-} qualified GI.Handy.Objects.HeaderBar as Handy.HeaderBar
import {-# SOURCE #-} qualified GI.Handy.Objects.HeaderGroupChild as Handy.HeaderGroupChild

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

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

foreign import ccall "hdy_header_group_get_type"
    c_hdy_header_group_get_type :: IO B.Types.GType

instance B.Types.TypedObject HeaderGroup where
    glibType :: IO GType
glibType = IO GType
c_hdy_header_group_get_type

instance B.Types.GObject HeaderGroup

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

instance O.HasParentTypes HeaderGroup
type instance O.ParentTypes HeaderGroup = '[GObject.Object.Object, Gtk.Buildable.Buildable]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveHeaderGroupMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveHeaderGroupMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveHeaderGroupMethod "addGtkHeaderBar" o = HeaderGroupAddGtkHeaderBarMethodInfo
    ResolveHeaderGroupMethod "addHeaderBar" o = HeaderGroupAddHeaderBarMethodInfo
    ResolveHeaderGroupMethod "addHeaderGroup" o = HeaderGroupAddHeaderGroupMethodInfo
    ResolveHeaderGroupMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveHeaderGroupMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveHeaderGroupMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveHeaderGroupMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveHeaderGroupMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveHeaderGroupMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveHeaderGroupMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveHeaderGroupMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveHeaderGroupMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveHeaderGroupMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveHeaderGroupMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveHeaderGroupMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveHeaderGroupMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveHeaderGroupMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveHeaderGroupMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveHeaderGroupMethod "removeChild" o = HeaderGroupRemoveChildMethodInfo
    ResolveHeaderGroupMethod "removeGtkHeaderBar" o = HeaderGroupRemoveGtkHeaderBarMethodInfo
    ResolveHeaderGroupMethod "removeHeaderBar" o = HeaderGroupRemoveHeaderBarMethodInfo
    ResolveHeaderGroupMethod "removeHeaderGroup" o = HeaderGroupRemoveHeaderGroupMethodInfo
    ResolveHeaderGroupMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveHeaderGroupMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveHeaderGroupMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveHeaderGroupMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveHeaderGroupMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveHeaderGroupMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveHeaderGroupMethod "getChildren" o = HeaderGroupGetChildrenMethodInfo
    ResolveHeaderGroupMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveHeaderGroupMethod "getDecorateAll" o = HeaderGroupGetDecorateAllMethodInfo
    ResolveHeaderGroupMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveHeaderGroupMethod "getName" o = Gtk.Buildable.BuildableGetNameMethodInfo
    ResolveHeaderGroupMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveHeaderGroupMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveHeaderGroupMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveHeaderGroupMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveHeaderGroupMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveHeaderGroupMethod "setDecorateAll" o = HeaderGroupSetDecorateAllMethodInfo
    ResolveHeaderGroupMethod "setName" o = Gtk.Buildable.BuildableSetNameMethodInfo
    ResolveHeaderGroupMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveHeaderGroupMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal HeaderGroup::update-decoration-layouts
-- | This signal is emitted before updating the decoration layouts.
-- 
-- /Since: 1.0/
type HeaderGroupUpdateDecorationLayoutsCallback =
    IO ()

type C_HeaderGroupUpdateDecorationLayoutsCallback =
    Ptr HeaderGroup ->                      -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_HeaderGroupUpdateDecorationLayoutsCallback`.
foreign import ccall "wrapper"
    mk_HeaderGroupUpdateDecorationLayoutsCallback :: C_HeaderGroupUpdateDecorationLayoutsCallback -> IO (FunPtr C_HeaderGroupUpdateDecorationLayoutsCallback)

wrap_HeaderGroupUpdateDecorationLayoutsCallback :: 
    GObject a => (a -> HeaderGroupUpdateDecorationLayoutsCallback) ->
    C_HeaderGroupUpdateDecorationLayoutsCallback
wrap_HeaderGroupUpdateDecorationLayoutsCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_HeaderGroupUpdateDecorationLayoutsCallback
wrap_HeaderGroupUpdateDecorationLayoutsCallback a -> IO ()
gi'cb Ptr HeaderGroup
gi'selfPtr Ptr ()
_ = do
    Ptr HeaderGroup -> (HeaderGroup -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr HeaderGroup
gi'selfPtr ((HeaderGroup -> IO ()) -> IO ())
-> (HeaderGroup -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HeaderGroup
gi'self -> a -> IO ()
gi'cb (HeaderGroup -> a
forall a b. Coercible a b => a -> b
Coerce.coerce HeaderGroup
gi'self) 


-- | Connect a signal handler for the [updateDecorationLayouts](#signal:updateDecorationLayouts) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' headerGroup #updateDecorationLayouts callback
-- @
-- 
-- 
onHeaderGroupUpdateDecorationLayouts :: (IsHeaderGroup a, MonadIO m) => a -> ((?self :: a) => HeaderGroupUpdateDecorationLayoutsCallback) -> m SignalHandlerId
onHeaderGroupUpdateDecorationLayouts :: forall a (m :: * -> *).
(IsHeaderGroup a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onHeaderGroupUpdateDecorationLayouts a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_HeaderGroupUpdateDecorationLayoutsCallback
wrapped' = (a -> IO ()) -> C_HeaderGroupUpdateDecorationLayoutsCallback
forall a.
GObject a =>
(a -> IO ()) -> C_HeaderGroupUpdateDecorationLayoutsCallback
wrap_HeaderGroupUpdateDecorationLayoutsCallback a -> IO ()
wrapped
    FunPtr C_HeaderGroupUpdateDecorationLayoutsCallback
wrapped'' <- C_HeaderGroupUpdateDecorationLayoutsCallback
-> IO (FunPtr C_HeaderGroupUpdateDecorationLayoutsCallback)
mk_HeaderGroupUpdateDecorationLayoutsCallback C_HeaderGroupUpdateDecorationLayoutsCallback
wrapped'
    a
-> Text
-> FunPtr C_HeaderGroupUpdateDecorationLayoutsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"update-decoration-layouts" FunPtr C_HeaderGroupUpdateDecorationLayoutsCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [updateDecorationLayouts](#signal:updateDecorationLayouts) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' headerGroup #updateDecorationLayouts callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterHeaderGroupUpdateDecorationLayouts :: (IsHeaderGroup a, MonadIO m) => a -> ((?self :: a) => HeaderGroupUpdateDecorationLayoutsCallback) -> m SignalHandlerId
afterHeaderGroupUpdateDecorationLayouts :: forall a (m :: * -> *).
(IsHeaderGroup a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterHeaderGroupUpdateDecorationLayouts a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_HeaderGroupUpdateDecorationLayoutsCallback
wrapped' = (a -> IO ()) -> C_HeaderGroupUpdateDecorationLayoutsCallback
forall a.
GObject a =>
(a -> IO ()) -> C_HeaderGroupUpdateDecorationLayoutsCallback
wrap_HeaderGroupUpdateDecorationLayoutsCallback a -> IO ()
wrapped
    FunPtr C_HeaderGroupUpdateDecorationLayoutsCallback
wrapped'' <- C_HeaderGroupUpdateDecorationLayoutsCallback
-> IO (FunPtr C_HeaderGroupUpdateDecorationLayoutsCallback)
mk_HeaderGroupUpdateDecorationLayoutsCallback C_HeaderGroupUpdateDecorationLayoutsCallback
wrapped'
    a
-> Text
-> FunPtr C_HeaderGroupUpdateDecorationLayoutsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"update-decoration-layouts" FunPtr C_HeaderGroupUpdateDecorationLayoutsCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data HeaderGroupUpdateDecorationLayoutsSignalInfo
instance SignalInfo HeaderGroupUpdateDecorationLayoutsSignalInfo where
    type HaskellCallbackType HeaderGroupUpdateDecorationLayoutsSignalInfo = HeaderGroupUpdateDecorationLayoutsCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_HeaderGroupUpdateDecorationLayoutsCallback cb
        cb'' <- mk_HeaderGroupUpdateDecorationLayoutsCallback cb'
        connectSignalFunPtr obj "update-decoration-layouts" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.HeaderGroup::update-decoration-layouts"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.4/docs/GI-Handy-Objects-HeaderGroup.html#g:signal:updateDecorationLayouts"})

#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data HeaderGroupDecorateAllPropertyInfo
instance AttrInfo HeaderGroupDecorateAllPropertyInfo where
    type AttrAllowedOps HeaderGroupDecorateAllPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint HeaderGroupDecorateAllPropertyInfo = IsHeaderGroup
    type AttrSetTypeConstraint HeaderGroupDecorateAllPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint HeaderGroupDecorateAllPropertyInfo = (~) Bool
    type AttrTransferType HeaderGroupDecorateAllPropertyInfo = Bool
    type AttrGetType HeaderGroupDecorateAllPropertyInfo = Bool
    type AttrLabel HeaderGroupDecorateAllPropertyInfo = "decorate-all"
    type AttrOrigin HeaderGroupDecorateAllPropertyInfo = HeaderGroup
    attrGet = getHeaderGroupDecorateAll
    attrSet = setHeaderGroupDecorateAll
    attrTransfer _ v = do
        return v
    attrConstruct = constructHeaderGroupDecorateAll
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.HeaderGroup.decorateAll"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.4/docs/GI-Handy-Objects-HeaderGroup.html#g:attr:decorateAll"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList HeaderGroup
type instance O.AttributeList HeaderGroup = HeaderGroupAttributeList
type HeaderGroupAttributeList = ('[ '("decorateAll", HeaderGroupDecorateAllPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
headerGroupDecorateAll :: AttrLabelProxy "decorateAll"
headerGroupDecorateAll = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "hdy_header_group_new" hdy_header_group_new :: 
    IO (Ptr HeaderGroup)

-- | Creates a new @HdyHeaderGroup@.
-- 
-- /Since: 1.0/
headerGroupNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m HeaderGroup
    -- ^ __Returns:__ the newly created @HdyHeaderGroup@
headerGroupNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m HeaderGroup
headerGroupNew  = IO HeaderGroup -> m HeaderGroup
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HeaderGroup -> m HeaderGroup)
-> IO HeaderGroup -> m HeaderGroup
forall a b. (a -> b) -> a -> b
$ do
    Ptr HeaderGroup
result <- IO (Ptr HeaderGroup)
hdy_header_group_new
    Text -> Ptr HeaderGroup -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"headerGroupNew" Ptr HeaderGroup
result
    HeaderGroup
result' <- ((ManagedPtr HeaderGroup -> HeaderGroup)
-> Ptr HeaderGroup -> IO HeaderGroup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr HeaderGroup -> HeaderGroup
HeaderGroup) Ptr HeaderGroup
result
    HeaderGroup -> IO HeaderGroup
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HeaderGroup
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method HeaderGroup::add_gtk_header_bar
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "HeaderGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a header group" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "header_bar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "HeaderBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the header bar to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "hdy_header_group_add_gtk_header_bar" hdy_header_group_add_gtk_header_bar :: 
    Ptr HeaderGroup ->                      -- self : TInterface (Name {namespace = "Handy", name = "HeaderGroup"})
    Ptr Gtk.HeaderBar.HeaderBar ->          -- header_bar : TInterface (Name {namespace = "Gtk", name = "HeaderBar"})
    IO ()

-- | Adds /@headerBar@/ to /@self@/.
-- 
-- When the widget is destroyed or no longer referenced elsewhere, it will be
-- removed from the header group.
-- 
-- /Since: 1.0/
headerGroupAddGtkHeaderBar ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a, Gtk.HeaderBar.IsHeaderBar b) =>
    a
    -- ^ /@self@/: a header group
    -> b
    -- ^ /@headerBar@/: the header bar to add
    -> m ()
headerGroupAddGtkHeaderBar :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsHeaderGroup a, IsHeaderBar b) =>
a -> b -> m ()
headerGroupAddGtkHeaderBar a
self b
headerBar = 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 HeaderGroup
self' <- a -> IO (Ptr HeaderGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr HeaderBar
headerBar' <- b -> IO (Ptr HeaderBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
headerBar
    Ptr HeaderGroup -> Ptr HeaderBar -> IO ()
hdy_header_group_add_gtk_header_bar Ptr HeaderGroup
self' Ptr HeaderBar
headerBar'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
headerBar
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HeaderGroupAddGtkHeaderBarMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsHeaderGroup a, Gtk.HeaderBar.IsHeaderBar b) => O.OverloadedMethod HeaderGroupAddGtkHeaderBarMethodInfo a signature where
    overloadedMethod = headerGroupAddGtkHeaderBar

instance O.OverloadedMethodInfo HeaderGroupAddGtkHeaderBarMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.HeaderGroup.headerGroupAddGtkHeaderBar",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.4/docs/GI-Handy-Objects-HeaderGroup.html#v:headerGroupAddGtkHeaderBar"
        })


#endif

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

foreign import ccall "hdy_header_group_add_header_bar" hdy_header_group_add_header_bar :: 
    Ptr HeaderGroup ->                      -- self : TInterface (Name {namespace = "Handy", name = "HeaderGroup"})
    Ptr Handy.HeaderBar.HeaderBar ->        -- header_bar : TInterface (Name {namespace = "Handy", name = "HeaderBar"})
    IO ()

-- | Adds /@headerBar@/ to /@self@/.
-- 
-- When the widget is destroyed or no longer referenced elsewhere, it will be
-- removed from the header group.
-- 
-- /Since: 1.0/
headerGroupAddHeaderBar ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a, Handy.HeaderBar.IsHeaderBar b) =>
    a
    -- ^ /@self@/: a header group
    -> b
    -- ^ /@headerBar@/: the header bar to add
    -> m ()
headerGroupAddHeaderBar :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsHeaderGroup a, IsHeaderBar b) =>
a -> b -> m ()
headerGroupAddHeaderBar a
self b
headerBar = 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 HeaderGroup
self' <- a -> IO (Ptr HeaderGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr HeaderBar
headerBar' <- b -> IO (Ptr HeaderBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
headerBar
    Ptr HeaderGroup -> Ptr HeaderBar -> IO ()
hdy_header_group_add_header_bar Ptr HeaderGroup
self' Ptr HeaderBar
headerBar'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
headerBar
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HeaderGroupAddHeaderBarMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsHeaderGroup a, Handy.HeaderBar.IsHeaderBar b) => O.OverloadedMethod HeaderGroupAddHeaderBarMethodInfo a signature where
    overloadedMethod = headerGroupAddHeaderBar

instance O.OverloadedMethodInfo HeaderGroupAddHeaderBarMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.HeaderGroup.headerGroupAddHeaderBar",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.4/docs/GI-Handy-Objects-HeaderGroup.html#v:headerGroupAddHeaderBar"
        })


#endif

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

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

-- | Adds /@headerGroup@/ to /@self@/.
-- 
-- When the nested group is no longer referenced elsewhere, it will be removed
-- from the header group.
-- 
-- /Since: 1.0/
headerGroupAddHeaderGroup ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a, IsHeaderGroup b) =>
    a
    -- ^ /@self@/: a header group
    -> b
    -- ^ /@headerGroup@/: the header group to add
    -> m ()
headerGroupAddHeaderGroup :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsHeaderGroup a, IsHeaderGroup b) =>
a -> b -> m ()
headerGroupAddHeaderGroup a
self b
headerGroup = 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 HeaderGroup
self' <- a -> IO (Ptr HeaderGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr HeaderGroup
headerGroup' <- b -> IO (Ptr HeaderGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
headerGroup
    Ptr HeaderGroup -> Ptr HeaderGroup -> IO ()
hdy_header_group_add_header_group Ptr HeaderGroup
self' Ptr HeaderGroup
headerGroup'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
headerGroup
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HeaderGroupAddHeaderGroupMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsHeaderGroup a, IsHeaderGroup b) => O.OverloadedMethod HeaderGroupAddHeaderGroupMethodInfo a signature where
    overloadedMethod = headerGroupAddHeaderGroup

instance O.OverloadedMethodInfo HeaderGroupAddHeaderGroupMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.HeaderGroup.headerGroupAddHeaderGroup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.4/docs/GI-Handy-Objects-HeaderGroup.html#v:headerGroupAddHeaderGroup"
        })


#endif

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

foreign import ccall "hdy_header_group_get_children" hdy_header_group_get_children :: 
    Ptr HeaderGroup ->                      -- self : TInterface (Name {namespace = "Handy", name = "HeaderGroup"})
    IO (Ptr (GSList (Ptr Handy.HeaderGroupChild.HeaderGroupChild)))

-- | Returns the list of children associated with /@self@/.
-- 
-- /Since: 1.0/
headerGroupGetChildren ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a) =>
    a
    -- ^ /@self@/: a header group
    -> m [Handy.HeaderGroupChild.HeaderGroupChild]
    -- ^ __Returns:__ the list of
    --   children
headerGroupGetChildren :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHeaderGroup a) =>
a -> m [HeaderGroupChild]
headerGroupGetChildren a
self = IO [HeaderGroupChild] -> m [HeaderGroupChild]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [HeaderGroupChild] -> m [HeaderGroupChild])
-> IO [HeaderGroupChild] -> m [HeaderGroupChild]
forall a b. (a -> b) -> a -> b
$ do
    Ptr HeaderGroup
self' <- a -> IO (Ptr HeaderGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr (GSList (Ptr HeaderGroupChild))
result <- Ptr HeaderGroup -> IO (Ptr (GSList (Ptr HeaderGroupChild)))
hdy_header_group_get_children Ptr HeaderGroup
self'
    [Ptr HeaderGroupChild]
result' <- Ptr (GSList (Ptr HeaderGroupChild)) -> IO [Ptr HeaderGroupChild]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr HeaderGroupChild))
result
    [HeaderGroupChild]
result'' <- (Ptr HeaderGroupChild -> IO HeaderGroupChild)
-> [Ptr HeaderGroupChild] -> IO [HeaderGroupChild]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr HeaderGroupChild -> HeaderGroupChild)
-> Ptr HeaderGroupChild -> IO HeaderGroupChild
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr HeaderGroupChild -> HeaderGroupChild
Handy.HeaderGroupChild.HeaderGroupChild) [Ptr HeaderGroupChild]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [HeaderGroupChild] -> IO [HeaderGroupChild]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [HeaderGroupChild]
result''

#if defined(ENABLE_OVERLOADING)
data HeaderGroupGetChildrenMethodInfo
instance (signature ~ (m [Handy.HeaderGroupChild.HeaderGroupChild]), MonadIO m, IsHeaderGroup a) => O.OverloadedMethod HeaderGroupGetChildrenMethodInfo a signature where
    overloadedMethod = headerGroupGetChildren

instance O.OverloadedMethodInfo HeaderGroupGetChildrenMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.HeaderGroup.headerGroupGetChildren",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.4/docs/GI-Handy-Objects-HeaderGroup.html#v:headerGroupGetChildren"
        })


#endif

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

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

-- | Gets whether the elements of the group should all receive the full
-- decoration.
-- 
-- /Since: 1.0/
headerGroupGetDecorateAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a) =>
    a
    -- ^ /@self@/: a header group
    -> m Bool
    -- ^ __Returns:__ whether the elements of the group should all receive the full
    --   decoration
headerGroupGetDecorateAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHeaderGroup a) =>
a -> m Bool
headerGroupGetDecorateAll 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 HeaderGroup
self' <- a -> IO (Ptr HeaderGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr HeaderGroup -> IO CInt
hdy_header_group_get_decorate_all Ptr HeaderGroup
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 HeaderGroupGetDecorateAllMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsHeaderGroup a) => O.OverloadedMethod HeaderGroupGetDecorateAllMethodInfo a signature where
    overloadedMethod = headerGroupGetDecorateAll

instance O.OverloadedMethodInfo HeaderGroupGetDecorateAllMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.HeaderGroup.headerGroupGetDecorateAll",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.4/docs/GI-Handy-Objects-HeaderGroup.html#v:headerGroupGetDecorateAll"
        })


#endif

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

foreign import ccall "hdy_header_group_remove_child" hdy_header_group_remove_child :: 
    Ptr HeaderGroup ->                      -- self : TInterface (Name {namespace = "Handy", name = "HeaderGroup"})
    Ptr Handy.HeaderGroupChild.HeaderGroupChild -> -- child : TInterface (Name {namespace = "Handy", name = "HeaderGroupChild"})
    IO ()

-- | Removes /@child@/ from /@self@/.
-- 
-- /Since: 1.0/
headerGroupRemoveChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a, Handy.HeaderGroupChild.IsHeaderGroupChild b) =>
    a
    -- ^ /@self@/: a header group
    -> b
    -- ^ /@child@/: the header group child to remove
    -> m ()
headerGroupRemoveChild :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsHeaderGroup a, IsHeaderGroupChild b) =>
a -> b -> m ()
headerGroupRemoveChild a
self b
child = 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 HeaderGroup
self' <- a -> IO (Ptr HeaderGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr HeaderGroupChild
child' <- b -> IO (Ptr HeaderGroupChild)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    Ptr HeaderGroup -> Ptr HeaderGroupChild -> IO ()
hdy_header_group_remove_child Ptr HeaderGroup
self' Ptr HeaderGroupChild
child'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HeaderGroupRemoveChildMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsHeaderGroup a, Handy.HeaderGroupChild.IsHeaderGroupChild b) => O.OverloadedMethod HeaderGroupRemoveChildMethodInfo a signature where
    overloadedMethod = headerGroupRemoveChild

instance O.OverloadedMethodInfo HeaderGroupRemoveChildMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.HeaderGroup.headerGroupRemoveChild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.4/docs/GI-Handy-Objects-HeaderGroup.html#v:headerGroupRemoveChild"
        })


#endif

-- method HeaderGroup::remove_gtk_header_bar
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "HeaderGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a header group" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "header_bar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "HeaderBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the header bar to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "hdy_header_group_remove_gtk_header_bar" hdy_header_group_remove_gtk_header_bar :: 
    Ptr HeaderGroup ->                      -- self : TInterface (Name {namespace = "Handy", name = "HeaderGroup"})
    Ptr Gtk.HeaderBar.HeaderBar ->          -- header_bar : TInterface (Name {namespace = "Gtk", name = "HeaderBar"})
    IO ()

-- | Removes /@headerBar@/ from /@self@/.
-- 
-- /Since: 1.0/
headerGroupRemoveGtkHeaderBar ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a, Gtk.HeaderBar.IsHeaderBar b) =>
    a
    -- ^ /@self@/: a header group
    -> b
    -- ^ /@headerBar@/: the header bar to remove
    -> m ()
headerGroupRemoveGtkHeaderBar :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsHeaderGroup a, IsHeaderBar b) =>
a -> b -> m ()
headerGroupRemoveGtkHeaderBar a
self b
headerBar = 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 HeaderGroup
self' <- a -> IO (Ptr HeaderGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr HeaderBar
headerBar' <- b -> IO (Ptr HeaderBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
headerBar
    Ptr HeaderGroup -> Ptr HeaderBar -> IO ()
hdy_header_group_remove_gtk_header_bar Ptr HeaderGroup
self' Ptr HeaderBar
headerBar'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
headerBar
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HeaderGroupRemoveGtkHeaderBarMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsHeaderGroup a, Gtk.HeaderBar.IsHeaderBar b) => O.OverloadedMethod HeaderGroupRemoveGtkHeaderBarMethodInfo a signature where
    overloadedMethod = headerGroupRemoveGtkHeaderBar

instance O.OverloadedMethodInfo HeaderGroupRemoveGtkHeaderBarMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.HeaderGroup.headerGroupRemoveGtkHeaderBar",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.4/docs/GI-Handy-Objects-HeaderGroup.html#v:headerGroupRemoveGtkHeaderBar"
        })


#endif

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

foreign import ccall "hdy_header_group_remove_header_bar" hdy_header_group_remove_header_bar :: 
    Ptr HeaderGroup ->                      -- self : TInterface (Name {namespace = "Handy", name = "HeaderGroup"})
    Ptr Handy.HeaderBar.HeaderBar ->        -- header_bar : TInterface (Name {namespace = "Handy", name = "HeaderBar"})
    IO ()

-- | Removes /@headerBar@/ from /@self@/.
-- 
-- /Since: 1.0/
headerGroupRemoveHeaderBar ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a, Handy.HeaderBar.IsHeaderBar b) =>
    a
    -- ^ /@self@/: a header group
    -> b
    -- ^ /@headerBar@/: the header bar to remove
    -> m ()
headerGroupRemoveHeaderBar :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsHeaderGroup a, IsHeaderBar b) =>
a -> b -> m ()
headerGroupRemoveHeaderBar a
self b
headerBar = 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 HeaderGroup
self' <- a -> IO (Ptr HeaderGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr HeaderBar
headerBar' <- b -> IO (Ptr HeaderBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
headerBar
    Ptr HeaderGroup -> Ptr HeaderBar -> IO ()
hdy_header_group_remove_header_bar Ptr HeaderGroup
self' Ptr HeaderBar
headerBar'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
headerBar
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HeaderGroupRemoveHeaderBarMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsHeaderGroup a, Handy.HeaderBar.IsHeaderBar b) => O.OverloadedMethod HeaderGroupRemoveHeaderBarMethodInfo a signature where
    overloadedMethod = headerGroupRemoveHeaderBar

instance O.OverloadedMethodInfo HeaderGroupRemoveHeaderBarMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.HeaderGroup.headerGroupRemoveHeaderBar",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.4/docs/GI-Handy-Objects-HeaderGroup.html#v:headerGroupRemoveHeaderBar"
        })


#endif

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

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

-- | Removes a nested @HdyHeaderGroup@ from /@self@/.
-- 
-- /Since: 1.0/
headerGroupRemoveHeaderGroup ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a, IsHeaderGroup b) =>
    a
    -- ^ /@self@/: a header group
    -> b
    -- ^ /@headerGroup@/: the header group to remove
    -> m ()
headerGroupRemoveHeaderGroup :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsHeaderGroup a, IsHeaderGroup b) =>
a -> b -> m ()
headerGroupRemoveHeaderGroup a
self b
headerGroup = 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 HeaderGroup
self' <- a -> IO (Ptr HeaderGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr HeaderGroup
headerGroup' <- b -> IO (Ptr HeaderGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
headerGroup
    Ptr HeaderGroup -> Ptr HeaderGroup -> IO ()
hdy_header_group_remove_header_group Ptr HeaderGroup
self' Ptr HeaderGroup
headerGroup'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
headerGroup
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HeaderGroupRemoveHeaderGroupMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsHeaderGroup a, IsHeaderGroup b) => O.OverloadedMethod HeaderGroupRemoveHeaderGroupMethodInfo a signature where
    overloadedMethod = headerGroupRemoveHeaderGroup

instance O.OverloadedMethodInfo HeaderGroupRemoveHeaderGroupMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.HeaderGroup.headerGroupRemoveHeaderGroup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.4/docs/GI-Handy-Objects-HeaderGroup.html#v:headerGroupRemoveHeaderGroup"
        })


#endif

-- method HeaderGroup::set_decorate_all
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "HeaderGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a header group" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "decorate_all"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether the elements of the group should all receive the full\n  decoration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "hdy_header_group_set_decorate_all" hdy_header_group_set_decorate_all :: 
    Ptr HeaderGroup ->                      -- self : TInterface (Name {namespace = "Handy", name = "HeaderGroup"})
    CInt ->                                 -- decorate_all : TBasicType TBoolean
    IO ()

-- | Sets whether the elements of the group should all receive the full
-- decoration.
-- 
-- /Since: 1.0/
headerGroupSetDecorateAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a) =>
    a
    -- ^ /@self@/: a header group
    -> Bool
    -- ^ /@decorateAll@/: whether the elements of the group should all receive the full
    --   decoration
    -> m ()
headerGroupSetDecorateAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsHeaderGroup a) =>
a -> Bool -> m ()
headerGroupSetDecorateAll a
self Bool
decorateAll = 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 HeaderGroup
self' <- a -> IO (Ptr HeaderGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let decorateAll' :: CInt
decorateAll' = (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
decorateAll
    Ptr HeaderGroup -> CInt -> IO ()
hdy_header_group_set_decorate_all Ptr HeaderGroup
self' CInt
decorateAll'
    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 HeaderGroupSetDecorateAllMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsHeaderGroup a) => O.OverloadedMethod HeaderGroupSetDecorateAllMethodInfo a signature where
    overloadedMethod = headerGroupSetDecorateAll

instance O.OverloadedMethodInfo HeaderGroupSetDecorateAllMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Handy.Objects.HeaderGroup.headerGroupSetDecorateAll",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-handy-1.0.4/docs/GI-Handy-Objects-HeaderGroup.html#v:headerGroupSetDecorateAll"
        })


#endif