{-# LANGUAGE TypeApplications #-}


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

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

module GI.Handy.Objects.HeaderGroup
    ( 

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


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveHeaderGroupMethod                ,
#endif


-- ** addHeaderBar #method:addHeaderBar#

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


-- ** getFocus #method:getFocus#

#if defined(ENABLE_OVERLOADING)
    HeaderGroupGetFocusMethodInfo           ,
#endif
    headerGroupGetFocus                     ,


-- ** getHeaderBars #method:getHeaderBars#

#if defined(ENABLE_OVERLOADING)
    HeaderGroupGetHeaderBarsMethodInfo      ,
#endif
    headerGroupGetHeaderBars                ,


-- ** new #method:new#

    headerGroupNew                          ,


-- ** removeHeaderBar #method:removeHeaderBar#

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


-- ** setFocus #method:setFocus#

#if defined(ENABLE_OVERLOADING)
    HeaderGroupSetFocusMethodInfo           ,
#endif
    headerGroupSetFocus                     ,




 -- * Properties
-- ** focus #attr:focus#
-- | The the currently focused header bar. If 'P.Nothing', the decoration will be
-- spread as if the header bars of the group were only one, otherwise the
-- focused header bar will be the only one to receive the decoration.

#if defined(ENABLE_OVERLOADING)
    HeaderGroupFocusPropertyInfo            ,
#endif
    clearHeaderGroupFocus                   ,
    constructHeaderGroupFocus               ,
    getHeaderGroupFocus                     ,
#if defined(ENABLE_OVERLOADING)
    headerGroupFocus                        ,
#endif
    setHeaderGroupFocus                     ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified 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

-- | 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
/= :: HeaderGroup -> HeaderGroup -> Bool
$c/= :: HeaderGroup -> HeaderGroup -> Bool
== :: HeaderGroup -> HeaderGroup -> Bool
$c== :: 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

-- | Convert 'HeaderGroup' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue HeaderGroup where
    toGValue :: HeaderGroup -> IO GValue
toGValue HeaderGroup
o = do
        GType
gtype <- IO GType
c_hdy_header_group_get_type
        HeaderGroup -> (Ptr HeaderGroup -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr HeaderGroup
o (GType
-> (GValue -> Ptr HeaderGroup -> IO ())
-> Ptr HeaderGroup
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr HeaderGroup -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO HeaderGroup
fromGValue GValue
gv = do
        Ptr HeaderGroup
ptr <- GValue -> IO (Ptr HeaderGroup)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr HeaderGroup)
        (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
        
    

-- | 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 :: (MonadIO m, IsHeaderGroup o) => o -> m HeaderGroup
toHeaderGroup :: o -> m HeaderGroup
toHeaderGroup = IO HeaderGroup -> m HeaderGroup
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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'
unsafeCastTo ManagedPtr HeaderGroup -> HeaderGroup
HeaderGroup

#if defined(ENABLE_OVERLOADING)
type family ResolveHeaderGroupMethod (t :: Symbol) (o :: *) :: * where
    ResolveHeaderGroupMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveHeaderGroupMethod "addHeaderBar" o = HeaderGroupAddHeaderBarMethodInfo
    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 "removeHeaderBar" o = HeaderGroupRemoveHeaderBarMethodInfo
    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 "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveHeaderGroupMethod "getFocus" o = HeaderGroupGetFocusMethodInfo
    ResolveHeaderGroupMethod "getHeaderBars" o = HeaderGroupGetHeaderBarsMethodInfo
    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 "setFocus" o = HeaderGroupSetFocusMethodInfo
    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.MethodInfo 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

#endif

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

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

-- | Set the value of the “@focus@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' headerGroup [ #focus 'Data.GI.Base.Attributes.:=' value ]
-- @
setHeaderGroupFocus :: (MonadIO m, IsHeaderGroup o, Gtk.HeaderBar.IsHeaderBar a) => o -> a -> m ()
setHeaderGroupFocus :: o -> a -> m ()
setHeaderGroupFocus o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"focus" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

-- | Set the value of the “@focus@” 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' #focus
-- @
clearHeaderGroupFocus :: (MonadIO m, IsHeaderGroup o) => o -> m ()
clearHeaderGroupFocus :: o -> m ()
clearHeaderGroupFocus o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe HeaderBar -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"focus" (Maybe HeaderBar
forall a. Maybe a
Nothing :: Maybe Gtk.HeaderBar.HeaderBar)

#if defined(ENABLE_OVERLOADING)
data HeaderGroupFocusPropertyInfo
instance AttrInfo HeaderGroupFocusPropertyInfo where
    type AttrAllowedOps HeaderGroupFocusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint HeaderGroupFocusPropertyInfo = IsHeaderGroup
    type AttrSetTypeConstraint HeaderGroupFocusPropertyInfo = Gtk.HeaderBar.IsHeaderBar
    type AttrTransferTypeConstraint HeaderGroupFocusPropertyInfo = Gtk.HeaderBar.IsHeaderBar
    type AttrTransferType HeaderGroupFocusPropertyInfo = Gtk.HeaderBar.HeaderBar
    type AttrGetType HeaderGroupFocusPropertyInfo = (Maybe Gtk.HeaderBar.HeaderBar)
    type AttrLabel HeaderGroupFocusPropertyInfo = "focus"
    type AttrOrigin HeaderGroupFocusPropertyInfo = HeaderGroup
    attrGet = getHeaderGroupFocus
    attrSet = setHeaderGroupFocus
    attrTransfer _ v = do
        unsafeCastTo Gtk.HeaderBar.HeaderBar v
    attrConstruct = constructHeaderGroupFocus
    attrClear = clearHeaderGroupFocus
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList HeaderGroup
type instance O.AttributeList HeaderGroup = HeaderGroupAttributeList
type HeaderGroupAttributeList = ('[ '("focus", HeaderGroupFocusPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
headerGroupFocus :: AttrLabelProxy "focus"
headerGroupFocus = AttrLabelProxy

#endif

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

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

-- | /No description available in the introspection data./
headerGroupNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m HeaderGroup
headerGroupNew :: m HeaderGroup
headerGroupNew  = IO HeaderGroup -> m HeaderGroup
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 (m :: * -> *) a. Monad m => a -> m a
return HeaderGroup
result'

#if defined(ENABLE_OVERLOADING)
#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 #HdyHeaderGroup" , 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 #GtkHeaderBar 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 Gtk.HeaderBar.HeaderBar ->          -- header_bar : TInterface (Name {namespace = "Gtk", name = "HeaderBar"})
    IO ()

-- | Adds a header bar to a t'GI.Handy.Objects.HeaderGroup.HeaderGroup'. The decoration layout of the
-- widgets will be edited depending on their position in the composite header
-- bar, the start widget displaying only the start of the user\'s decoration
-- layout and the end widget displaying only its end while widgets in the middle
-- won\'t display anything. A header bar can be set as having the focus to
-- display all the decorations. See 'GI.Gtk.Objects.HeaderBar.headerBarSetDecorationLayout'.
-- 
-- When the widget is destroyed or no longer referenced elsewhere, it will
-- be removed from the header group.
headerGroupAddHeaderBar ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a, Gtk.HeaderBar.IsHeaderBar b) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.HeaderGroup.HeaderGroup'
    -> b
    -- ^ /@headerBar@/: the t'GI.Gtk.Objects.HeaderBar.HeaderBar' to add
    -> m ()
headerGroupAddHeaderBar :: a -> b -> m ()
headerGroupAddHeaderBar a
self b
headerBar = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

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

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

-- | /No description available in the introspection data./
headerGroupGetFocus ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.HeaderGroup.HeaderGroup'
    -> m (Maybe Gtk.HeaderBar.HeaderBar)
    -- ^ __Returns:__ The currently focused header bar
headerGroupGetFocus :: a -> m (Maybe HeaderBar)
headerGroupGetFocus a
self = IO (Maybe HeaderBar) -> m (Maybe HeaderBar)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe HeaderBar) -> m (Maybe HeaderBar))
-> IO (Maybe HeaderBar) -> m (Maybe HeaderBar)
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
result <- Ptr HeaderGroup -> IO (Ptr HeaderBar)
hdy_header_group_get_focus Ptr HeaderGroup
self'
    Maybe HeaderBar
maybeResult <- Ptr HeaderBar
-> (Ptr HeaderBar -> IO HeaderBar) -> IO (Maybe HeaderBar)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr HeaderBar
result ((Ptr HeaderBar -> IO HeaderBar) -> IO (Maybe HeaderBar))
-> (Ptr HeaderBar -> IO HeaderBar) -> IO (Maybe HeaderBar)
forall a b. (a -> b) -> a -> b
$ \Ptr HeaderBar
result' -> do
        HeaderBar
result'' <- ((ManagedPtr HeaderBar -> HeaderBar)
-> Ptr HeaderBar -> IO HeaderBar
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr HeaderBar -> HeaderBar
Gtk.HeaderBar.HeaderBar) Ptr HeaderBar
result'
        HeaderBar -> IO HeaderBar
forall (m :: * -> *) a. Monad m => a -> m a
return HeaderBar
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe HeaderBar -> IO (Maybe HeaderBar)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe HeaderBar
maybeResult

#if defined(ENABLE_OVERLOADING)
data HeaderGroupGetFocusMethodInfo
instance (signature ~ (m (Maybe Gtk.HeaderBar.HeaderBar)), MonadIO m, IsHeaderGroup a) => O.MethodInfo HeaderGroupGetFocusMethodInfo a signature where
    overloadedMethod = headerGroupGetFocus

#endif

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

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

-- | Returns the list of headerbars associated with /@self@/.
headerGroupGetHeaderBars ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.HeaderGroup.HeaderGroup'
    -> m [Gtk.HeaderBar.HeaderBar]
    -- ^ __Returns:__ a t'GI.GLib.Structs.SList.SList' of
    --   headerbars. The list is owned by libhandy and should not be modified.
headerGroupGetHeaderBars :: a -> m [HeaderBar]
headerGroupGetHeaderBars a
self = IO [HeaderBar] -> m [HeaderBar]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [HeaderBar] -> m [HeaderBar])
-> IO [HeaderBar] -> m [HeaderBar]
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 HeaderBar))
result <- Ptr HeaderGroup -> IO (Ptr (GSList (Ptr HeaderBar)))
hdy_header_group_get_header_bars Ptr HeaderGroup
self'
    [Ptr HeaderBar]
result' <- Ptr (GSList (Ptr HeaderBar)) -> IO [Ptr HeaderBar]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr HeaderBar))
result
    [HeaderBar]
result'' <- (Ptr HeaderBar -> IO HeaderBar)
-> [Ptr HeaderBar] -> IO [HeaderBar]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr HeaderBar -> HeaderBar)
-> Ptr HeaderBar -> IO HeaderBar
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr HeaderBar -> HeaderBar
Gtk.HeaderBar.HeaderBar) [Ptr HeaderBar]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [HeaderBar] -> IO [HeaderBar]
forall (m :: * -> *) a. Monad m => a -> m a
return [HeaderBar]
result''

#if defined(ENABLE_OVERLOADING)
data HeaderGroupGetHeaderBarsMethodInfo
instance (signature ~ (m [Gtk.HeaderBar.HeaderBar]), MonadIO m, IsHeaderGroup a) => O.MethodInfo HeaderGroupGetHeaderBarsMethodInfo a signature where
    overloadedMethod = headerGroupGetHeaderBars

#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 #HdyHeaderGroup" , 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 #GtkHeaderBar 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 Gtk.HeaderBar.HeaderBar ->          -- header_bar : TInterface (Name {namespace = "Gtk", name = "HeaderBar"})
    IO ()

-- | Removes a widget from a t'GI.Handy.Objects.HeaderGroup.HeaderGroup'
headerGroupRemoveHeaderBar ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a, Gtk.HeaderBar.IsHeaderBar b) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.HeaderGroup.HeaderGroup'
    -> b
    -- ^ /@headerBar@/: the t'GI.Gtk.Objects.HeaderBar.HeaderBar' to remove
    -> m ()
headerGroupRemoveHeaderBar :: a -> b -> m ()
headerGroupRemoveHeaderBar a
self b
headerBar = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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 (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- method HeaderGroup::set_focus
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Handy" , name = "HeaderGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #HdyHeaderGroup" , 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 = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkHeaderBar of @self, or %NULL"
--                 , 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_focus" hdy_header_group_set_focus :: 
    Ptr HeaderGroup ->                      -- self : TInterface (Name {namespace = "Handy", name = "HeaderGroup"})
    Ptr Gtk.HeaderBar.HeaderBar ->          -- header_bar : TInterface (Name {namespace = "Gtk", name = "HeaderBar"})
    IO ()

-- | Sets the the currently focused header bar. If /@headerBar@/ is 'P.Nothing', the
-- decoration will be spread as if the header bars of the group were only one,
-- otherwise /@headerBar@/ will be the only one to receive the decoration.
headerGroupSetFocus ::
    (B.CallStack.HasCallStack, MonadIO m, IsHeaderGroup a, Gtk.HeaderBar.IsHeaderBar b) =>
    a
    -- ^ /@self@/: a t'GI.Handy.Objects.HeaderGroup.HeaderGroup'
    -> Maybe (b)
    -- ^ /@headerBar@/: a t'GI.Gtk.Objects.HeaderBar.HeaderBar' of /@self@/, or 'P.Nothing'
    -> m ()
headerGroupSetFocus :: a -> Maybe b -> m ()
headerGroupSetFocus a
self Maybe b
headerBar = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr HeaderGroup
self' <- a -> IO (Ptr HeaderGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr HeaderBar
maybeHeaderBar <- case Maybe b
headerBar of
        Maybe b
Nothing -> Ptr HeaderBar -> IO (Ptr HeaderBar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr HeaderBar
forall a. Ptr a
nullPtr
        Just b
jHeaderBar -> do
            Ptr HeaderBar
jHeaderBar' <- b -> IO (Ptr HeaderBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jHeaderBar
            Ptr HeaderBar -> IO (Ptr HeaderBar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr HeaderBar
jHeaderBar'
    Ptr HeaderGroup -> Ptr HeaderBar -> IO ()
hdy_header_group_set_focus Ptr HeaderGroup
self' Ptr HeaderBar
maybeHeaderBar
    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
headerBar b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data HeaderGroupSetFocusMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsHeaderGroup a, Gtk.HeaderBar.IsHeaderBar b) => O.MethodInfo HeaderGroupSetFocusMethodInfo a signature where
    overloadedMethod = headerGroupSetFocus

#endif