{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Array of IBusAttribute.

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

module GI.IBus.Objects.AttrList
    ( 

-- * Exported types
    AttrList(..)                            ,
    IsAttrList                              ,
    toAttrList                              ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAttrListMethod                   ,
#endif


-- ** append #method:append#

#if defined(ENABLE_OVERLOADING)
    AttrListAppendMethodInfo                ,
#endif
    attrListAppend                          ,


-- ** get #method:get#

#if defined(ENABLE_OVERLOADING)
    AttrListGetMethodInfo                   ,
#endif
    attrListGet                             ,


-- ** new #method:new#

    attrListNew                             ,




    ) 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 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.Attribute as IBus.Attribute
import {-# SOURCE #-} qualified GI.IBus.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Serializable as IBus.Serializable

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

instance GObject AttrList where
    gobjectType :: IO GType
gobjectType = IO GType
c_ibus_attr_list_get_type
    

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

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "ibus_attr_list_new" ibus_attr_list_new :: 
    IO (Ptr AttrList)

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

#if defined(ENABLE_OVERLOADING)
#endif

-- method AttrList::append
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "attr_list"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusAttrList instance."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attr"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "Attribute" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The IBusAttribute instance to be appended."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_attr_list_append" ibus_attr_list_append :: 
    Ptr AttrList ->                         -- attr_list : TInterface (Name {namespace = "IBus", name = "AttrList"})
    Ptr IBus.Attribute.Attribute ->         -- attr : TInterface (Name {namespace = "IBus", name = "Attribute"})
    IO ()

-- | Append an IBusAttribute to IBusAttrList, and increase reference.
attrListAppend ::
    (B.CallStack.HasCallStack, MonadIO m, IsAttrList a, IBus.Attribute.IsAttribute b) =>
    a
    -- ^ /@attrList@/: An IBusAttrList instance.
    -> b
    -- ^ /@attr@/: The IBusAttribute instance to be appended.
    -> m ()
attrListAppend :: a -> b -> m ()
attrListAppend a
attrList b
attr = 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 AttrList
attrList' <- a -> IO (Ptr AttrList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attrList
    Ptr Attribute
attr' <- b -> IO (Ptr Attribute)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
attr
    Ptr AttrList -> Ptr Attribute -> IO ()
ibus_attr_list_append Ptr AttrList
attrList' Ptr Attribute
attr'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attrList
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
attr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AttrListAppendMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsAttrList a, IBus.Attribute.IsAttribute b) => O.MethodInfo AttrListAppendMethodInfo a signature where
    overloadedMethod = attrListAppend

#endif

-- method AttrList::get
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "attr_list"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "AttrList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusAttrList instance."
--                 , 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 the @attr_list."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "Attribute" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_attr_list_get" ibus_attr_list_get :: 
    Ptr AttrList ->                         -- attr_list : TInterface (Name {namespace = "IBus", name = "AttrList"})
    Word32 ->                               -- index : TBasicType TUInt
    IO (Ptr IBus.Attribute.Attribute)

-- | Returns t'GI.IBus.Objects.Attribute.Attribute' at given index. Borrowed reference.
attrListGet ::
    (B.CallStack.HasCallStack, MonadIO m, IsAttrList a) =>
    a
    -- ^ /@attrList@/: An IBusAttrList instance.
    -> Word32
    -- ^ /@index@/: Index of the /@attrList@/.
    -> m IBus.Attribute.Attribute
    -- ^ __Returns:__ t'GI.IBus.Objects.Attribute.Attribute' at given index, 'P.Nothing' if no such
    --        t'GI.IBus.Objects.Attribute.Attribute'.
attrListGet :: a -> Word32 -> m Attribute
attrListGet a
attrList Word32
index = IO Attribute -> m Attribute
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Attribute -> m Attribute) -> IO Attribute -> m Attribute
forall a b. (a -> b) -> a -> b
$ do
    Ptr AttrList
attrList' <- a -> IO (Ptr AttrList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
attrList
    Ptr Attribute
result <- Ptr AttrList -> Word32 -> IO (Ptr Attribute)
ibus_attr_list_get Ptr AttrList
attrList' Word32
index
    Text -> Ptr Attribute -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"attrListGet" Ptr Attribute
result
    Attribute
result' <- ((ManagedPtr Attribute -> Attribute)
-> Ptr Attribute -> IO Attribute
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Attribute -> Attribute
IBus.Attribute.Attribute) Ptr Attribute
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
attrList
    Attribute -> IO Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return Attribute
result'

#if defined(ENABLE_OVERLOADING)
data AttrListGetMethodInfo
instance (signature ~ (Word32 -> m IBus.Attribute.Attribute), MonadIO m, IsAttrList a) => O.MethodInfo AttrListGetMethodInfo a signature where
    overloadedMethod = attrListGet

#endif