{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gio.Objects.DBusMenuModel.DBusMenuModel' is an implementation of t'GI.Gio.Objects.MenuModel.MenuModel' that can be used
-- as a proxy for a menu model that is exported over D-Bus with
-- 'GI.Gio.Objects.DBusConnection.dBusConnectionExportMenuModel'.

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

module GI.Gio.Objects.DBusMenuModel
    ( 

-- * Exported types
    DBusMenuModel(..)                       ,
    IsDBusMenuModel                         ,
    toDBusMenuModel                         ,
    noDBusMenuModel                         ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDBusMenuModelMethod              ,
#endif


-- ** get #method:get#

    dBusMenuModelGet                        ,




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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection
import {-# SOURCE #-} qualified GI.Gio.Objects.MenuModel as Gio.MenuModel

-- | Memory-managed wrapper type.
newtype DBusMenuModel = DBusMenuModel (ManagedPtr DBusMenuModel)
    deriving (DBusMenuModel -> DBusMenuModel -> Bool
(DBusMenuModel -> DBusMenuModel -> Bool)
-> (DBusMenuModel -> DBusMenuModel -> Bool) -> Eq DBusMenuModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DBusMenuModel -> DBusMenuModel -> Bool
$c/= :: DBusMenuModel -> DBusMenuModel -> Bool
== :: DBusMenuModel -> DBusMenuModel -> Bool
$c== :: DBusMenuModel -> DBusMenuModel -> Bool
Eq)
foreign import ccall "g_dbus_menu_model_get_type"
    c_g_dbus_menu_model_get_type :: IO GType

instance GObject DBusMenuModel where
    gobjectType :: IO GType
gobjectType = IO GType
c_g_dbus_menu_model_get_type
    

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

-- | Type class for types which can be safely cast to `DBusMenuModel`, for instance with `toDBusMenuModel`.
class (GObject o, O.IsDescendantOf DBusMenuModel o) => IsDBusMenuModel o
instance (GObject o, O.IsDescendantOf DBusMenuModel o) => IsDBusMenuModel o

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

-- | Cast to `DBusMenuModel`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toDBusMenuModel :: (MonadIO m, IsDBusMenuModel o) => o -> m DBusMenuModel
toDBusMenuModel :: o -> m DBusMenuModel
toDBusMenuModel = IO DBusMenuModel -> m DBusMenuModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusMenuModel -> m DBusMenuModel)
-> (o -> IO DBusMenuModel) -> o -> m DBusMenuModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr DBusMenuModel -> DBusMenuModel)
-> o -> IO DBusMenuModel
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr DBusMenuModel -> DBusMenuModel
DBusMenuModel

-- | A convenience alias for `Nothing` :: `Maybe` `DBusMenuModel`.
noDBusMenuModel :: Maybe DBusMenuModel
noDBusMenuModel :: Maybe DBusMenuModel
noDBusMenuModel = Maybe DBusMenuModel
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveDBusMenuModelMethod (t :: Symbol) (o :: *) :: * where
    ResolveDBusMenuModelMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDBusMenuModelMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDBusMenuModelMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDBusMenuModelMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDBusMenuModelMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDBusMenuModelMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDBusMenuModelMethod "isMutable" o = Gio.MenuModel.MenuModelIsMutableMethodInfo
    ResolveDBusMenuModelMethod "itemsChanged" o = Gio.MenuModel.MenuModelItemsChangedMethodInfo
    ResolveDBusMenuModelMethod "iterateItemAttributes" o = Gio.MenuModel.MenuModelIterateItemAttributesMethodInfo
    ResolveDBusMenuModelMethod "iterateItemLinks" o = Gio.MenuModel.MenuModelIterateItemLinksMethodInfo
    ResolveDBusMenuModelMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDBusMenuModelMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDBusMenuModelMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDBusMenuModelMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDBusMenuModelMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDBusMenuModelMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDBusMenuModelMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDBusMenuModelMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDBusMenuModelMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDBusMenuModelMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDBusMenuModelMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDBusMenuModelMethod "getItemAttributeValue" o = Gio.MenuModel.MenuModelGetItemAttributeValueMethodInfo
    ResolveDBusMenuModelMethod "getItemLink" o = Gio.MenuModel.MenuModelGetItemLinkMethodInfo
    ResolveDBusMenuModelMethod "getNItems" o = Gio.MenuModel.MenuModelGetNItemsMethodInfo
    ResolveDBusMenuModelMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDBusMenuModelMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDBusMenuModelMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDBusMenuModelMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDBusMenuModelMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDBusMenuModelMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDBusMenuModelMethod t DBusMenuModel, O.MethodInfo info DBusMenuModel p) => OL.IsLabel t (DBusMenuModel -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method DBusMenuModel::get
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDBusConnection" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bus_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the bus name which exports the menu model\n    or %NULL if @connection is not a message bus connection"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the object path at which the menu model is exported"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "DBusMenuModel" })
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_menu_model_get" g_dbus_menu_model_get :: 
    Ptr Gio.DBusConnection.DBusConnection -> -- connection : TInterface (Name {namespace = "Gio", name = "DBusConnection"})
    CString ->                              -- bus_name : TBasicType TUTF8
    CString ->                              -- object_path : TBasicType TUTF8
    IO (Ptr DBusMenuModel)

-- | Obtains a t'GI.Gio.Objects.DBusMenuModel.DBusMenuModel' for the menu model which is exported
-- at the given /@busName@/ and /@objectPath@/.
-- 
-- The thread default main context is taken at the time of this call.
-- All signals on the menu model (and any linked models) are reported
-- with respect to this context.  All calls on the returned menu model
-- (and linked models) must also originate from this same context, with
-- the thread default main context unchanged.
-- 
-- /Since: 2.32/
dBusMenuModelGet ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.DBusConnection.IsDBusConnection a) =>
    a
    -- ^ /@connection@/: a t'GI.Gio.Objects.DBusConnection.DBusConnection'
    -> Maybe (T.Text)
    -- ^ /@busName@/: the bus name which exports the menu model
    --     or 'P.Nothing' if /@connection@/ is not a message bus connection
    -> T.Text
    -- ^ /@objectPath@/: the object path at which the menu model is exported
    -> m DBusMenuModel
    -- ^ __Returns:__ a t'GI.Gio.Objects.DBusMenuModel.DBusMenuModel' object. Free with
    --     'GI.GObject.Objects.Object.objectUnref'.
dBusMenuModelGet :: a -> Maybe Text -> Text -> m DBusMenuModel
dBusMenuModelGet connection :: a
connection busName :: Maybe Text
busName objectPath :: Text
objectPath = IO DBusMenuModel -> m DBusMenuModel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DBusMenuModel -> m DBusMenuModel)
-> IO DBusMenuModel -> m DBusMenuModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusConnection
connection' <- a -> IO (Ptr DBusConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    Ptr CChar
maybeBusName <- case Maybe Text
busName of
        Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just jBusName :: Text
jBusName -> do
            Ptr CChar
jBusName' <- Text -> IO (Ptr CChar)
textToCString Text
jBusName
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jBusName'
    Ptr CChar
objectPath' <- Text -> IO (Ptr CChar)
textToCString Text
objectPath
    Ptr DBusMenuModel
result <- Ptr DBusConnection
-> Ptr CChar -> Ptr CChar -> IO (Ptr DBusMenuModel)
g_dbus_menu_model_get Ptr DBusConnection
connection' Ptr CChar
maybeBusName Ptr CChar
objectPath'
    Text -> Ptr DBusMenuModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "dBusMenuModelGet" Ptr DBusMenuModel
result
    DBusMenuModel
result' <- ((ManagedPtr DBusMenuModel -> DBusMenuModel)
-> Ptr DBusMenuModel -> IO DBusMenuModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DBusMenuModel -> DBusMenuModel
DBusMenuModel) Ptr DBusMenuModel
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeBusName
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
objectPath'
    DBusMenuModel -> IO DBusMenuModel
forall (m :: * -> *) a. Monad m => a -> m a
return DBusMenuModel
result'

#if defined(ENABLE_OVERLOADING)
#endif