{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- See_also: t'GI.IBus.Objects.Property.Property', t'GI.IBus.Objects.Engine.Engine'

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

module GI.IBus.Objects.PropList
    ( 

-- * Exported types
    PropList(..)                            ,
    IsPropList                              ,
    toPropList                              ,


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

#if defined(ENABLE_OVERLOADING)
    ResolvePropListMethod                   ,
#endif


-- ** append #method:append#

#if defined(ENABLE_OVERLOADING)
    PropListAppendMethodInfo                ,
#endif
    propListAppend                          ,


-- ** get #method:get#

#if defined(ENABLE_OVERLOADING)
    PropListGetMethodInfo                   ,
#endif
    propListGet                             ,


-- ** new #method:new#

    propListNew                             ,


-- ** updateProperty #method:updateProperty#

#if defined(ENABLE_OVERLOADING)
    PropListUpdatePropertyMethodInfo        ,
#endif
    propListUpdateProperty                  ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.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.IBus.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Property as IBus.Property
import {-# SOURCE #-} qualified GI.IBus.Objects.Serializable as IBus.Serializable

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

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

foreign import ccall "ibus_prop_list_get_type"
    c_ibus_prop_list_get_type :: IO B.Types.GType

instance B.Types.TypedObject PropList where
    glibType :: IO GType
glibType = IO GType
c_ibus_prop_list_get_type

instance B.Types.GObject PropList

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

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

instance O.HasParentTypes PropList
type instance O.ParentTypes PropList = '[IBus.Serializable.Serializable, IBus.Object.Object, GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePropListMethod (t :: Symbol) (o :: *) :: * where
    ResolvePropListMethod "append" o = PropListAppendMethodInfo
    ResolvePropListMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePropListMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePropListMethod "copy" o = IBus.Serializable.SerializableCopyMethodInfo
    ResolvePropListMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolvePropListMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePropListMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePropListMethod "get" o = PropListGetMethodInfo
    ResolvePropListMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePropListMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePropListMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePropListMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePropListMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePropListMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePropListMethod "removeQattachment" o = IBus.Serializable.SerializableRemoveQattachmentMethodInfo
    ResolvePropListMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePropListMethod "serializeObject" o = IBus.Serializable.SerializableSerializeObjectMethodInfo
    ResolvePropListMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePropListMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePropListMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePropListMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePropListMethod "updateProperty" o = PropListUpdatePropertyMethodInfo
    ResolvePropListMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePropListMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePropListMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePropListMethod "getQattachment" o = IBus.Serializable.SerializableGetQattachmentMethodInfo
    ResolvePropListMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePropListMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePropListMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePropListMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePropListMethod "setQattachment" o = IBus.Serializable.SerializableSetQattachmentMethodInfo
    ResolvePropListMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePropListMethod t PropList, O.MethodInfo info PropList p) => OL.IsLabel t (PropList -> 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 PropList
type instance O.AttributeList PropList = PropListAttributeList
type PropListAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList PropList = PropListSignalList
type PropListSignalList = ('[ '("destroy", IBus.Object.ObjectDestroySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "ibus_prop_list_new" ibus_prop_list_new :: 
    IO (Ptr PropList)

-- | Create a new t'GI.IBus.Objects.PropList.PropList'.
propListNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m PropList
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.PropList.PropList'.
propListNew :: m PropList
propListNew  = IO PropList -> m PropList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PropList -> m PropList) -> IO PropList -> m PropList
forall a b. (a -> b) -> a -> b
$ do
    Ptr PropList
result <- IO (Ptr PropList)
ibus_prop_list_new
    Text -> Ptr PropList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propListNew" Ptr PropList
result
    PropList
result' <- ((ManagedPtr PropList -> PropList) -> Ptr PropList -> IO PropList
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PropList -> PropList
PropList) Ptr PropList
result
    PropList -> IO PropList
forall (m :: * -> *) a. Monad m => a -> m a
return PropList
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method PropList::append
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop_list"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PropList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusPropList." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "IBusProperty to be append to @prop_list."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_prop_list_append" ibus_prop_list_append :: 
    Ptr PropList ->                         -- prop_list : TInterface (Name {namespace = "IBus", name = "PropList"})
    Ptr IBus.Property.Property ->           -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    IO ()

-- | Append an IBusProperty to an IBusPropList, and increase reference.
propListAppend ::
    (B.CallStack.HasCallStack, MonadIO m, IsPropList a, IBus.Property.IsProperty b) =>
    a
    -- ^ /@propList@/: An IBusPropList.
    -> b
    -- ^ /@prop@/: IBusProperty to be append to /@propList@/.
    -> m ()
propListAppend :: a -> b -> m ()
propListAppend a
propList b
prop = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PropList
propList' <- a -> IO (Ptr PropList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
propList
    Ptr Property
prop' <- b -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
prop
    Ptr PropList -> Ptr Property -> IO ()
ibus_prop_list_append Ptr PropList
propList' Ptr Property
prop'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
propList
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
prop
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PropListAppendMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPropList a, IBus.Property.IsProperty b) => O.MethodInfo PropListAppendMethodInfo a signature where
    overloadedMethod = propListAppend

#endif

-- method PropList::get
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop_list"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PropList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusPropList." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Index of an IBusPropList."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "Property" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_prop_list_get" ibus_prop_list_get :: 
    Ptr PropList ->                         -- prop_list : TInterface (Name {namespace = "IBus", name = "PropList"})
    Word32 ->                               -- index : TBasicType TUInt
    IO (Ptr IBus.Property.Property)

-- | Gets t'GI.IBus.Objects.Property.Property' at given index. Borrowed reference.
propListGet ::
    (B.CallStack.HasCallStack, MonadIO m, IsPropList a) =>
    a
    -- ^ /@propList@/: An IBusPropList.
    -> Word32
    -- ^ /@index@/: Index of an IBusPropList.
    -> m IBus.Property.Property
    -- ^ __Returns:__ t'GI.IBus.Objects.Property.Property' at given index, 'P.Nothing' if no such
    --     t'GI.IBus.Objects.Property.Property'.
propListGet :: a -> Word32 -> m Property
propListGet a
propList Word32
index = IO Property -> m Property
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Property -> m Property) -> IO Property -> m Property
forall a b. (a -> b) -> a -> b
$ do
    Ptr PropList
propList' <- a -> IO (Ptr PropList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
propList
    Ptr Property
result <- Ptr PropList -> Word32 -> IO (Ptr Property)
ibus_prop_list_get Ptr PropList
propList' Word32
index
    Text -> Ptr Property -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"propListGet" Ptr Property
result
    Property
result' <- ((ManagedPtr Property -> Property) -> Ptr Property -> IO Property
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Property -> Property
IBus.Property.Property) Ptr Property
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
propList
    Property -> IO Property
forall (m :: * -> *) a. Monad m => a -> m a
return Property
result'

#if defined(ENABLE_OVERLOADING)
data PropListGetMethodInfo
instance (signature ~ (Word32 -> m IBus.Property.Property), MonadIO m, IsPropList a) => O.MethodInfo PropListGetMethodInfo a signature where
    overloadedMethod = propListGet

#endif

-- method PropList::update_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "prop_list"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PropList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusPropList." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prop"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Property" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "IBusProperty to be update."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_prop_list_update_property" ibus_prop_list_update_property :: 
    Ptr PropList ->                         -- prop_list : TInterface (Name {namespace = "IBus", name = "PropList"})
    Ptr IBus.Property.Property ->           -- prop : TInterface (Name {namespace = "IBus", name = "Property"})
    IO CInt

-- | Update an IBusProperty in IBusPropList.
propListUpdateProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsPropList a, IBus.Property.IsProperty b) =>
    a
    -- ^ /@propList@/: An IBusPropList.
    -> b
    -- ^ /@prop@/: IBusProperty to be update.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if succeeded, 'P.False' otherwise.
propListUpdateProperty :: a -> b -> m Bool
propListUpdateProperty a
propList b
prop = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr PropList
propList' <- a -> IO (Ptr PropList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
propList
    Ptr Property
prop' <- b -> IO (Ptr Property)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
prop
    CInt
result <- Ptr PropList -> Ptr Property -> IO CInt
ibus_prop_list_update_property Ptr PropList
propList' Ptr Property
prop'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
propList
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
prop
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PropListUpdatePropertyMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsPropList a, IBus.Property.IsProperty b) => O.MethodInfo PropListUpdatePropertyMethodInfo a signature where
    overloadedMethod = propListUpdateProperty

#endif