DBusObject.hs

{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gio.Interfaces.DBusObject
    ( 

-- * Exported types
    DBusObject(..)                          ,
    noDBusObject                            ,
    DBusObjectK                             ,
    toDBusObject                            ,


 -- * Methods
-- ** dBusObjectGetInterface
    dBusObjectGetInterface                  ,


-- ** dBusObjectGetInterfaces
    dBusObjectGetInterfaces                 ,


-- ** dBusObjectGetObjectPath
    dBusObjectGetObjectPath                 ,




 -- * Signals
-- ** InterfaceAdded
    DBusObjectInterfaceAddedCallback        ,
    DBusObjectInterfaceAddedCallbackC       ,
    DBusObjectInterfaceAddedSignalInfo      ,
    afterDBusObjectInterfaceAdded           ,
    dBusObjectInterfaceAddedCallbackWrapper ,
    dBusObjectInterfaceAddedClosure         ,
    mkDBusObjectInterfaceAddedCallback      ,
    noDBusObjectInterfaceAddedCallback      ,
    onDBusObjectInterfaceAdded              ,


-- ** InterfaceRemoved
    DBusObjectInterfaceRemovedCallback      ,
    DBusObjectInterfaceRemovedCallbackC     ,
    DBusObjectInterfaceRemovedSignalInfo    ,
    afterDBusObjectInterfaceRemoved         ,
    dBusObjectInterfaceRemovedCallbackWrapper,
    dBusObjectInterfaceRemovedClosure       ,
    mkDBusObjectInterfaceRemovedCallback    ,
    noDBusObjectInterfaceRemovedCallback    ,
    onDBusObjectInterfaceRemoved            ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gio.Types
import GI.Gio.Callbacks
import qualified GI.GObject as GObject

-- interface DBusObject 

newtype DBusObject = DBusObject (ForeignPtr DBusObject)
noDBusObject :: Maybe DBusObject
noDBusObject = Nothing

-- signal DBusObject::interface-added
type DBusObjectInterfaceAddedCallback =
    DBusInterface ->
    IO ()

noDBusObjectInterfaceAddedCallback :: Maybe DBusObjectInterfaceAddedCallback
noDBusObjectInterfaceAddedCallback = Nothing

type DBusObjectInterfaceAddedCallbackC =
    Ptr () ->                               -- object
    Ptr DBusInterface ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkDBusObjectInterfaceAddedCallback :: DBusObjectInterfaceAddedCallbackC -> IO (FunPtr DBusObjectInterfaceAddedCallbackC)

dBusObjectInterfaceAddedClosure :: DBusObjectInterfaceAddedCallback -> IO Closure
dBusObjectInterfaceAddedClosure cb = newCClosure =<< mkDBusObjectInterfaceAddedCallback wrapped
    where wrapped = dBusObjectInterfaceAddedCallbackWrapper cb

dBusObjectInterfaceAddedCallbackWrapper ::
    DBusObjectInterfaceAddedCallback ->
    Ptr () ->
    Ptr DBusInterface ->
    Ptr () ->
    IO ()
dBusObjectInterfaceAddedCallbackWrapper _cb _ interface _ = do
    interface' <- (newObject DBusInterface) interface
    _cb  interface'

onDBusObjectInterfaceAdded :: (GObject a, MonadIO m) => a -> DBusObjectInterfaceAddedCallback -> m SignalHandlerId
onDBusObjectInterfaceAdded obj cb = liftIO $ connectDBusObjectInterfaceAdded obj cb SignalConnectBefore
afterDBusObjectInterfaceAdded :: (GObject a, MonadIO m) => a -> DBusObjectInterfaceAddedCallback -> m SignalHandlerId
afterDBusObjectInterfaceAdded obj cb = connectDBusObjectInterfaceAdded obj cb SignalConnectAfter

connectDBusObjectInterfaceAdded :: (GObject a, MonadIO m) =>
                                   a -> DBusObjectInterfaceAddedCallback -> SignalConnectMode -> m SignalHandlerId
connectDBusObjectInterfaceAdded obj cb after = liftIO $ do
    cb' <- mkDBusObjectInterfaceAddedCallback (dBusObjectInterfaceAddedCallbackWrapper cb)
    connectSignalFunPtr obj "interface-added" cb' after

-- signal DBusObject::interface-removed
type DBusObjectInterfaceRemovedCallback =
    DBusInterface ->
    IO ()

noDBusObjectInterfaceRemovedCallback :: Maybe DBusObjectInterfaceRemovedCallback
noDBusObjectInterfaceRemovedCallback = Nothing

type DBusObjectInterfaceRemovedCallbackC =
    Ptr () ->                               -- object
    Ptr DBusInterface ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkDBusObjectInterfaceRemovedCallback :: DBusObjectInterfaceRemovedCallbackC -> IO (FunPtr DBusObjectInterfaceRemovedCallbackC)

dBusObjectInterfaceRemovedClosure :: DBusObjectInterfaceRemovedCallback -> IO Closure
dBusObjectInterfaceRemovedClosure cb = newCClosure =<< mkDBusObjectInterfaceRemovedCallback wrapped
    where wrapped = dBusObjectInterfaceRemovedCallbackWrapper cb

dBusObjectInterfaceRemovedCallbackWrapper ::
    DBusObjectInterfaceRemovedCallback ->
    Ptr () ->
    Ptr DBusInterface ->
    Ptr () ->
    IO ()
dBusObjectInterfaceRemovedCallbackWrapper _cb _ interface _ = do
    interface' <- (newObject DBusInterface) interface
    _cb  interface'

onDBusObjectInterfaceRemoved :: (GObject a, MonadIO m) => a -> DBusObjectInterfaceRemovedCallback -> m SignalHandlerId
onDBusObjectInterfaceRemoved obj cb = liftIO $ connectDBusObjectInterfaceRemoved obj cb SignalConnectBefore
afterDBusObjectInterfaceRemoved :: (GObject a, MonadIO m) => a -> DBusObjectInterfaceRemovedCallback -> m SignalHandlerId
afterDBusObjectInterfaceRemoved obj cb = connectDBusObjectInterfaceRemoved obj cb SignalConnectAfter

connectDBusObjectInterfaceRemoved :: (GObject a, MonadIO m) =>
                                     a -> DBusObjectInterfaceRemovedCallback -> SignalConnectMode -> m SignalHandlerId
connectDBusObjectInterfaceRemoved obj cb after = liftIO $ do
    cb' <- mkDBusObjectInterfaceRemovedCallback (dBusObjectInterfaceRemovedCallbackWrapper cb)
    connectSignalFunPtr obj "interface-removed" cb' after

type instance AttributeList DBusObject = DBusObjectAttributeList
type DBusObjectAttributeList = ('[ ] :: [(Symbol, *)])

data DBusObjectInterfaceAddedSignalInfo
instance SignalInfo DBusObjectInterfaceAddedSignalInfo where
    type HaskellCallbackType DBusObjectInterfaceAddedSignalInfo = DBusObjectInterfaceAddedCallback
    connectSignal _ = connectDBusObjectInterfaceAdded

data DBusObjectInterfaceRemovedSignalInfo
instance SignalInfo DBusObjectInterfaceRemovedSignalInfo where
    type HaskellCallbackType DBusObjectInterfaceRemovedSignalInfo = DBusObjectInterfaceRemovedCallback
    connectSignal _ = connectDBusObjectInterfaceRemoved

type instance SignalList DBusObject = DBusObjectSignalList
type DBusObjectSignalList = ('[ '("interface-added", DBusObjectInterfaceAddedSignalInfo), '("interface-removed", DBusObjectInterfaceRemovedSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

foreign import ccall "g_dbus_object_get_type"
    c_g_dbus_object_get_type :: IO GType

type instance ParentTypes DBusObject = DBusObjectParentTypes
type DBusObjectParentTypes = '[GObject.Object]

instance GObject DBusObject where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_g_dbus_object_get_type
    

class GObject o => DBusObjectK o
instance (GObject o, IsDescendantOf DBusObject o) => DBusObjectK o

toDBusObject :: DBusObjectK o => o -> IO DBusObject
toDBusObject = unsafeCastTo DBusObject

-- method DBusObject::get_interface
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "DBusInterface"
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_get_interface" g_dbus_object_get_interface :: 
    Ptr DBusObject ->                       -- _obj : TInterface "Gio" "DBusObject"
    CString ->                              -- interface_name : TBasicType TUTF8
    IO (Ptr DBusInterface)


dBusObjectGetInterface ::
    (MonadIO m, DBusObjectK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- interface_name
    m DBusInterface
dBusObjectGetInterface _obj interface_name = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    interface_name' <- textToCString interface_name
    result <- g_dbus_object_get_interface _obj' interface_name'
    checkUnexpectedReturnNULL "g_dbus_object_get_interface" result
    result' <- (wrapObject DBusInterface) result
    touchManagedPtr _obj
    freeMem interface_name'
    return result'

-- method DBusObject::get_interfaces
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TGList (TInterface "Gio" "DBusInterface")
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_get_interfaces" g_dbus_object_get_interfaces :: 
    Ptr DBusObject ->                       -- _obj : TInterface "Gio" "DBusObject"
    IO (Ptr (GList (Ptr DBusInterface)))


dBusObjectGetInterfaces ::
    (MonadIO m, DBusObjectK a) =>
    a ->                                    -- _obj
    m [DBusInterface]
dBusObjectGetInterfaces _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_dbus_object_get_interfaces _obj'
    checkUnexpectedReturnNULL "g_dbus_object_get_interfaces" result
    result' <- unpackGList result
    result'' <- mapM (wrapObject DBusInterface) result'
    g_list_free result
    touchManagedPtr _obj
    return result''

-- method DBusObject::get_object_path
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "DBusObject", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "g_dbus_object_get_object_path" g_dbus_object_get_object_path :: 
    Ptr DBusObject ->                       -- _obj : TInterface "Gio" "DBusObject"
    IO CString


dBusObjectGetObjectPath ::
    (MonadIO m, DBusObjectK a) =>
    a ->                                    -- _obj
    m T.Text
dBusObjectGetObjectPath _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_dbus_object_get_object_path _obj'
    checkUnexpectedReturnNULL "g_dbus_object_get_object_path" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'