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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A server which represents a sharing of a set of
-- 	@/DbusmenuMenuitems/@ across DBus to a t'GI.Dbusmenu.Objects.Client.Client'.

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

module GI.Dbusmenu.Objects.Server
    ( 

-- * Exported types
    Server(..)                              ,
    IsServer                                ,
    toServer                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [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"), [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"), [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"), [getIconPaths]("GI.Dbusmenu.Objects.Server#g:method:getIconPaths"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getStatus]("GI.Dbusmenu.Objects.Server#g:method:getStatus"), [getTextDirection]("GI.Dbusmenu.Objects.Server#g:method:getTextDirection").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setIconPaths]("GI.Dbusmenu.Objects.Server#g:method:setIconPaths"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRoot]("GI.Dbusmenu.Objects.Server#g:method:setRoot"), [setStatus]("GI.Dbusmenu.Objects.Server#g:method:setStatus"), [setTextDirection]("GI.Dbusmenu.Objects.Server#g:method:setTextDirection").

#if defined(ENABLE_OVERLOADING)
    ResolveServerMethod                     ,
#endif

-- ** getIconPaths #method:getIconPaths#

#if defined(ENABLE_OVERLOADING)
    ServerGetIconPathsMethodInfo            ,
#endif
    serverGetIconPaths                      ,


-- ** getStatus #method:getStatus#

#if defined(ENABLE_OVERLOADING)
    ServerGetStatusMethodInfo               ,
#endif
    serverGetStatus                         ,


-- ** getTextDirection #method:getTextDirection#

#if defined(ENABLE_OVERLOADING)
    ServerGetTextDirectionMethodInfo        ,
#endif
    serverGetTextDirection                  ,


-- ** new #method:new#

    serverNew                               ,


-- ** setIconPaths #method:setIconPaths#

#if defined(ENABLE_OVERLOADING)
    ServerSetIconPathsMethodInfo            ,
#endif
    serverSetIconPaths                      ,


-- ** setRoot #method:setRoot#

#if defined(ENABLE_OVERLOADING)
    ServerSetRootMethodInfo                 ,
#endif
    serverSetRoot                           ,


-- ** setStatus #method:setStatus#

#if defined(ENABLE_OVERLOADING)
    ServerSetStatusMethodInfo               ,
#endif
    serverSetStatus                         ,


-- ** setTextDirection #method:setTextDirection#

#if defined(ENABLE_OVERLOADING)
    ServerSetTextDirectionMethodInfo        ,
#endif
    serverSetTextDirection                  ,




 -- * Properties


-- ** dbusObject #attr:dbusObject#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ServerDbusObjectPropertyInfo            ,
#endif
    constructServerDbusObject               ,
    getServerDbusObject                     ,
#if defined(ENABLE_OVERLOADING)
    serverDbusObject                        ,
#endif


-- ** rootNode #attr:rootNode#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ServerRootNodePropertyInfo              ,
#endif
    clearServerRootNode                     ,
    constructServerRootNode                 ,
    getServerRootNode                       ,
#if defined(ENABLE_OVERLOADING)
    serverRootNode                          ,
#endif
    setServerRootNode                       ,


-- ** version #attr:version#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ServerVersionPropertyInfo               ,
#endif
    getServerVersion                        ,
#if defined(ENABLE_OVERLOADING)
    serverVersion                           ,
#endif




 -- * Signals


-- ** itemActivationRequested #signal:itemActivationRequested#

    ServerItemActivationRequestedCallback   ,
#if defined(ENABLE_OVERLOADING)
    ServerItemActivationRequestedSignalInfo ,
#endif
    afterServerItemActivationRequested      ,
    onServerItemActivationRequested         ,


-- ** itemPropertyUpdated #signal:itemPropertyUpdated#

    ServerItemPropertyUpdatedCallback       ,
#if defined(ENABLE_OVERLOADING)
    ServerItemPropertyUpdatedSignalInfo     ,
#endif
    afterServerItemPropertyUpdated          ,
    onServerItemPropertyUpdated             ,


-- ** itemUpdated #signal:itemUpdated#

    ServerItemUpdatedCallback               ,
#if defined(ENABLE_OVERLOADING)
    ServerItemUpdatedSignalInfo             ,
#endif
    afterServerItemUpdated                  ,
    onServerItemUpdated                     ,


-- ** layoutUpdated #signal:layoutUpdated#

    ServerLayoutUpdatedCallback             ,
#if defined(ENABLE_OVERLOADING)
    ServerLayoutUpdatedSignalInfo           ,
#endif
    afterServerLayoutUpdated                ,
    onServerLayoutUpdated                   ,




    ) 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.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.Dbusmenu.Enums as Dbusmenu.Enums
import {-# SOURCE #-} qualified GI.Dbusmenu.Objects.Menuitem as Dbusmenu.Menuitem
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "dbusmenu_server_get_type"
    c_dbusmenu_server_get_type :: IO B.Types.GType

instance B.Types.TypedObject Server where
    glibType :: IO GType
glibType = IO GType
c_dbusmenu_server_get_type

instance B.Types.GObject Server

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveServerMethod (t :: Symbol) (o :: *) :: * where
    ResolveServerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveServerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveServerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveServerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveServerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveServerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveServerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveServerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveServerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveServerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveServerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveServerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveServerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveServerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveServerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveServerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveServerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveServerMethod "getIconPaths" o = ServerGetIconPathsMethodInfo
    ResolveServerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveServerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveServerMethod "getStatus" o = ServerGetStatusMethodInfo
    ResolveServerMethod "getTextDirection" o = ServerGetTextDirectionMethodInfo
    ResolveServerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveServerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveServerMethod "setIconPaths" o = ServerSetIconPathsMethodInfo
    ResolveServerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveServerMethod "setRoot" o = ServerSetRootMethodInfo
    ResolveServerMethod "setStatus" o = ServerSetStatusMethodInfo
    ResolveServerMethod "setTextDirection" o = ServerSetTextDirectionMethodInfo
    ResolveServerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Server::item-activation-requested
-- | This is signaled when a menuitem under this server
-- 		sends its activate signal.
type ServerItemActivationRequestedCallback =
    Int32
    -- ^ /@arg1@/: The ID of the parent for this update.
    -> Word32
    -- ^ /@arg2@/: The timestamp of when the event happened
    -> IO ()

type C_ServerItemActivationRequestedCallback =
    Ptr Server ->                           -- object
    Int32 ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ServerItemActivationRequestedCallback :: 
    GObject a => (a -> ServerItemActivationRequestedCallback) ->
    C_ServerItemActivationRequestedCallback
wrap_ServerItemActivationRequestedCallback :: forall a.
GObject a =>
(a -> ServerItemActivationRequestedCallback)
-> C_ServerItemActivationRequestedCallback
wrap_ServerItemActivationRequestedCallback a -> ServerItemActivationRequestedCallback
gi'cb Ptr Server
gi'selfPtr Int32
arg1 Word32
arg2 Ptr ()
_ = do
    Ptr Server -> (Server -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Server
gi'selfPtr ((Server -> IO ()) -> IO ()) -> (Server -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Server
gi'self -> a -> ServerItemActivationRequestedCallback
gi'cb (Server -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Server
gi'self)  Int32
arg1 Word32
arg2


-- | Connect a signal handler for the [itemActivationRequested](#signal:itemActivationRequested) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' server #itemActivationRequested callback
-- @
-- 
-- 
onServerItemActivationRequested :: (IsServer a, MonadIO m) => a -> ((?self :: a) => ServerItemActivationRequestedCallback) -> m SignalHandlerId
onServerItemActivationRequested :: forall a (m :: * -> *).
(IsServer a, MonadIO m) =>
a
-> ((?self::a) => ServerItemActivationRequestedCallback)
-> m SignalHandlerId
onServerItemActivationRequested a
obj (?self::a) => ServerItemActivationRequestedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ServerItemActivationRequestedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ServerItemActivationRequestedCallback
ServerItemActivationRequestedCallback
cb
    let wrapped' :: C_ServerItemActivationRequestedCallback
wrapped' = (a -> ServerItemActivationRequestedCallback)
-> C_ServerItemActivationRequestedCallback
forall a.
GObject a =>
(a -> ServerItemActivationRequestedCallback)
-> C_ServerItemActivationRequestedCallback
wrap_ServerItemActivationRequestedCallback a -> ServerItemActivationRequestedCallback
wrapped
    FunPtr C_ServerItemActivationRequestedCallback
wrapped'' <- C_ServerItemActivationRequestedCallback
-> IO (FunPtr C_ServerItemActivationRequestedCallback)
mk_ServerItemActivationRequestedCallback C_ServerItemActivationRequestedCallback
wrapped'
    a
-> Text
-> FunPtr C_ServerItemActivationRequestedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"item-activation-requested" FunPtr C_ServerItemActivationRequestedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data ServerItemActivationRequestedSignalInfo
instance SignalInfo ServerItemActivationRequestedSignalInfo where
    type HaskellCallbackType ServerItemActivationRequestedSignalInfo = ServerItemActivationRequestedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ServerItemActivationRequestedCallback cb
        cb'' <- mk_ServerItemActivationRequestedCallback cb'
        connectSignalFunPtr obj "item-activation-requested" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server::item-activation-requested"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#g:signal:itemActivationRequested"})

#endif

-- signal Server::item-property-updated
-- | /No description available in the introspection data./
type ServerItemPropertyUpdatedCallback =
    Int32
    -> T.Text
    -> GVariant
    -> IO ()

type C_ServerItemPropertyUpdatedCallback =
    Ptr Server ->                           -- object
    Int32 ->
    CString ->
    Ptr GVariant ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ServerItemPropertyUpdatedCallback :: 
    GObject a => (a -> ServerItemPropertyUpdatedCallback) ->
    C_ServerItemPropertyUpdatedCallback
wrap_ServerItemPropertyUpdatedCallback :: forall a.
GObject a =>
(a -> ServerItemPropertyUpdatedCallback)
-> C_ServerItemPropertyUpdatedCallback
wrap_ServerItemPropertyUpdatedCallback a -> ServerItemPropertyUpdatedCallback
gi'cb Ptr Server
gi'selfPtr Int32
object CString
p0 Ptr GVariant
p1 Ptr ()
_ = do
    Text
p0' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
p0
    GVariant
p1' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
p1
    Ptr Server -> (Server -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Server
gi'selfPtr ((Server -> IO ()) -> IO ()) -> (Server -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Server
gi'self -> a -> ServerItemPropertyUpdatedCallback
gi'cb (Server -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Server
gi'self)  Int32
object Text
p0' GVariant
p1'


-- | Connect a signal handler for the [itemPropertyUpdated](#signal:itemPropertyUpdated) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' server #itemPropertyUpdated callback
-- @
-- 
-- 
onServerItemPropertyUpdated :: (IsServer a, MonadIO m) => a -> ((?self :: a) => ServerItemPropertyUpdatedCallback) -> m SignalHandlerId
onServerItemPropertyUpdated :: forall a (m :: * -> *).
(IsServer a, MonadIO m) =>
a
-> ((?self::a) => ServerItemPropertyUpdatedCallback)
-> m SignalHandlerId
onServerItemPropertyUpdated a
obj (?self::a) => ServerItemPropertyUpdatedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ServerItemPropertyUpdatedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ServerItemPropertyUpdatedCallback
ServerItemPropertyUpdatedCallback
cb
    let wrapped' :: C_ServerItemPropertyUpdatedCallback
wrapped' = (a -> ServerItemPropertyUpdatedCallback)
-> C_ServerItemPropertyUpdatedCallback
forall a.
GObject a =>
(a -> ServerItemPropertyUpdatedCallback)
-> C_ServerItemPropertyUpdatedCallback
wrap_ServerItemPropertyUpdatedCallback a -> ServerItemPropertyUpdatedCallback
wrapped
    FunPtr C_ServerItemPropertyUpdatedCallback
wrapped'' <- C_ServerItemPropertyUpdatedCallback
-> IO (FunPtr C_ServerItemPropertyUpdatedCallback)
mk_ServerItemPropertyUpdatedCallback C_ServerItemPropertyUpdatedCallback
wrapped'
    a
-> Text
-> FunPtr C_ServerItemPropertyUpdatedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"item-property-updated" FunPtr C_ServerItemPropertyUpdatedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data ServerItemPropertyUpdatedSignalInfo
instance SignalInfo ServerItemPropertyUpdatedSignalInfo where
    type HaskellCallbackType ServerItemPropertyUpdatedSignalInfo = ServerItemPropertyUpdatedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ServerItemPropertyUpdatedCallback cb
        cb'' <- mk_ServerItemPropertyUpdatedCallback cb'
        connectSignalFunPtr obj "item-property-updated" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server::item-property-updated"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#g:signal:itemPropertyUpdated"})

#endif

-- signal Server::item-updated
-- | /No description available in the introspection data./
type ServerItemUpdatedCallback =
    Int32
    -> IO ()

type C_ServerItemUpdatedCallback =
    Ptr Server ->                           -- object
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ServerItemUpdatedCallback :: 
    GObject a => (a -> ServerItemUpdatedCallback) ->
    C_ServerItemUpdatedCallback
wrap_ServerItemUpdatedCallback :: forall a.
GObject a =>
(a -> ServerItemUpdatedCallback) -> C_ServerItemUpdatedCallback
wrap_ServerItemUpdatedCallback a -> ServerItemUpdatedCallback
gi'cb Ptr Server
gi'selfPtr Int32
object Ptr ()
_ = do
    Ptr Server -> (Server -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Server
gi'selfPtr ((Server -> IO ()) -> IO ()) -> (Server -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Server
gi'self -> a -> ServerItemUpdatedCallback
gi'cb (Server -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Server
gi'self)  Int32
object


-- | Connect a signal handler for the [itemUpdated](#signal:itemUpdated) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' server #itemUpdated callback
-- @
-- 
-- 
onServerItemUpdated :: (IsServer a, MonadIO m) => a -> ((?self :: a) => ServerItemUpdatedCallback) -> m SignalHandlerId
onServerItemUpdated :: forall a (m :: * -> *).
(IsServer a, MonadIO m) =>
a -> ((?self::a) => ServerItemUpdatedCallback) -> m SignalHandlerId
onServerItemUpdated a
obj (?self::a) => ServerItemUpdatedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ServerItemUpdatedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ServerItemUpdatedCallback
ServerItemUpdatedCallback
cb
    let wrapped' :: C_ServerItemUpdatedCallback
wrapped' = (a -> ServerItemUpdatedCallback) -> C_ServerItemUpdatedCallback
forall a.
GObject a =>
(a -> ServerItemUpdatedCallback) -> C_ServerItemUpdatedCallback
wrap_ServerItemUpdatedCallback a -> ServerItemUpdatedCallback
wrapped
    FunPtr C_ServerItemUpdatedCallback
wrapped'' <- C_ServerItemUpdatedCallback
-> IO (FunPtr C_ServerItemUpdatedCallback)
mk_ServerItemUpdatedCallback C_ServerItemUpdatedCallback
wrapped'
    a
-> Text
-> FunPtr C_ServerItemUpdatedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"item-updated" FunPtr C_ServerItemUpdatedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data ServerItemUpdatedSignalInfo
instance SignalInfo ServerItemUpdatedSignalInfo where
    type HaskellCallbackType ServerItemUpdatedSignalInfo = ServerItemUpdatedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ServerItemUpdatedCallback cb
        cb'' <- mk_ServerItemUpdatedCallback cb'
        connectSignalFunPtr obj "item-updated" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server::item-updated"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#g:signal:itemUpdated"})

#endif

-- signal Server::layout-updated
-- | This signal is emitted any time the layout of the
-- 		menuitems under this server is changed.
type ServerLayoutUpdatedCallback =
    Word32
    -- ^ /@arg1@/: A revision number representing which revision the update
    -- 		       represents itself as.
    -> Int32
    -- ^ /@arg2@/: The ID of the parent for this update.
    -> IO ()

type C_ServerLayoutUpdatedCallback =
    Ptr Server ->                           -- object
    Word32 ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ServerLayoutUpdatedCallback :: 
    GObject a => (a -> ServerLayoutUpdatedCallback) ->
    C_ServerLayoutUpdatedCallback
wrap_ServerLayoutUpdatedCallback :: forall a.
GObject a =>
(a -> ServerLayoutUpdatedCallback) -> C_ServerLayoutUpdatedCallback
wrap_ServerLayoutUpdatedCallback a -> ServerLayoutUpdatedCallback
gi'cb Ptr Server
gi'selfPtr Word32
arg1 Int32
arg2 Ptr ()
_ = do
    Ptr Server -> (Server -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Server
gi'selfPtr ((Server -> IO ()) -> IO ()) -> (Server -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Server
gi'self -> a -> ServerLayoutUpdatedCallback
gi'cb (Server -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Server
gi'self)  Word32
arg1 Int32
arg2


-- | Connect a signal handler for the [layoutUpdated](#signal:layoutUpdated) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' server #layoutUpdated callback
-- @
-- 
-- 
onServerLayoutUpdated :: (IsServer a, MonadIO m) => a -> ((?self :: a) => ServerLayoutUpdatedCallback) -> m SignalHandlerId
onServerLayoutUpdated :: forall a (m :: * -> *).
(IsServer a, MonadIO m) =>
a
-> ((?self::a) => ServerLayoutUpdatedCallback) -> m SignalHandlerId
onServerLayoutUpdated a
obj (?self::a) => ServerLayoutUpdatedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> ServerLayoutUpdatedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ServerLayoutUpdatedCallback
ServerLayoutUpdatedCallback
cb
    let wrapped' :: C_ServerLayoutUpdatedCallback
wrapped' = (a -> ServerLayoutUpdatedCallback) -> C_ServerLayoutUpdatedCallback
forall a.
GObject a =>
(a -> ServerLayoutUpdatedCallback) -> C_ServerLayoutUpdatedCallback
wrap_ServerLayoutUpdatedCallback a -> ServerLayoutUpdatedCallback
wrapped
    FunPtr C_ServerLayoutUpdatedCallback
wrapped'' <- C_ServerLayoutUpdatedCallback
-> IO (FunPtr C_ServerLayoutUpdatedCallback)
mk_ServerLayoutUpdatedCallback C_ServerLayoutUpdatedCallback
wrapped'
    a
-> Text
-> FunPtr C_ServerLayoutUpdatedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"layout-updated" FunPtr C_ServerLayoutUpdatedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data ServerLayoutUpdatedSignalInfo
instance SignalInfo ServerLayoutUpdatedSignalInfo where
    type HaskellCallbackType ServerLayoutUpdatedSignalInfo = ServerLayoutUpdatedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ServerLayoutUpdatedCallback cb
        cb'' <- mk_ServerLayoutUpdatedCallback cb'
        connectSignalFunPtr obj "layout-updated" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server::layout-updated"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#g:signal:layoutUpdated"})

#endif

-- VVV Prop "dbus-object"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@dbus-object@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' server #dbusObject
-- @
getServerDbusObject :: (MonadIO m, IsServer o) => o -> m (Maybe T.Text)
getServerDbusObject :: forall (m :: * -> *) o.
(MonadIO m, IsServer o) =>
o -> m (Maybe Text)
getServerDbusObject o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"dbus-object"

-- | Construct a `GValueConstruct` with valid value for the “@dbus-object@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructServerDbusObject :: (IsServer o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructServerDbusObject :: forall o (m :: * -> *).
(IsServer o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructServerDbusObject Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"dbus-object" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data ServerDbusObjectPropertyInfo
instance AttrInfo ServerDbusObjectPropertyInfo where
    type AttrAllowedOps ServerDbusObjectPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ServerDbusObjectPropertyInfo = IsServer
    type AttrSetTypeConstraint ServerDbusObjectPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ServerDbusObjectPropertyInfo = (~) T.Text
    type AttrTransferType ServerDbusObjectPropertyInfo = T.Text
    type AttrGetType ServerDbusObjectPropertyInfo = (Maybe T.Text)
    type AttrLabel ServerDbusObjectPropertyInfo = "dbus-object"
    type AttrOrigin ServerDbusObjectPropertyInfo = Server
    attrGet = getServerDbusObject
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructServerDbusObject
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server.dbusObject"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#g:attr:dbusObject"
        })
#endif

-- VVV Prop "root-node"
   -- Type: TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

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

-- | Set the value of the “@root-node@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #rootNode
-- @
clearServerRootNode :: (MonadIO m, IsServer o) => o -> m ()
clearServerRootNode :: forall (m :: * -> *) o. (MonadIO m, IsServer o) => o -> m ()
clearServerRootNode o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Menuitem -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"root-node" (Maybe Menuitem
forall a. Maybe a
Nothing :: Maybe Dbusmenu.Menuitem.Menuitem)

#if defined(ENABLE_OVERLOADING)
data ServerRootNodePropertyInfo
instance AttrInfo ServerRootNodePropertyInfo where
    type AttrAllowedOps ServerRootNodePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ServerRootNodePropertyInfo = IsServer
    type AttrSetTypeConstraint ServerRootNodePropertyInfo = Dbusmenu.Menuitem.IsMenuitem
    type AttrTransferTypeConstraint ServerRootNodePropertyInfo = Dbusmenu.Menuitem.IsMenuitem
    type AttrTransferType ServerRootNodePropertyInfo = Dbusmenu.Menuitem.Menuitem
    type AttrGetType ServerRootNodePropertyInfo = (Maybe Dbusmenu.Menuitem.Menuitem)
    type AttrLabel ServerRootNodePropertyInfo = "root-node"
    type AttrOrigin ServerRootNodePropertyInfo = Server
    attrGet = getServerRootNode
    attrSet = setServerRootNode
    attrTransfer _ v = do
        unsafeCastTo Dbusmenu.Menuitem.Menuitem v
    attrConstruct = constructServerRootNode
    attrClear = clearServerRootNode
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server.rootNode"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#g:attr:rootNode"
        })
#endif

-- VVV Prop "version"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@version@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' server #version
-- @
getServerVersion :: (MonadIO m, IsServer o) => o -> m Word32
getServerVersion :: forall (m :: * -> *) o. (MonadIO m, IsServer o) => o -> m Word32
getServerVersion o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"version"

#if defined(ENABLE_OVERLOADING)
data ServerVersionPropertyInfo
instance AttrInfo ServerVersionPropertyInfo where
    type AttrAllowedOps ServerVersionPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ServerVersionPropertyInfo = IsServer
    type AttrSetTypeConstraint ServerVersionPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ServerVersionPropertyInfo = (~) ()
    type AttrTransferType ServerVersionPropertyInfo = ()
    type AttrGetType ServerVersionPropertyInfo = Word32
    type AttrLabel ServerVersionPropertyInfo = "version"
    type AttrOrigin ServerVersionPropertyInfo = Server
    attrGet = getServerVersion
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server.version"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#g:attr:version"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Server
type instance O.AttributeList Server = ServerAttributeList
type ServerAttributeList = ('[ '("dbusObject", ServerDbusObjectPropertyInfo), '("rootNode", ServerRootNodePropertyInfo), '("version", ServerVersionPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
serverDbusObject :: AttrLabelProxy "dbusObject"
serverDbusObject = AttrLabelProxy

serverRootNode :: AttrLabelProxy "rootNode"
serverRootNode = AttrLabelProxy

serverVersion :: AttrLabelProxy "version"
serverVersion = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Server = ServerSignalList
type ServerSignalList = ('[ '("itemActivationRequested", ServerItemActivationRequestedSignalInfo), '("itemPropertyUpdated", ServerItemPropertyUpdatedSignalInfo), '("itemUpdated", ServerItemUpdatedSignalInfo), '("layoutUpdated", ServerLayoutUpdatedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Server::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "object"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The object name to show for this menu structure\n\t\ton DBus.  May be NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Dbusmenu" , name = "Server" })
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_server_new" dbusmenu_server_new :: 
    CString ->                              -- object : TBasicType TUTF8
    IO (Ptr Server)

-- | Creates a new t'GI.Dbusmenu.Objects.Server.Server' object with a specific object
-- 	path on DBus.  If /@object@/ is set to NULL the default object
-- 	name of \"\/com\/canonical\/dbusmenu\" will be used.
-- 
-- 	Return value: A brand new t'GI.Dbusmenu.Objects.Server.Server'
serverNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@object@/: The object name to show for this menu structure
    -- 		on DBus.  May be NULL.
    -> m Server
serverNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m Server
serverNew Text
object = IO Server -> m Server
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Server -> m Server) -> IO Server -> m Server
forall a b. (a -> b) -> a -> b
$ do
    CString
object' <- Text -> IO CString
textToCString Text
object
    Ptr Server
result <- CString -> IO (Ptr Server)
dbusmenu_server_new CString
object'
    Text -> Ptr Server -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"serverNew" Ptr Server
result
    Server
result' <- ((ManagedPtr Server -> Server) -> Ptr Server -> IO Server
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Server -> Server
Server) Ptr Server
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
object'
    Server -> IO Server
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Server
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Server::get_icon_paths
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuServer to get the icon paths from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_server_get_icon_paths" dbusmenu_server_get_icon_paths :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Dbusmenu", name = "Server"})
    IO (Ptr CString)

-- | Gets the stored and exported icon paths from the server.
serverGetIconPaths ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: The t'GI.Dbusmenu.Objects.Server.Server' to get the icon paths from
    -> m [T.Text]
    -- ^ __Returns:__ A NULL-terminated list of icon paths with
    --   memory managed by the server.  Duplicate if you want
    --   to keep them.
serverGetIconPaths :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> m [Text]
serverGetIconPaths a
server = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr CString
result <- Ptr Server -> IO (Ptr CString)
dbusmenu_server_get_icon_paths Ptr Server
server'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"serverGetIconPaths" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data ServerGetIconPathsMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsServer a) => O.OverloadedMethod ServerGetIconPathsMethodInfo a signature where
    overloadedMethod = serverGetIconPaths

instance O.OverloadedMethodInfo ServerGetIconPathsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server.serverGetIconPaths",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#v:serverGetIconPaths"
        })


#endif

-- method Server::get_status
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuServer to get the status from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Dbusmenu" , name = "Status" })
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_server_get_status" dbusmenu_server_get_status :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Dbusmenu", name = "Server"})
    IO CUInt

-- | Gets the current statust hat the server is sending out over
-- 	DBus.
-- 
-- 	Return value: The current status the server is sending
serverGetStatus ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: The t'GI.Dbusmenu.Objects.Server.Server' to get the status from
    -> m Dbusmenu.Enums.Status
serverGetStatus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> m Status
serverGetStatus a
server = IO Status -> m Status
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Status -> m Status) -> IO Status -> m Status
forall a b. (a -> b) -> a -> b
$ do
    Ptr Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    CUInt
result <- Ptr Server -> IO CUInt
dbusmenu_server_get_status Ptr Server
server'
    let result' :: Status
result' = (Int -> Status
forall a. Enum a => Int -> a
toEnum (Int -> Status) -> (CUInt -> Int) -> CUInt -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    Status -> IO Status
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
result'

#if defined(ENABLE_OVERLOADING)
data ServerGetStatusMethodInfo
instance (signature ~ (m Dbusmenu.Enums.Status), MonadIO m, IsServer a) => O.OverloadedMethod ServerGetStatusMethodInfo a signature where
    overloadedMethod = serverGetStatus

instance O.OverloadedMethodInfo ServerGetStatusMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server.serverGetStatus",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#v:serverGetStatus"
        })


#endif

-- method Server::get_text_direction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuServer object to get the text direction from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Dbusmenu" , name = "TextDirection" })
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_server_get_text_direction" dbusmenu_server_get_text_direction :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Dbusmenu", name = "Server"})
    IO CUInt

-- | Returns the value of the text direction that is being exported
-- 	over DBus for this server.  It should relate to the direction
-- 	of the labels and other text fields that are being exported by
-- 	this server.
-- 
-- 	Return value: Text direction exported for this server.
serverGetTextDirection ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: The t'GI.Dbusmenu.Objects.Server.Server' object to get the text direction from
    -> m Dbusmenu.Enums.TextDirection
serverGetTextDirection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> m TextDirection
serverGetTextDirection a
server = IO TextDirection -> m TextDirection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextDirection -> m TextDirection)
-> IO TextDirection -> m TextDirection
forall a b. (a -> b) -> a -> b
$ do
    Ptr Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    CUInt
result <- Ptr Server -> IO CUInt
dbusmenu_server_get_text_direction Ptr Server
server'
    let result' :: TextDirection
result' = (Int -> TextDirection
forall a. Enum a => Int -> a
toEnum (Int -> TextDirection) -> (CUInt -> Int) -> CUInt -> TextDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    TextDirection -> IO TextDirection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TextDirection
result'

#if defined(ENABLE_OVERLOADING)
data ServerGetTextDirectionMethodInfo
instance (signature ~ (m Dbusmenu.Enums.TextDirection), MonadIO m, IsServer a) => O.OverloadedMethod ServerGetTextDirectionMethodInfo a signature where
    overloadedMethod = serverGetTextDirection

instance O.OverloadedMethodInfo ServerGetTextDirectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server.serverGetTextDirection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#v:serverGetTextDirection"
        })


#endif

-- method Server::set_icon_paths
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuServer to set the icon paths on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_paths"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_server_set_icon_paths" dbusmenu_server_set_icon_paths :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Dbusmenu", name = "Server"})
    Ptr CString ->                          -- icon_paths : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO ()

-- | Sets the icon paths for the server.  This will replace previously
-- 	set icon theme paths.
serverSetIconPaths ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: The t'GI.Dbusmenu.Objects.Server.Server' to set the icon paths on
    -> [T.Text]
    -> m ()
serverSetIconPaths :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> [Text] -> m ()
serverSetIconPaths a
server [Text]
iconPaths = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    Ptr CString
iconPaths' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
iconPaths
    Ptr Server -> Ptr CString -> IO ()
dbusmenu_server_set_icon_paths Ptr Server
server' Ptr CString
iconPaths'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
iconPaths'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
iconPaths'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerSetIconPathsMethodInfo
instance (signature ~ ([T.Text] -> m ()), MonadIO m, IsServer a) => O.OverloadedMethod ServerSetIconPathsMethodInfo a signature where
    overloadedMethod = serverSetIconPaths

instance O.OverloadedMethodInfo ServerSetIconPathsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server.serverSetIconPaths",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#v:serverSetIconPaths"
        })


#endif

-- method Server::set_root
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuServer object to set the root on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "root"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Menuitem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new root #DbusmenuMenuitem tree"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_server_set_root" dbusmenu_server_set_root :: 
    Ptr Server ->                           -- self : TInterface (Name {namespace = "Dbusmenu", name = "Server"})
    Ptr Dbusmenu.Menuitem.Menuitem ->       -- root : TInterface (Name {namespace = "Dbusmenu", name = "Menuitem"})
    IO ()

-- | This function contains all of the t'GI.GObject.Structs.Value.Value' wrapping
-- 	required to set the property [Server:rootNode]("GI.Dbusmenu.Objects.Server#g:attr:rootNode")
-- 	on the server /@self@/.
serverSetRoot ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a, Dbusmenu.Menuitem.IsMenuitem b) =>
    a
    -- ^ /@self@/: The t'GI.Dbusmenu.Objects.Server.Server' object to set the root on
    -> b
    -- ^ /@root@/: The new root t'GI.Dbusmenu.Objects.Menuitem.Menuitem' tree
    -> m ()
serverSetRoot :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsServer a, IsMenuitem b) =>
a -> b -> m ()
serverSetRoot a
self b
root = 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 Server
self' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Menuitem
root' <- b -> IO (Ptr Menuitem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
root
    Ptr Server -> Ptr Menuitem -> IO ()
dbusmenu_server_set_root Ptr Server
self' Ptr Menuitem
root'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
root
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerSetRootMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsServer a, Dbusmenu.Menuitem.IsMenuitem b) => O.OverloadedMethod ServerSetRootMethodInfo a signature where
    overloadedMethod = serverSetRoot

instance O.OverloadedMethodInfo ServerSetRootMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server.serverSetRoot",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#v:serverSetRoot"
        })


#endif

-- method Server::set_status
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #DbusmenuServer to set the status on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "status"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Status" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Status value to set on the server"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_server_set_status" dbusmenu_server_set_status :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Dbusmenu", name = "Server"})
    CUInt ->                                -- status : TInterface (Name {namespace = "Dbusmenu", name = "Status"})
    IO ()

-- | Changes the status of the server.
serverSetStatus ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: The t'GI.Dbusmenu.Objects.Server.Server' to set the status on
    -> Dbusmenu.Enums.Status
    -- ^ /@status@/: Status value to set on the server
    -> m ()
serverSetStatus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> Status -> m ()
serverSetStatus a
server Status
status = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    let status' :: CUInt
status' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Status -> Int) -> Status -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Int
forall a. Enum a => a -> Int
fromEnum) Status
status
    Ptr Server -> CUInt -> IO ()
dbusmenu_server_set_status Ptr Server
server' CUInt
status'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerSetStatusMethodInfo
instance (signature ~ (Dbusmenu.Enums.Status -> m ()), MonadIO m, IsServer a) => O.OverloadedMethod ServerSetStatusMethodInfo a signature where
    overloadedMethod = serverSetStatus

instance O.OverloadedMethodInfo ServerSetStatusMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server.serverSetStatus",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#v:serverSetStatus"
        })


#endif

-- method Server::set_text_direction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "server"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "Server" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #DbusmenuServer object to set the text direction on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dir"
--           , argType =
--               TInterface Name { namespace = "Dbusmenu" , name = "TextDirection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Direction of the text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dbusmenu_server_set_text_direction" dbusmenu_server_set_text_direction :: 
    Ptr Server ->                           -- server : TInterface (Name {namespace = "Dbusmenu", name = "Server"})
    CUInt ->                                -- dir : TInterface (Name {namespace = "Dbusmenu", name = "TextDirection"})
    IO ()

-- | Sets the text direction that should be exported over DBus for
-- 	this server.  If the value is set to @/DBUSMENU_TEXT_DIRECTION_NONE/@
-- 	the default detection will be used for setting the value and
-- 	exported over DBus.
serverSetTextDirection ::
    (B.CallStack.HasCallStack, MonadIO m, IsServer a) =>
    a
    -- ^ /@server@/: The t'GI.Dbusmenu.Objects.Server.Server' object to set the text direction on
    -> Dbusmenu.Enums.TextDirection
    -- ^ /@dir@/: Direction of the text
    -> m ()
serverSetTextDirection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsServer a) =>
a -> TextDirection -> m ()
serverSetTextDirection a
server TextDirection
dir = 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 Server
server' <- a -> IO (Ptr Server)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
server
    let dir' :: CUInt
dir' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TextDirection -> Int) -> TextDirection -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextDirection -> Int
forall a. Enum a => a -> Int
fromEnum) TextDirection
dir
    Ptr Server -> CUInt -> IO ()
dbusmenu_server_set_text_direction Ptr Server
server' CUInt
dir'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
server
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ServerSetTextDirectionMethodInfo
instance (signature ~ (Dbusmenu.Enums.TextDirection -> m ()), MonadIO m, IsServer a) => O.OverloadedMethod ServerSetTextDirectionMethodInfo a signature where
    overloadedMethod = serverSetTextDirection

instance O.OverloadedMethodInfo ServerSetTextDirectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dbusmenu.Objects.Server.serverSetTextDirection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dbusmenu-0.4.11/docs/GI-Dbusmenu-Objects-Server.html#v:serverSetTextDirection"
        })


#endif