{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The goal of t'GI.Dazzle.Objects.MenuManager.MenuManager' is to simplify the process of merging multiple
-- GtkBuilder .ui files containing menus into a single representation of the
-- application menus. Additionally, it provides the ability to \"unmerge\"
-- previously merged menus.
-- 
-- This allows for an application to have plugins which seemlessly extends
-- the core application menus.
-- 
-- Implementation notes:
-- 
-- To make this work, we don\'t use the GMenu instances created by a GtkBuilder
-- instance. Instead, we create the menus ourself and recreate section and
-- submenu links. This allows the t'GI.Dazzle.Objects.MenuManager.MenuManager' to be in full control of
-- the generated menus.
-- 
-- 'GI.Dazzle.Objects.MenuManager.menuManagerGetMenuById' will always return a t'GI.Gio.Objects.Menu.Menu', however
-- that menu may contain no children until something has extended it later
-- on during the application process.
-- 
-- /Since: 3.26/

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

module GI.Dazzle.Objects.MenuManager
    ( 

-- * Exported types
    MenuManager(..)                         ,
    IsMenuManager                           ,
    toMenuManager                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addFilename]("GI.Dazzle.Objects.MenuManager#g:method:addFilename"), [addResource]("GI.Dazzle.Objects.MenuManager#g:method:addResource"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [merge]("GI.Dazzle.Objects.MenuManager#g:method:merge"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [remove]("GI.Dazzle.Objects.MenuManager#g:method:remove"), [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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getMenuById]("GI.Dazzle.Objects.MenuManager#g:method:getMenuById"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveMenuManagerMethod                ,
#endif

-- ** addFilename #method:addFilename#

#if defined(ENABLE_OVERLOADING)
    MenuManagerAddFilenameMethodInfo        ,
#endif
    menuManagerAddFilename                  ,


-- ** addResource #method:addResource#

#if defined(ENABLE_OVERLOADING)
    MenuManagerAddResourceMethodInfo        ,
#endif
    menuManagerAddResource                  ,


-- ** getMenuById #method:getMenuById#

#if defined(ENABLE_OVERLOADING)
    MenuManagerGetMenuByIdMethodInfo        ,
#endif
    menuManagerGetMenuById                  ,


-- ** merge #method:merge#

#if defined(ENABLE_OVERLOADING)
    MenuManagerMergeMethodInfo              ,
#endif
    menuManagerMerge                        ,


-- ** new #method:new#

    menuManagerNew                          ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    MenuManagerRemoveMethodInfo             ,
#endif
    menuManagerRemove                       ,




    ) 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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Objects.Menu as Gio.Menu
import qualified GI.Gio.Objects.MenuModel as Gio.MenuModel

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Objects.Menu as Gio.Menu
import qualified GI.Gio.Objects.MenuModel as Gio.MenuModel

#endif

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

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

foreign import ccall "dzl_menu_manager_get_type"
    c_dzl_menu_manager_get_type :: IO B.Types.GType

instance B.Types.TypedObject MenuManager where
    glibType :: IO GType
glibType = IO GType
c_dzl_menu_manager_get_type

instance B.Types.GObject MenuManager

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

instance O.HasParentTypes MenuManager
type instance O.ParentTypes MenuManager = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveMenuManagerMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveMenuManagerMethod "addFilename" o = MenuManagerAddFilenameMethodInfo
    ResolveMenuManagerMethod "addResource" o = MenuManagerAddResourceMethodInfo
    ResolveMenuManagerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMenuManagerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMenuManagerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMenuManagerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMenuManagerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMenuManagerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMenuManagerMethod "merge" o = MenuManagerMergeMethodInfo
    ResolveMenuManagerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMenuManagerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMenuManagerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMenuManagerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMenuManagerMethod "remove" o = MenuManagerRemoveMethodInfo
    ResolveMenuManagerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMenuManagerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMenuManagerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMenuManagerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMenuManagerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMenuManagerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMenuManagerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMenuManagerMethod "getMenuById" o = MenuManagerGetMenuByIdMethodInfo
    ResolveMenuManagerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMenuManagerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMenuManagerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMenuManagerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMenuManagerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMenuManagerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MenuManager
type instance O.AttributeList MenuManager = MenuManagerAttributeList
type MenuManagerAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "dzl_menu_manager_new" dzl_menu_manager_new :: 
    IO (Ptr MenuManager)

-- | /No description available in the introspection data./
menuManagerNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m MenuManager
menuManagerNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m MenuManager
menuManagerNew  = IO MenuManager -> m MenuManager
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MenuManager -> m MenuManager)
-> IO MenuManager -> m MenuManager
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuManager
result <- IO (Ptr MenuManager)
dzl_menu_manager_new
    Text -> Ptr MenuManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"menuManagerNew" Ptr MenuManager
result
    MenuManager
result' <- ((ManagedPtr MenuManager -> MenuManager)
-> Ptr MenuManager -> IO MenuManager
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr MenuManager -> MenuManager
MenuManager) Ptr MenuManager
result
    MenuManager -> IO MenuManager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MenuManager
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method MenuManager::add_filename
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "MenuManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : True
-- Skip return : False

foreign import ccall "dzl_menu_manager_add_filename" dzl_menu_manager_add_filename :: 
    Ptr MenuManager ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "MenuManager"})
    CString ->                              -- filename : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO Word32

-- | /No description available in the introspection data./
menuManagerAddFilename ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuManager a) =>
    a
    -> T.Text
    -> m Word32
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
menuManagerAddFilename :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuManager a) =>
a -> Text -> m Word32
menuManagerAddFilename a
self Text
filename = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuManager
self' <- a -> IO (Ptr MenuManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    IO Word32 -> IO () -> IO Word32
forall a b. IO a -> IO b -> IO a
onException (do
        Word32
result <- (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Word32) -> IO Word32)
-> (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ Ptr MenuManager -> CString -> Ptr (Ptr GError) -> IO Word32
dzl_menu_manager_add_filename Ptr MenuManager
self' CString
filename'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
        Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
     )

#if defined(ENABLE_OVERLOADING)
data MenuManagerAddFilenameMethodInfo
instance (signature ~ (T.Text -> m Word32), MonadIO m, IsMenuManager a) => O.OverloadedMethod MenuManagerAddFilenameMethodInfo a signature where
    overloadedMethod = menuManagerAddFilename

instance O.OverloadedMethodInfo MenuManagerAddFilenameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.MenuManager.menuManagerAddFilename",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-MenuManager.html#v:menuManagerAddFilename"
        })


#endif

-- method MenuManager::add_resource
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "MenuManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "resource"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : True
-- Skip return : False

foreign import ccall "dzl_menu_manager_add_resource" dzl_menu_manager_add_resource :: 
    Ptr MenuManager ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "MenuManager"})
    CString ->                              -- resource : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO Word32

-- | /No description available in the introspection data./
menuManagerAddResource ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuManager a) =>
    a
    -> T.Text
    -> m Word32
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
menuManagerAddResource :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuManager a) =>
a -> Text -> m Word32
menuManagerAddResource a
self Text
resource = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuManager
self' <- a -> IO (Ptr MenuManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
resource' <- Text -> IO CString
textToCString Text
resource
    IO Word32 -> IO () -> IO Word32
forall a b. IO a -> IO b -> IO a
onException (do
        Word32
result <- (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Word32) -> IO Word32)
-> (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ Ptr MenuManager -> CString -> Ptr (Ptr GError) -> IO Word32
dzl_menu_manager_add_resource Ptr MenuManager
self' CString
resource'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
resource'
        Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
resource'
     )

#if defined(ENABLE_OVERLOADING)
data MenuManagerAddResourceMethodInfo
instance (signature ~ (T.Text -> m Word32), MonadIO m, IsMenuManager a) => O.OverloadedMethod MenuManagerAddResourceMethodInfo a signature where
    overloadedMethod = menuManagerAddResource

instance O.OverloadedMethodInfo MenuManagerAddResourceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.MenuManager.menuManagerAddResource",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-MenuManager.html#v:menuManagerAddResource"
        })


#endif

-- method MenuManager::get_menu_by_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "MenuManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menu_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Menu" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_menu_manager_get_menu_by_id" dzl_menu_manager_get_menu_by_id :: 
    Ptr MenuManager ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "MenuManager"})
    CString ->                              -- menu_id : TBasicType TUTF8
    IO (Ptr Gio.Menu.Menu)

-- | /No description available in the introspection data./
menuManagerGetMenuById ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuManager a) =>
    a
    -> T.Text
    -> m Gio.Menu.Menu
    -- ^ __Returns:__ A t'GI.Gio.Objects.Menu.Menu'.
menuManagerGetMenuById :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuManager a) =>
a -> Text -> m Menu
menuManagerGetMenuById a
self Text
menuId = IO Menu -> m Menu
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Menu -> m Menu) -> IO Menu -> m Menu
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuManager
self' <- a -> IO (Ptr MenuManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
menuId' <- Text -> IO CString
textToCString Text
menuId
    Ptr Menu
result <- Ptr MenuManager -> CString -> IO (Ptr Menu)
dzl_menu_manager_get_menu_by_id Ptr MenuManager
self' CString
menuId'
    Text -> Ptr Menu -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"menuManagerGetMenuById" Ptr Menu
result
    Menu
result' <- ((ManagedPtr Menu -> Menu) -> Ptr Menu -> IO Menu
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Menu -> Menu
Gio.Menu.Menu) Ptr Menu
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
menuId'
    Menu -> IO Menu
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Menu
result'

#if defined(ENABLE_OVERLOADING)
data MenuManagerGetMenuByIdMethodInfo
instance (signature ~ (T.Text -> m Gio.Menu.Menu), MonadIO m, IsMenuManager a) => O.OverloadedMethod MenuManagerGetMenuByIdMethodInfo a signature where
    overloadedMethod = menuManagerGetMenuById

instance O.OverloadedMethodInfo MenuManagerGetMenuByIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.MenuManager.menuManagerGetMenuById",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-MenuManager.html#v:menuManagerGetMenuById"
        })


#endif

-- method MenuManager::merge
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "MenuManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menu_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "model"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_menu_manager_merge" dzl_menu_manager_merge :: 
    Ptr MenuManager ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "MenuManager"})
    CString ->                              -- menu_id : TBasicType TUTF8
    Ptr Gio.MenuModel.MenuModel ->          -- model : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    IO Word32

-- | /No description available in the introspection data./
menuManagerMerge ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuManager a, Gio.MenuModel.IsMenuModel b) =>
    a
    -> T.Text
    -> b
    -> m Word32
menuManagerMerge :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenuManager a, IsMenuModel b) =>
a -> Text -> b -> m Word32
menuManagerMerge a
self Text
menuId b
model = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr MenuManager
self' <- a -> IO (Ptr MenuManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
menuId' <- Text -> IO CString
textToCString Text
menuId
    Ptr MenuModel
model' <- b -> IO (Ptr MenuModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
model
    Word32
result <- Ptr MenuManager -> CString -> Ptr MenuModel -> IO Word32
dzl_menu_manager_merge Ptr MenuManager
self' CString
menuId' Ptr MenuModel
model'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
model
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
menuId'
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data MenuManagerMergeMethodInfo
instance (signature ~ (T.Text -> b -> m Word32), MonadIO m, IsMenuManager a, Gio.MenuModel.IsMenuModel b) => O.OverloadedMethod MenuManagerMergeMethodInfo a signature where
    overloadedMethod = menuManagerMerge

instance O.OverloadedMethodInfo MenuManagerMergeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.MenuManager.menuManagerMerge",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-MenuManager.html#v:menuManagerMerge"
        })


#endif

-- method MenuManager::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "MenuManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlMenuManager" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "merge_id"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A previously registered merge id"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_menu_manager_remove" dzl_menu_manager_remove :: 
    Ptr MenuManager ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "MenuManager"})
    Word32 ->                               -- merge_id : TBasicType TUInt
    IO ()

-- | This removes items from menus that were added as part of a previous
-- menu merge. Use the value returned from 'GI.Dazzle.Objects.MenuManager.menuManagerMerge' as
-- the /@mergeId@/.
-- 
-- /Since: 3.26/
menuManagerRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenuManager a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.MenuManager.MenuManager'
    -> Word32
    -- ^ /@mergeId@/: A previously registered merge id
    -> m ()
menuManagerRemove :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenuManager a) =>
a -> Word32 -> m ()
menuManagerRemove a
self Word32
mergeId = 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 MenuManager
self' <- a -> IO (Ptr MenuManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr MenuManager -> Word32 -> IO ()
dzl_menu_manager_remove Ptr MenuManager
self' Word32
mergeId
    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 MenuManagerRemoveMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsMenuManager a) => O.OverloadedMethod MenuManagerRemoveMethodInfo a signature where
    overloadedMethod = menuManagerRemove

instance O.OverloadedMethodInfo MenuManagerRemoveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.MenuManager.menuManagerRemove",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-MenuManager.html#v:menuManagerRemove"
        })


#endif