{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gio.Objects.Menu.Menu' is a simple implementation of t'GI.Gio.Objects.MenuModel.MenuModel'.
-- You populate a t'GI.Gio.Objects.Menu.Menu' by adding t'GI.Gio.Objects.MenuItem.MenuItem' instances to it.
-- 
-- There are some convenience functions to allow you to directly
-- add items (avoiding t'GI.Gio.Objects.MenuItem.MenuItem') for the common cases. To add
-- a regular item, use 'GI.Gio.Objects.Menu.menuInsert'. To add a section, use
-- 'GI.Gio.Objects.Menu.menuInsertSection'. To add a submenu, use
-- 'GI.Gio.Objects.Menu.menuInsertSubmenu'.
-- 
-- /Since: 2.32/

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

module GI.Gio.Objects.Menu
    ( 

-- * Exported types
    Menu(..)                                ,
    IsMenu                                  ,
    toMenu                                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [append]("GI.Gio.Objects.Menu#g:method:append"), [appendItem]("GI.Gio.Objects.Menu#g:method:appendItem"), [appendSection]("GI.Gio.Objects.Menu#g:method:appendSection"), [appendSubmenu]("GI.Gio.Objects.Menu#g:method:appendSubmenu"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freeze]("GI.Gio.Objects.Menu#g:method:freeze"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [insert]("GI.Gio.Objects.Menu#g:method:insert"), [insertItem]("GI.Gio.Objects.Menu#g:method:insertItem"), [insertSection]("GI.Gio.Objects.Menu#g:method:insertSection"), [insertSubmenu]("GI.Gio.Objects.Menu#g:method:insertSubmenu"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isMutable]("GI.Gio.Objects.MenuModel#g:method:isMutable"), [itemsChanged]("GI.Gio.Objects.MenuModel#g:method:itemsChanged"), [iterateItemAttributes]("GI.Gio.Objects.MenuModel#g:method:iterateItemAttributes"), [iterateItemLinks]("GI.Gio.Objects.MenuModel#g:method:iterateItemLinks"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [prepend]("GI.Gio.Objects.Menu#g:method:prepend"), [prependItem]("GI.Gio.Objects.Menu#g:method:prependItem"), [prependSection]("GI.Gio.Objects.Menu#g:method:prependSection"), [prependSubmenu]("GI.Gio.Objects.Menu#g:method:prependSubmenu"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [remove]("GI.Gio.Objects.Menu#g:method:remove"), [removeAll]("GI.Gio.Objects.Menu#g:method:removeAll"), [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"), [getItemAttributeValue]("GI.Gio.Objects.MenuModel#g:method:getItemAttributeValue"), [getItemLink]("GI.Gio.Objects.MenuModel#g:method:getItemLink"), [getNItems]("GI.Gio.Objects.MenuModel#g:method:getNItems"), [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)
    ResolveMenuMethod                       ,
#endif

-- ** append #method:append#

#if defined(ENABLE_OVERLOADING)
    MenuAppendMethodInfo                    ,
#endif
    menuAppend                              ,


-- ** appendItem #method:appendItem#

#if defined(ENABLE_OVERLOADING)
    MenuAppendItemMethodInfo                ,
#endif
    menuAppendItem                          ,


-- ** appendSection #method:appendSection#

#if defined(ENABLE_OVERLOADING)
    MenuAppendSectionMethodInfo             ,
#endif
    menuAppendSection                       ,


-- ** appendSubmenu #method:appendSubmenu#

#if defined(ENABLE_OVERLOADING)
    MenuAppendSubmenuMethodInfo             ,
#endif
    menuAppendSubmenu                       ,


-- ** freeze #method:freeze#

#if defined(ENABLE_OVERLOADING)
    MenuFreezeMethodInfo                    ,
#endif
    menuFreeze                              ,


-- ** insert #method:insert#

#if defined(ENABLE_OVERLOADING)
    MenuInsertMethodInfo                    ,
#endif
    menuInsert                              ,


-- ** insertItem #method:insertItem#

#if defined(ENABLE_OVERLOADING)
    MenuInsertItemMethodInfo                ,
#endif
    menuInsertItem                          ,


-- ** insertSection #method:insertSection#

#if defined(ENABLE_OVERLOADING)
    MenuInsertSectionMethodInfo             ,
#endif
    menuInsertSection                       ,


-- ** insertSubmenu #method:insertSubmenu#

#if defined(ENABLE_OVERLOADING)
    MenuInsertSubmenuMethodInfo             ,
#endif
    menuInsertSubmenu                       ,


-- ** new #method:new#

    menuNew                                 ,


-- ** prepend #method:prepend#

#if defined(ENABLE_OVERLOADING)
    MenuPrependMethodInfo                   ,
#endif
    menuPrepend                             ,


-- ** prependItem #method:prependItem#

#if defined(ENABLE_OVERLOADING)
    MenuPrependItemMethodInfo               ,
#endif
    menuPrependItem                         ,


-- ** prependSection #method:prependSection#

#if defined(ENABLE_OVERLOADING)
    MenuPrependSectionMethodInfo            ,
#endif
    menuPrependSection                      ,


-- ** prependSubmenu #method:prependSubmenu#

#if defined(ENABLE_OVERLOADING)
    MenuPrependSubmenuMethodInfo            ,
#endif
    menuPrependSubmenu                      ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    MenuRemoveMethodInfo                    ,
#endif
    menuRemove                              ,


-- ** removeAll #method:removeAll#

#if defined(ENABLE_OVERLOADING)
    MenuRemoveAllMethodInfo                 ,
#endif
    menuRemoveAll                           ,




    ) 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.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.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 {-# SOURCE #-} qualified GI.Gio.Objects.MenuItem as Gio.MenuItem
import {-# SOURCE #-} qualified GI.Gio.Objects.MenuModel as Gio.MenuModel

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

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

foreign import ccall "g_menu_get_type"
    c_g_menu_get_type :: IO B.Types.GType

instance B.Types.TypedObject Menu where
    glibType :: IO GType
glibType = IO GType
c_g_menu_get_type

instance B.Types.GObject Menu

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

instance O.HasParentTypes Menu
type instance O.ParentTypes Menu = '[Gio.MenuModel.MenuModel, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveMenuMethod (t :: Symbol) (o :: *) :: * where
    ResolveMenuMethod "append" o = MenuAppendMethodInfo
    ResolveMenuMethod "appendItem" o = MenuAppendItemMethodInfo
    ResolveMenuMethod "appendSection" o = MenuAppendSectionMethodInfo
    ResolveMenuMethod "appendSubmenu" o = MenuAppendSubmenuMethodInfo
    ResolveMenuMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMenuMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMenuMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMenuMethod "freeze" o = MenuFreezeMethodInfo
    ResolveMenuMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMenuMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMenuMethod "insert" o = MenuInsertMethodInfo
    ResolveMenuMethod "insertItem" o = MenuInsertItemMethodInfo
    ResolveMenuMethod "insertSection" o = MenuInsertSectionMethodInfo
    ResolveMenuMethod "insertSubmenu" o = MenuInsertSubmenuMethodInfo
    ResolveMenuMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMenuMethod "isMutable" o = Gio.MenuModel.MenuModelIsMutableMethodInfo
    ResolveMenuMethod "itemsChanged" o = Gio.MenuModel.MenuModelItemsChangedMethodInfo
    ResolveMenuMethod "iterateItemAttributes" o = Gio.MenuModel.MenuModelIterateItemAttributesMethodInfo
    ResolveMenuMethod "iterateItemLinks" o = Gio.MenuModel.MenuModelIterateItemLinksMethodInfo
    ResolveMenuMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMenuMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMenuMethod "prepend" o = MenuPrependMethodInfo
    ResolveMenuMethod "prependItem" o = MenuPrependItemMethodInfo
    ResolveMenuMethod "prependSection" o = MenuPrependSectionMethodInfo
    ResolveMenuMethod "prependSubmenu" o = MenuPrependSubmenuMethodInfo
    ResolveMenuMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMenuMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMenuMethod "remove" o = MenuRemoveMethodInfo
    ResolveMenuMethod "removeAll" o = MenuRemoveAllMethodInfo
    ResolveMenuMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMenuMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMenuMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMenuMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMenuMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMenuMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMenuMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMenuMethod "getItemAttributeValue" o = Gio.MenuModel.MenuModelGetItemAttributeValueMethodInfo
    ResolveMenuMethod "getItemLink" o = Gio.MenuModel.MenuModelGetItemLinkMethodInfo
    ResolveMenuMethod "getNItems" o = Gio.MenuModel.MenuModelGetNItemsMethodInfo
    ResolveMenuMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMenuMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMenuMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMenuMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMenuMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMenuMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Menu
type instance O.AttributeList Menu = MenuAttributeList
type MenuAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Menu = MenuSignalList
type MenuSignalList = ('[ '("itemsChanged", Gio.MenuModel.MenuModelItemsChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "g_menu_new" g_menu_new :: 
    IO (Ptr Menu)

-- | Creates a new t'GI.Gio.Objects.Menu.Menu'.
-- 
-- The new menu has no items.
-- 
-- /Since: 2.32/
menuNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Menu
    -- ^ __Returns:__ a new t'GI.Gio.Objects.Menu.Menu'
menuNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Menu
menuNew  = IO Menu -> m Menu
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 Menu
result <- IO (Ptr Menu)
g_menu_new
    Text -> Ptr Menu -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"menuNew" 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
wrapObject ManagedPtr Menu -> Menu
Menu) Ptr Menu
result
    Menu -> IO Menu
forall (m :: * -> *) a. Monad m => a -> m a
return Menu
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Menu::append
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section label, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "detailed_action"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the detailed action string, 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 "g_menu_append" g_menu_append :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    CString ->                              -- label : TBasicType TUTF8
    CString ->                              -- detailed_action : TBasicType TUTF8
    IO ()

-- | Convenience function for appending a normal menu item to the end of
-- /@menu@/.  Combine 'GI.Gio.Objects.MenuItem.menuItemNew' and 'GI.Gio.Objects.Menu.menuInsertItem' for a more
-- flexible alternative.
-- 
-- /Since: 2.32/
menuAppend ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> Maybe (T.Text)
    -- ^ /@label@/: the section label, or 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@detailedAction@/: the detailed action string, or 'P.Nothing'
    -> m ()
menuAppend :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenu a) =>
a -> Maybe Text -> Maybe Text -> m ()
menuAppend a
menu Maybe Text
label Maybe Text
detailedAction = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr CChar
maybeLabel <- case Maybe Text
label of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jLabel -> do
            Ptr CChar
jLabel' <- Text -> IO (Ptr CChar)
textToCString Text
jLabel
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jLabel'
    Ptr CChar
maybeDetailedAction <- case Maybe Text
detailedAction of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jDetailedAction -> do
            Ptr CChar
jDetailedAction' <- Text -> IO (Ptr CChar)
textToCString Text
jDetailedAction
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jDetailedAction'
    Ptr Menu -> Ptr CChar -> Ptr CChar -> IO ()
g_menu_append Ptr Menu
menu' Ptr CChar
maybeLabel Ptr CChar
maybeDetailedAction
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLabel
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeDetailedAction
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo MenuAppendMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuAppend",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuAppend"
        })


#endif

-- method Menu::append_item
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenuItem to append"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_menu_append_item" g_menu_append_item :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    Ptr Gio.MenuItem.MenuItem ->            -- item : TInterface (Name {namespace = "Gio", name = "MenuItem"})
    IO ()

-- | Appends /@item@/ to the end of /@menu@/.
-- 
-- See 'GI.Gio.Objects.Menu.menuInsertItem' for more information.
-- 
-- /Since: 2.32/
menuAppendItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gio.MenuItem.IsMenuItem b) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> b
    -- ^ /@item@/: a t'GI.Gio.Objects.MenuItem.MenuItem' to append
    -> m ()
menuAppendItem :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenu a, IsMenuItem b) =>
a -> b -> m ()
menuAppendItem a
menu b
item = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr MenuItem
item' <- b -> IO (Ptr MenuItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item
    Ptr Menu -> Ptr MenuItem -> IO ()
g_menu_append_item Ptr Menu
menu' Ptr MenuItem
item'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuAppendItemMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsMenu a, Gio.MenuItem.IsMenuItem b) => O.OverloadedMethod MenuAppendItemMethodInfo a signature where
    overloadedMethod = menuAppendItem

instance O.OverloadedMethodInfo MenuAppendItemMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuAppendItem",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuAppendItem"
        })


#endif

-- method Menu::append_section
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section label, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "section"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenuModel with the items of the section"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_menu_append_section" g_menu_append_section :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    CString ->                              -- label : TBasicType TUTF8
    Ptr Gio.MenuModel.MenuModel ->          -- section : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    IO ()

-- | Convenience function for appending a section menu item to the end of
-- /@menu@/.  Combine 'GI.Gio.Objects.MenuItem.menuItemNewSection' and 'GI.Gio.Objects.Menu.menuInsertItem' for a
-- more flexible alternative.
-- 
-- /Since: 2.32/
menuAppendSection ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gio.MenuModel.IsMenuModel b) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> Maybe (T.Text)
    -- ^ /@label@/: the section label, or 'P.Nothing'
    -> b
    -- ^ /@section@/: a t'GI.Gio.Objects.MenuModel.MenuModel' with the items of the section
    -> m ()
menuAppendSection :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenu a, IsMenuModel b) =>
a -> Maybe Text -> b -> m ()
menuAppendSection a
menu Maybe Text
label b
section = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr CChar
maybeLabel <- case Maybe Text
label of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jLabel -> do
            Ptr CChar
jLabel' <- Text -> IO (Ptr CChar)
textToCString Text
jLabel
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jLabel'
    Ptr MenuModel
section' <- b -> IO (Ptr MenuModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
section
    Ptr Menu -> Ptr CChar -> Ptr MenuModel -> IO ()
g_menu_append_section Ptr Menu
menu' Ptr CChar
maybeLabel Ptr MenuModel
section'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
section
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLabel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuAppendSectionMethodInfo
instance (signature ~ (Maybe (T.Text) -> b -> m ()), MonadIO m, IsMenu a, Gio.MenuModel.IsMenuModel b) => O.OverloadedMethod MenuAppendSectionMethodInfo a signature where
    overloadedMethod = menuAppendSection

instance O.OverloadedMethodInfo MenuAppendSectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuAppendSection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuAppendSection"
        })


#endif

-- method Menu::append_submenu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section label, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "submenu"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenuModel with the items of the submenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_menu_append_submenu" g_menu_append_submenu :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    CString ->                              -- label : TBasicType TUTF8
    Ptr Gio.MenuModel.MenuModel ->          -- submenu : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    IO ()

-- | Convenience function for appending a submenu menu item to the end of
-- /@menu@/.  Combine 'GI.Gio.Objects.MenuItem.menuItemNewSubmenu' and 'GI.Gio.Objects.Menu.menuInsertItem' for a
-- more flexible alternative.
-- 
-- /Since: 2.32/
menuAppendSubmenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gio.MenuModel.IsMenuModel b) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> Maybe (T.Text)
    -- ^ /@label@/: the section label, or 'P.Nothing'
    -> b
    -- ^ /@submenu@/: a t'GI.Gio.Objects.MenuModel.MenuModel' with the items of the submenu
    -> m ()
menuAppendSubmenu :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenu a, IsMenuModel b) =>
a -> Maybe Text -> b -> m ()
menuAppendSubmenu a
menu Maybe Text
label b
submenu = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr CChar
maybeLabel <- case Maybe Text
label of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jLabel -> do
            Ptr CChar
jLabel' <- Text -> IO (Ptr CChar)
textToCString Text
jLabel
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jLabel'
    Ptr MenuModel
submenu' <- b -> IO (Ptr MenuModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
submenu
    Ptr Menu -> Ptr CChar -> Ptr MenuModel -> IO ()
g_menu_append_submenu Ptr Menu
menu' Ptr CChar
maybeLabel Ptr MenuModel
submenu'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
submenu
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLabel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuAppendSubmenuMethodInfo
instance (signature ~ (Maybe (T.Text) -> b -> m ()), MonadIO m, IsMenu a, Gio.MenuModel.IsMenuModel b) => O.OverloadedMethod MenuAppendSubmenuMethodInfo a signature where
    overloadedMethod = menuAppendSubmenu

instance O.OverloadedMethodInfo MenuAppendSubmenuMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuAppendSubmenu",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuAppendSubmenu"
        })


#endif

-- method Menu::freeze
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_menu_freeze" g_menu_freeze :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    IO ()

-- | Marks /@menu@/ as frozen.
-- 
-- After the menu is frozen, it is an error to attempt to make any
-- changes to it.  In effect this means that the t'GI.Gio.Objects.Menu.Menu' API must no
-- longer be used.
-- 
-- This function causes 'GI.Gio.Objects.MenuModel.menuModelIsMutable' to begin returning
-- 'P.False', which has some positive performance implications.
-- 
-- /Since: 2.32/
menuFreeze ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> m ()
menuFreeze :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenu a) =>
a -> m ()
menuFreeze a
menu = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Menu -> IO ()
g_menu_freeze Ptr Menu
menu'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuFreezeMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMenu a) => O.OverloadedMethod MenuFreezeMethodInfo a signature where
    overloadedMethod = menuFreeze

instance O.OverloadedMethodInfo MenuFreezeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuFreeze",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuFreeze"
        })


#endif

-- method Menu::insert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position at which to insert the item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section label, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "detailed_action"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the detailed action string, 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 "g_menu_insert" g_menu_insert :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    Int32 ->                                -- position : TBasicType TInt
    CString ->                              -- label : TBasicType TUTF8
    CString ->                              -- detailed_action : TBasicType TUTF8
    IO ()

-- | Convenience function for inserting a normal menu item into /@menu@/.
-- Combine 'GI.Gio.Objects.MenuItem.menuItemNew' and 'GI.Gio.Objects.Menu.menuInsertItem' for a more flexible
-- alternative.
-- 
-- /Since: 2.32/
menuInsert ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> Int32
    -- ^ /@position@/: the position at which to insert the item
    -> Maybe (T.Text)
    -- ^ /@label@/: the section label, or 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@detailedAction@/: the detailed action string, or 'P.Nothing'
    -> m ()
menuInsert :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenu a) =>
a -> Int32 -> Maybe Text -> Maybe Text -> m ()
menuInsert a
menu Int32
position Maybe Text
label Maybe Text
detailedAction = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr CChar
maybeLabel <- case Maybe Text
label of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jLabel -> do
            Ptr CChar
jLabel' <- Text -> IO (Ptr CChar)
textToCString Text
jLabel
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jLabel'
    Ptr CChar
maybeDetailedAction <- case Maybe Text
detailedAction of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jDetailedAction -> do
            Ptr CChar
jDetailedAction' <- Text -> IO (Ptr CChar)
textToCString Text
jDetailedAction
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jDetailedAction'
    Ptr Menu -> Int32 -> Ptr CChar -> Ptr CChar -> IO ()
g_menu_insert Ptr Menu
menu' Int32
position Ptr CChar
maybeLabel Ptr CChar
maybeDetailedAction
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLabel
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeDetailedAction
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuInsertMethodInfo
instance (signature ~ (Int32 -> Maybe (T.Text) -> Maybe (T.Text) -> m ()), MonadIO m, IsMenu a) => O.OverloadedMethod MenuInsertMethodInfo a signature where
    overloadedMethod = menuInsert

instance O.OverloadedMethodInfo MenuInsertMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuInsert",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuInsert"
        })


#endif

-- method Menu::insert_item
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position at which to insert the item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GMenuItem to insert"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_menu_insert_item" g_menu_insert_item :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    Int32 ->                                -- position : TBasicType TInt
    Ptr Gio.MenuItem.MenuItem ->            -- item : TInterface (Name {namespace = "Gio", name = "MenuItem"})
    IO ()

-- | Inserts /@item@/ into /@menu@/.
-- 
-- The \"insertion\" is actually done by copying all of the attribute and
-- link values of /@item@/ and using them to form a new item within /@menu@/.
-- As such, /@item@/ itself is not really inserted, but rather, a menu item
-- that is exactly the same as the one presently described by /@item@/.
-- 
-- This means that /@item@/ is essentially useless after the insertion
-- occurs.  Any changes you make to it are ignored unless it is inserted
-- again (at which point its updated values will be copied).
-- 
-- You should probably just free /@item@/ once you\'re done.
-- 
-- There are many convenience functions to take care of common cases.
-- See 'GI.Gio.Objects.Menu.menuInsert', 'GI.Gio.Objects.Menu.menuInsertSection' and
-- 'GI.Gio.Objects.Menu.menuInsertSubmenu' as well as \"prepend\" and \"append\" variants of
-- each of these functions.
-- 
-- /Since: 2.32/
menuInsertItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gio.MenuItem.IsMenuItem b) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> Int32
    -- ^ /@position@/: the position at which to insert the item
    -> b
    -- ^ /@item@/: the t'GI.Gio.Objects.MenuItem.MenuItem' to insert
    -> m ()
menuInsertItem :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenu a, IsMenuItem b) =>
a -> Int32 -> b -> m ()
menuInsertItem a
menu Int32
position b
item = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr MenuItem
item' <- b -> IO (Ptr MenuItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item
    Ptr Menu -> Int32 -> Ptr MenuItem -> IO ()
g_menu_insert_item Ptr Menu
menu' Int32
position Ptr MenuItem
item'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuInsertItemMethodInfo
instance (signature ~ (Int32 -> b -> m ()), MonadIO m, IsMenu a, Gio.MenuItem.IsMenuItem b) => O.OverloadedMethod MenuInsertItemMethodInfo a signature where
    overloadedMethod = menuInsertItem

instance O.OverloadedMethodInfo MenuInsertItemMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuInsertItem",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuInsertItem"
        })


#endif

-- method Menu::insert_section
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position at which to insert the item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section label, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "section"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenuModel with the items of the section"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_menu_insert_section" g_menu_insert_section :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    Int32 ->                                -- position : TBasicType TInt
    CString ->                              -- label : TBasicType TUTF8
    Ptr Gio.MenuModel.MenuModel ->          -- section : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    IO ()

-- | Convenience function for inserting a section menu item into /@menu@/.
-- Combine 'GI.Gio.Objects.MenuItem.menuItemNewSection' and 'GI.Gio.Objects.Menu.menuInsertItem' for a more
-- flexible alternative.
-- 
-- /Since: 2.32/
menuInsertSection ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gio.MenuModel.IsMenuModel b) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> Int32
    -- ^ /@position@/: the position at which to insert the item
    -> Maybe (T.Text)
    -- ^ /@label@/: the section label, or 'P.Nothing'
    -> b
    -- ^ /@section@/: a t'GI.Gio.Objects.MenuModel.MenuModel' with the items of the section
    -> m ()
menuInsertSection :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenu a, IsMenuModel b) =>
a -> Int32 -> Maybe Text -> b -> m ()
menuInsertSection a
menu Int32
position Maybe Text
label b
section = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr CChar
maybeLabel <- case Maybe Text
label of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jLabel -> do
            Ptr CChar
jLabel' <- Text -> IO (Ptr CChar)
textToCString Text
jLabel
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jLabel'
    Ptr MenuModel
section' <- b -> IO (Ptr MenuModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
section
    Ptr Menu -> Int32 -> Ptr CChar -> Ptr MenuModel -> IO ()
g_menu_insert_section Ptr Menu
menu' Int32
position Ptr CChar
maybeLabel Ptr MenuModel
section'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
section
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLabel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuInsertSectionMethodInfo
instance (signature ~ (Int32 -> Maybe (T.Text) -> b -> m ()), MonadIO m, IsMenu a, Gio.MenuModel.IsMenuModel b) => O.OverloadedMethod MenuInsertSectionMethodInfo a signature where
    overloadedMethod = menuInsertSection

instance O.OverloadedMethodInfo MenuInsertSectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuInsertSection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuInsertSection"
        })


#endif

-- method Menu::insert_submenu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position at which to insert the item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section label, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "submenu"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenuModel with the items of the submenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_menu_insert_submenu" g_menu_insert_submenu :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    Int32 ->                                -- position : TBasicType TInt
    CString ->                              -- label : TBasicType TUTF8
    Ptr Gio.MenuModel.MenuModel ->          -- submenu : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    IO ()

-- | Convenience function for inserting a submenu menu item into /@menu@/.
-- Combine 'GI.Gio.Objects.MenuItem.menuItemNewSubmenu' and 'GI.Gio.Objects.Menu.menuInsertItem' for a more
-- flexible alternative.
-- 
-- /Since: 2.32/
menuInsertSubmenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gio.MenuModel.IsMenuModel b) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> Int32
    -- ^ /@position@/: the position at which to insert the item
    -> Maybe (T.Text)
    -- ^ /@label@/: the section label, or 'P.Nothing'
    -> b
    -- ^ /@submenu@/: a t'GI.Gio.Objects.MenuModel.MenuModel' with the items of the submenu
    -> m ()
menuInsertSubmenu :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenu a, IsMenuModel b) =>
a -> Int32 -> Maybe Text -> b -> m ()
menuInsertSubmenu a
menu Int32
position Maybe Text
label b
submenu = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr CChar
maybeLabel <- case Maybe Text
label of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jLabel -> do
            Ptr CChar
jLabel' <- Text -> IO (Ptr CChar)
textToCString Text
jLabel
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jLabel'
    Ptr MenuModel
submenu' <- b -> IO (Ptr MenuModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
submenu
    Ptr Menu -> Int32 -> Ptr CChar -> Ptr MenuModel -> IO ()
g_menu_insert_submenu Ptr Menu
menu' Int32
position Ptr CChar
maybeLabel Ptr MenuModel
submenu'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
submenu
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLabel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuInsertSubmenuMethodInfo
instance (signature ~ (Int32 -> Maybe (T.Text) -> b -> m ()), MonadIO m, IsMenu a, Gio.MenuModel.IsMenuModel b) => O.OverloadedMethod MenuInsertSubmenuMethodInfo a signature where
    overloadedMethod = menuInsertSubmenu

instance O.OverloadedMethodInfo MenuInsertSubmenuMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuInsertSubmenu",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuInsertSubmenu"
        })


#endif

-- method Menu::prepend
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section label, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "detailed_action"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the detailed action string, 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 "g_menu_prepend" g_menu_prepend :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    CString ->                              -- label : TBasicType TUTF8
    CString ->                              -- detailed_action : TBasicType TUTF8
    IO ()

-- | Convenience function for prepending a normal menu item to the start
-- of /@menu@/.  Combine 'GI.Gio.Objects.MenuItem.menuItemNew' and 'GI.Gio.Objects.Menu.menuInsertItem' for a more
-- flexible alternative.
-- 
-- /Since: 2.32/
menuPrepend ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> Maybe (T.Text)
    -- ^ /@label@/: the section label, or 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@detailedAction@/: the detailed action string, or 'P.Nothing'
    -> m ()
menuPrepend :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenu a) =>
a -> Maybe Text -> Maybe Text -> m ()
menuPrepend a
menu Maybe Text
label Maybe Text
detailedAction = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr CChar
maybeLabel <- case Maybe Text
label of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jLabel -> do
            Ptr CChar
jLabel' <- Text -> IO (Ptr CChar)
textToCString Text
jLabel
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jLabel'
    Ptr CChar
maybeDetailedAction <- case Maybe Text
detailedAction of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jDetailedAction -> do
            Ptr CChar
jDetailedAction' <- Text -> IO (Ptr CChar)
textToCString Text
jDetailedAction
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jDetailedAction'
    Ptr Menu -> Ptr CChar -> Ptr CChar -> IO ()
g_menu_prepend Ptr Menu
menu' Ptr CChar
maybeLabel Ptr CChar
maybeDetailedAction
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLabel
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeDetailedAction
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo MenuPrependMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuPrepend",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuPrepend"
        })


#endif

-- method Menu::prepend_item
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenuItem to prepend"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_menu_prepend_item" g_menu_prepend_item :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    Ptr Gio.MenuItem.MenuItem ->            -- item : TInterface (Name {namespace = "Gio", name = "MenuItem"})
    IO ()

-- | Prepends /@item@/ to the start of /@menu@/.
-- 
-- See 'GI.Gio.Objects.Menu.menuInsertItem' for more information.
-- 
-- /Since: 2.32/
menuPrependItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gio.MenuItem.IsMenuItem b) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> b
    -- ^ /@item@/: a t'GI.Gio.Objects.MenuItem.MenuItem' to prepend
    -> m ()
menuPrependItem :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenu a, IsMenuItem b) =>
a -> b -> m ()
menuPrependItem a
menu b
item = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr MenuItem
item' <- b -> IO (Ptr MenuItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item
    Ptr Menu -> Ptr MenuItem -> IO ()
g_menu_prepend_item Ptr Menu
menu' Ptr MenuItem
item'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuPrependItemMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsMenu a, Gio.MenuItem.IsMenuItem b) => O.OverloadedMethod MenuPrependItemMethodInfo a signature where
    overloadedMethod = menuPrependItem

instance O.OverloadedMethodInfo MenuPrependItemMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuPrependItem",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuPrependItem"
        })


#endif

-- method Menu::prepend_section
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section label, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "section"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenuModel with the items of the section"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_menu_prepend_section" g_menu_prepend_section :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    CString ->                              -- label : TBasicType TUTF8
    Ptr Gio.MenuModel.MenuModel ->          -- section : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    IO ()

-- | Convenience function for prepending a section menu item to the start
-- of /@menu@/.  Combine 'GI.Gio.Objects.MenuItem.menuItemNewSection' and 'GI.Gio.Objects.Menu.menuInsertItem' for
-- a more flexible alternative.
-- 
-- /Since: 2.32/
menuPrependSection ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gio.MenuModel.IsMenuModel b) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> Maybe (T.Text)
    -- ^ /@label@/: the section label, or 'P.Nothing'
    -> b
    -- ^ /@section@/: a t'GI.Gio.Objects.MenuModel.MenuModel' with the items of the section
    -> m ()
menuPrependSection :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenu a, IsMenuModel b) =>
a -> Maybe Text -> b -> m ()
menuPrependSection a
menu Maybe Text
label b
section = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr CChar
maybeLabel <- case Maybe Text
label of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jLabel -> do
            Ptr CChar
jLabel' <- Text -> IO (Ptr CChar)
textToCString Text
jLabel
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jLabel'
    Ptr MenuModel
section' <- b -> IO (Ptr MenuModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
section
    Ptr Menu -> Ptr CChar -> Ptr MenuModel -> IO ()
g_menu_prepend_section Ptr Menu
menu' Ptr CChar
maybeLabel Ptr MenuModel
section'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
section
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLabel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuPrependSectionMethodInfo
instance (signature ~ (Maybe (T.Text) -> b -> m ()), MonadIO m, IsMenu a, Gio.MenuModel.IsMenuModel b) => O.OverloadedMethod MenuPrependSectionMethodInfo a signature where
    overloadedMethod = menuPrependSection

instance O.OverloadedMethodInfo MenuPrependSectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuPrependSection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuPrependSection"
        })


#endif

-- method Menu::prepend_submenu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the section label, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "submenu"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MenuModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenuModel with the items of the submenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_menu_prepend_submenu" g_menu_prepend_submenu :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    CString ->                              -- label : TBasicType TUTF8
    Ptr Gio.MenuModel.MenuModel ->          -- submenu : TInterface (Name {namespace = "Gio", name = "MenuModel"})
    IO ()

-- | Convenience function for prepending a submenu menu item to the start
-- of /@menu@/.  Combine 'GI.Gio.Objects.MenuItem.menuItemNewSubmenu' and 'GI.Gio.Objects.Menu.menuInsertItem' for
-- a more flexible alternative.
-- 
-- /Since: 2.32/
menuPrependSubmenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a, Gio.MenuModel.IsMenuModel b) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> Maybe (T.Text)
    -- ^ /@label@/: the section label, or 'P.Nothing'
    -> b
    -- ^ /@submenu@/: a t'GI.Gio.Objects.MenuModel.MenuModel' with the items of the submenu
    -> m ()
menuPrependSubmenu :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenu a, IsMenuModel b) =>
a -> Maybe Text -> b -> m ()
menuPrependSubmenu a
menu Maybe Text
label b
submenu = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr CChar
maybeLabel <- case Maybe Text
label of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jLabel -> do
            Ptr CChar
jLabel' <- Text -> IO (Ptr CChar)
textToCString Text
jLabel
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jLabel'
    Ptr MenuModel
submenu' <- b -> IO (Ptr MenuModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
submenu
    Ptr Menu -> Ptr CChar -> Ptr MenuModel -> IO ()
g_menu_prepend_submenu Ptr Menu
menu' Ptr CChar
maybeLabel Ptr MenuModel
submenu'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
submenu
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLabel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuPrependSubmenuMethodInfo
instance (signature ~ (Maybe (T.Text) -> b -> m ()), MonadIO m, IsMenu a, Gio.MenuModel.IsMenuModel b) => O.OverloadedMethod MenuPrependSubmenuMethodInfo a signature where
    overloadedMethod = menuPrependSubmenu

instance O.OverloadedMethodInfo MenuPrependSubmenuMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuPrependSubmenu",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuPrependSubmenu"
        })


#endif

-- method Menu::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position of the item 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 "g_menu_remove" g_menu_remove :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    Int32 ->                                -- position : TBasicType TInt
    IO ()

-- | Removes an item from the menu.
-- 
-- /@position@/ gives the index of the item to remove.
-- 
-- It is an error if position is not in range the range from 0 to one
-- less than the number of items in the menu.
-- 
-- It is not possible to remove items by identity since items are added
-- to the menu simply by copying their links and attributes (ie:
-- identity of the item itself is not preserved).
-- 
-- /Since: 2.32/
menuRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> Int32
    -- ^ /@position@/: the position of the item to remove
    -> m ()
menuRemove :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenu a) =>
a -> Int32 -> m ()
menuRemove a
menu Int32
position = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Menu -> Int32 -> IO ()
g_menu_remove Ptr Menu
menu' Int32
position
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuRemoveMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsMenu a) => O.OverloadedMethod MenuRemoveMethodInfo a signature where
    overloadedMethod = menuRemove

instance O.OverloadedMethodInfo MenuRemoveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuRemove",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuRemove"
        })


#endif

-- method Menu::remove_all
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gio" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMenu" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_menu_remove_all" g_menu_remove_all :: 
    Ptr Menu ->                             -- menu : TInterface (Name {namespace = "Gio", name = "Menu"})
    IO ()

-- | Removes all items in the menu.
-- 
-- /Since: 2.38/
menuRemoveAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.Gio.Objects.Menu.Menu'
    -> m ()
menuRemoveAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMenu a) =>
a -> m ()
menuRemoveAll a
menu = 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 Menu
menu' <- a -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr Menu -> IO ()
g_menu_remove_all Ptr Menu
menu'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MenuRemoveAllMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMenu a) => O.OverloadedMethod MenuRemoveAllMethodInfo a signature where
    overloadedMethod = menuRemoveAll

instance O.OverloadedMethodInfo MenuRemoveAllMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Menu.menuRemoveAll",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Objects-Menu.html#v:menuRemoveAll"
        })


#endif