{-# LINE 1 "Data/GI/Base/Properties.hsc" #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}

module Data.GI.Base.Properties
    ( setObjectPropertyString
    , setObjectPropertyStringArray
    , setObjectPropertyPtr
    , setObjectPropertyInt
    , setObjectPropertyUInt
    , setObjectPropertyLong
    , setObjectPropertyULong
    , setObjectPropertyInt32
    , setObjectPropertyUInt32
    , setObjectPropertyInt64
    , setObjectPropertyUInt64
    , setObjectPropertyFloat
    , setObjectPropertyDouble
    , setObjectPropertyBool
    , setObjectPropertyGType
    , setObjectPropertyObject
    , setObjectPropertyBoxed
    , setObjectPropertyEnum
    , setObjectPropertyFlags
    , setObjectPropertyClosure
    , setObjectPropertyVariant
    , setObjectPropertyByteArray
    , setObjectPropertyPtrGList
    , setObjectPropertyHash
    , setObjectPropertyCallback
    , setObjectPropertyGError

    , getObjectPropertyString
    , getObjectPropertyStringArray
    , getObjectPropertyPtr
    , getObjectPropertyInt
    , getObjectPropertyUInt
    , getObjectPropertyLong
    , getObjectPropertyULong
    , getObjectPropertyInt32
    , getObjectPropertyUInt32
    , getObjectPropertyInt64
    , getObjectPropertyUInt64
    , getObjectPropertyFloat
    , getObjectPropertyDouble
    , getObjectPropertyBool
    , getObjectPropertyGType
    , getObjectPropertyObject
    , getObjectPropertyBoxed
    , getObjectPropertyEnum
    , getObjectPropertyFlags
    , getObjectPropertyClosure
    , getObjectPropertyVariant
    , getObjectPropertyByteArray
    , getObjectPropertyPtrGList
    , getObjectPropertyHash
    , getObjectPropertyCallback
    , getObjectPropertyGError

    , constructObjectPropertyString
    , constructObjectPropertyStringArray
    , constructObjectPropertyPtr
    , constructObjectPropertyInt
    , constructObjectPropertyUInt
    , constructObjectPropertyLong
    , constructObjectPropertyULong
    , constructObjectPropertyInt32
    , constructObjectPropertyUInt32
    , constructObjectPropertyInt64
    , constructObjectPropertyUInt64
    , constructObjectPropertyFloat
    , constructObjectPropertyDouble
    , constructObjectPropertyBool
    , constructObjectPropertyGType
    , constructObjectPropertyObject
    , constructObjectPropertyBoxed
    , constructObjectPropertyEnum
    , constructObjectPropertyFlags
    , constructObjectPropertyClosure
    , constructObjectPropertyVariant
    , constructObjectPropertyByteArray
    , constructObjectPropertyPtrGList
    , constructObjectPropertyHash
    , constructObjectPropertyCallback
    , constructObjectPropertyGError
    ) where


{-# LINE 89 "Data/GI/Base/Properties.hsc" #-}
import Control.Monad ((>=>))

import qualified Data.ByteString.Char8 as B
import Data.Text (Text)
import Data.Proxy (Proxy(..))

import Data.GI.Base.BasicTypes
import Data.GI.Base.BasicConversions
import Data.GI.Base.ManagedPtr
import Data.GI.Base.GError (GError(..))
import Data.GI.Base.GValue
import Data.GI.Base.GType
import Data.GI.Base.GClosure (GClosure(..))
import Data.GI.Base.GVariant (newGVariantFromPtr)
import Data.GI.Base.Utils (freeMem, convertIfNonNull)

import Foreign (Ptr, FunPtr, Int32, Word32, Int64, Word64, nullPtr,
                castFunPtrToPtr, castPtrToFunPtr)
import Foreign.C (CString, withCString)
import Foreign.C.Types (CInt, CUInt, CLong, CULong)



foreign import ccall "g_object_set_property" g_object_set_property ::
    Ptr a -> CString -> Ptr GValue -> IO ()

setObjectProperty :: GObject a => a -> String -> b ->
                     (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty :: a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty obj :: a
obj propName :: String
propName propValue :: b
propValue setter :: GValue -> b -> IO ()
setter (GType gtype :: CGType
gtype) = do
  GValue
gvalue <- GType -> (GValue -> b -> IO ()) -> b -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
buildGValue (CGType -> GType
GType CGType
gtype) GValue -> b -> IO ()
setter b
propValue
  a -> (Ptr a -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr a
obj ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \objPtr :: Ptr a
objPtr ->
      String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
propName ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \cPropName :: CString
cPropName ->
          GValue -> (Ptr GValue -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GValue
gvalue ((Ptr GValue -> IO ()) -> IO ()) -> (Ptr GValue -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \gvalueptr :: Ptr GValue
gvalueptr ->
              Ptr a -> CString -> Ptr GValue -> IO ()
forall a. Ptr a -> CString -> Ptr GValue -> IO ()
g_object_set_property Ptr a
objPtr CString
cPropName Ptr GValue
gvalueptr

foreign import ccall "g_object_get_property" g_object_get_property ::
    Ptr a -> CString -> Ptr GValue -> IO ()

getObjectProperty :: GObject a => a -> String ->
                     (GValue -> IO b) -> GType -> IO b
getObjectProperty :: a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty obj :: a
obj propName :: String
propName getter :: GValue -> IO b
getter gtype :: GType
gtype = do
  GValue
gvalue <- GType -> IO GValue
newGValue GType
gtype
  a -> (Ptr a -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr a
obj ((Ptr a -> IO ()) -> IO ()) -> (Ptr a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \objPtr :: Ptr a
objPtr ->
      String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
propName ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \cPropName :: CString
cPropName ->
          GValue -> (Ptr GValue -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GValue
gvalue ((Ptr GValue -> IO ()) -> IO ()) -> (Ptr GValue -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \gvalueptr :: Ptr GValue
gvalueptr ->
              Ptr a -> CString -> Ptr GValue -> IO ()
forall a. Ptr a -> CString -> Ptr GValue -> IO ()
g_object_get_property Ptr a
objPtr CString
cPropName Ptr GValue
gvalueptr
  GValue -> IO b
getter GValue
gvalue

constructObjectProperty :: String -> b -> (GValue -> b -> IO ()) ->
                           GType -> IO (GValueConstruct o)
constructObjectProperty :: String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty propName :: String
propName propValue :: b
propValue setter :: GValue -> b -> IO ()
setter gtype :: GType
gtype = do
  GValue
gvalue <- GType -> (GValue -> b -> IO ()) -> b -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
buildGValue GType
gtype GValue -> b -> IO ()
setter b
propValue
  GValueConstruct o -> IO (GValueConstruct o)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> GValue -> GValueConstruct o
forall o. String -> GValue -> GValueConstruct o
GValueConstruct String
propName GValue
gvalue)

setObjectPropertyString :: GObject a =>
                           a -> String -> Maybe Text -> IO ()
setObjectPropertyString :: a -> String -> Maybe Text -> IO ()
setObjectPropertyString obj :: a
obj propName :: String
propName str :: Maybe Text
str =
    a
-> String
-> Maybe Text
-> (GValue -> Maybe Text -> IO ())
-> GType
-> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Maybe Text
str GValue -> Maybe Text -> IO ()
set_string GType
gtypeString

constructObjectPropertyString :: String -> Maybe Text ->
                                 IO (GValueConstruct o)
constructObjectPropertyString :: String -> Maybe Text -> IO (GValueConstruct o)
constructObjectPropertyString propName :: String
propName str :: Maybe Text
str =
    String
-> Maybe Text
-> (GValue -> Maybe Text -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Maybe Text
str GValue -> Maybe Text -> IO ()
set_string GType
gtypeString

getObjectPropertyString :: GObject a =>
                           a -> String -> IO (Maybe Text)
getObjectPropertyString :: a -> String -> IO (Maybe Text)
getObjectPropertyString obj :: a
obj propName :: String
propName =
    a
-> String
-> (GValue -> IO (Maybe Text))
-> GType
-> IO (Maybe Text)
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO (Maybe Text)
get_string GType
gtypeString

setObjectPropertyPtr :: GObject a =>
                        a -> String -> Ptr b -> IO ()
setObjectPropertyPtr :: a -> String -> Ptr b -> IO ()
setObjectPropertyPtr obj :: a
obj propName :: String
propName ptr :: Ptr b
ptr =
    a
-> String -> Ptr b -> (GValue -> Ptr b -> IO ()) -> GType -> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Ptr b
ptr GValue -> Ptr b -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_pointer GType
gtypePointer

constructObjectPropertyPtr :: String -> Ptr b ->
                              IO (GValueConstruct o)
constructObjectPropertyPtr :: String -> Ptr b -> IO (GValueConstruct o)
constructObjectPropertyPtr propName :: String
propName ptr :: Ptr b
ptr =
    String
-> Ptr b
-> (GValue -> Ptr b -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Ptr b
ptr GValue -> Ptr b -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_pointer GType
gtypePointer

getObjectPropertyPtr :: GObject a =>
                        a -> String -> IO (Ptr b)
getObjectPropertyPtr :: a -> String -> IO (Ptr b)
getObjectPropertyPtr obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO (Ptr b)) -> GType -> IO (Ptr b)
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO (Ptr b)
forall b. GValue -> IO (Ptr b)
get_pointer GType
gtypePointer

setObjectPropertyInt :: GObject a =>
                         a -> String -> CInt -> IO ()
setObjectPropertyInt :: a -> String -> CInt -> IO ()
setObjectPropertyInt obj :: a
obj propName :: String
propName int :: CInt
int =
    a -> String -> CInt -> (GValue -> CInt -> IO ()) -> GType -> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName CInt
int GValue -> CInt -> IO ()
set_int GType
gtypeInt

constructObjectPropertyInt :: String -> CInt ->
                              IO (GValueConstruct o)
constructObjectPropertyInt :: String -> CInt -> IO (GValueConstruct o)
constructObjectPropertyInt propName :: String
propName int :: CInt
int =
    String
-> CInt
-> (GValue -> CInt -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName CInt
int GValue -> CInt -> IO ()
set_int GType
gtypeInt

getObjectPropertyInt :: GObject a => a -> String -> IO CInt
getObjectPropertyInt :: a -> String -> IO CInt
getObjectPropertyInt obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO CInt) -> GType -> IO CInt
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO CInt
get_int GType
gtypeInt

setObjectPropertyUInt :: GObject a =>
                          a -> String -> CUInt -> IO ()
setObjectPropertyUInt :: a -> String -> CUInt -> IO ()
setObjectPropertyUInt obj :: a
obj propName :: String
propName uint :: CUInt
uint =
    a
-> String -> CUInt -> (GValue -> CUInt -> IO ()) -> GType -> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName CUInt
uint GValue -> CUInt -> IO ()
set_uint GType
gtypeUInt

constructObjectPropertyUInt :: String -> CUInt ->
                                IO (GValueConstruct o)
constructObjectPropertyUInt :: String -> CUInt -> IO (GValueConstruct o)
constructObjectPropertyUInt propName :: String
propName uint :: CUInt
uint =
    String
-> CUInt
-> (GValue -> CUInt -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName CUInt
uint GValue -> CUInt -> IO ()
set_uint GType
gtypeUInt

getObjectPropertyUInt :: GObject a => a -> String -> IO CUInt
getObjectPropertyUInt :: a -> String -> IO CUInt
getObjectPropertyUInt obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO CUInt) -> GType -> IO CUInt
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO CUInt
get_uint GType
gtypeUInt

setObjectPropertyLong :: GObject a =>
                         a -> String -> CLong -> IO ()
setObjectPropertyLong :: a -> String -> CLong -> IO ()
setObjectPropertyLong obj :: a
obj propName :: String
propName int :: CLong
int =
    a
-> String -> CLong -> (GValue -> CLong -> IO ()) -> GType -> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName CLong
int GValue -> CLong -> IO ()
set_long GType
gtypeLong

constructObjectPropertyLong :: String -> CLong ->
                               IO (GValueConstruct o)
constructObjectPropertyLong :: String -> CLong -> IO (GValueConstruct o)
constructObjectPropertyLong propName :: String
propName int :: CLong
int =
    String
-> CLong
-> (GValue -> CLong -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName CLong
int GValue -> CLong -> IO ()
set_long GType
gtypeLong

getObjectPropertyLong :: GObject a => a -> String -> IO CLong
getObjectPropertyLong :: a -> String -> IO CLong
getObjectPropertyLong obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO CLong) -> GType -> IO CLong
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO CLong
get_long GType
gtypeLong

setObjectPropertyULong :: GObject a =>
                          a -> String -> CULong -> IO ()
setObjectPropertyULong :: a -> String -> CULong -> IO ()
setObjectPropertyULong obj :: a
obj propName :: String
propName uint :: CULong
uint =
    a
-> String
-> CULong
-> (GValue -> CULong -> IO ())
-> GType
-> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName CULong
uint GValue -> CULong -> IO ()
set_ulong GType
gtypeULong

constructObjectPropertyULong :: String -> CULong ->
                                IO (GValueConstruct o)
constructObjectPropertyULong :: String -> CULong -> IO (GValueConstruct o)
constructObjectPropertyULong propName :: String
propName uint :: CULong
uint =
    String
-> CULong
-> (GValue -> CULong -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName CULong
uint GValue -> CULong -> IO ()
set_ulong GType
gtypeULong

getObjectPropertyULong :: GObject a => a -> String -> IO CULong
getObjectPropertyULong :: a -> String -> IO CULong
getObjectPropertyULong obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO CULong) -> GType -> IO CULong
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO CULong
get_ulong GType
gtypeULong

setObjectPropertyInt32 :: GObject a =>
                          a -> String -> Int32 -> IO ()
setObjectPropertyInt32 :: a -> String -> Int32 -> IO ()
setObjectPropertyInt32 obj :: a
obj propName :: String
propName int32 :: Int32
int32 =
    a
-> String -> Int32 -> (GValue -> Int32 -> IO ()) -> GType -> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Int32
int32 GValue -> Int32 -> IO ()
set_int32 GType
gtypeInt

constructObjectPropertyInt32 :: String -> Int32 ->
                                IO (GValueConstruct o)
constructObjectPropertyInt32 :: String -> Int32 -> IO (GValueConstruct o)
constructObjectPropertyInt32 propName :: String
propName int32 :: Int32
int32 =
    String
-> Int32
-> (GValue -> Int32 -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Int32
int32 GValue -> Int32 -> IO ()
set_int32 GType
gtypeInt

getObjectPropertyInt32 :: GObject a => a -> String -> IO Int32
getObjectPropertyInt32 :: a -> String -> IO Int32
getObjectPropertyInt32 obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO Int32) -> GType -> IO Int32
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO Int32
get_int32 GType
gtypeInt

setObjectPropertyUInt32 :: GObject a =>
                          a -> String -> Word32 -> IO ()
setObjectPropertyUInt32 :: a -> String -> Word32 -> IO ()
setObjectPropertyUInt32 obj :: a
obj propName :: String
propName uint32 :: Word32
uint32 =
    a
-> String
-> Word32
-> (GValue -> Word32 -> IO ())
-> GType
-> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Word32
uint32 GValue -> Word32 -> IO ()
set_uint32 GType
gtypeUInt

constructObjectPropertyUInt32 :: String -> Word32 ->
                                 IO (GValueConstruct o)
constructObjectPropertyUInt32 :: String -> Word32 -> IO (GValueConstruct o)
constructObjectPropertyUInt32 propName :: String
propName uint32 :: Word32
uint32 =
    String
-> Word32
-> (GValue -> Word32 -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Word32
uint32 GValue -> Word32 -> IO ()
set_uint32 GType
gtypeUInt

getObjectPropertyUInt32 :: GObject a => a -> String -> IO Word32
getObjectPropertyUInt32 :: a -> String -> IO Word32
getObjectPropertyUInt32 obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO Word32) -> GType -> IO Word32
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO Word32
get_uint32 GType
gtypeUInt

setObjectPropertyInt64 :: GObject a =>
                          a -> String -> Int64 -> IO ()
setObjectPropertyInt64 :: a -> String -> Int64 -> IO ()
setObjectPropertyInt64 obj :: a
obj propName :: String
propName int64 :: Int64
int64 =
    a
-> String -> Int64 -> (GValue -> Int64 -> IO ()) -> GType -> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Int64
int64 GValue -> Int64 -> IO ()
set_int64 GType
gtypeInt64

constructObjectPropertyInt64 :: String -> Int64 ->
                                IO (GValueConstruct o)
constructObjectPropertyInt64 :: String -> Int64 -> IO (GValueConstruct o)
constructObjectPropertyInt64 propName :: String
propName int64 :: Int64
int64 =
    String
-> Int64
-> (GValue -> Int64 -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Int64
int64 GValue -> Int64 -> IO ()
set_int64 GType
gtypeInt64

getObjectPropertyInt64 :: GObject a => a -> String -> IO Int64
getObjectPropertyInt64 :: a -> String -> IO Int64
getObjectPropertyInt64 obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO Int64) -> GType -> IO Int64
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO Int64
get_int64 GType
gtypeInt64

setObjectPropertyUInt64 :: GObject a =>
                          a -> String -> Word64 -> IO ()
setObjectPropertyUInt64 :: a -> String -> CGType -> IO ()
setObjectPropertyUInt64 obj :: a
obj propName :: String
propName uint64 :: CGType
uint64 =
    a
-> String
-> CGType
-> (GValue -> CGType -> IO ())
-> GType
-> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName CGType
uint64 GValue -> CGType -> IO ()
set_uint64 GType
gtypeUInt64

constructObjectPropertyUInt64 :: String -> Word64 ->
                                 IO (GValueConstruct o)
constructObjectPropertyUInt64 :: String -> CGType -> IO (GValueConstruct o)
constructObjectPropertyUInt64 propName :: String
propName uint64 :: CGType
uint64 =
    String
-> CGType
-> (GValue -> CGType -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName CGType
uint64 GValue -> CGType -> IO ()
set_uint64 GType
gtypeUInt64

getObjectPropertyUInt64 :: GObject a => a -> String -> IO Word64
getObjectPropertyUInt64 :: a -> String -> IO CGType
getObjectPropertyUInt64 obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO CGType) -> GType -> IO CGType
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO CGType
get_uint64 GType
gtypeUInt64

setObjectPropertyFloat :: GObject a =>
                           a -> String -> Float -> IO ()
setObjectPropertyFloat :: a -> String -> Float -> IO ()
setObjectPropertyFloat obj :: a
obj propName :: String
propName float :: Float
float =
    a
-> String -> Float -> (GValue -> Float -> IO ()) -> GType -> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Float
float GValue -> Float -> IO ()
set_float GType
gtypeFloat

constructObjectPropertyFloat :: String -> Float ->
                                 IO (GValueConstruct o)
constructObjectPropertyFloat :: String -> Float -> IO (GValueConstruct o)
constructObjectPropertyFloat propName :: String
propName float :: Float
float =
    String
-> Float
-> (GValue -> Float -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Float
float GValue -> Float -> IO ()
set_float GType
gtypeFloat

getObjectPropertyFloat :: GObject a =>
                           a -> String -> IO Float
getObjectPropertyFloat :: a -> String -> IO Float
getObjectPropertyFloat obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO Float) -> GType -> IO Float
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO Float
get_float GType
gtypeFloat

setObjectPropertyDouble :: GObject a =>
                            a -> String -> Double -> IO ()
setObjectPropertyDouble :: a -> String -> Double -> IO ()
setObjectPropertyDouble obj :: a
obj propName :: String
propName double :: Double
double =
    a
-> String
-> Double
-> (GValue -> Double -> IO ())
-> GType
-> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Double
double GValue -> Double -> IO ()
set_double GType
gtypeDouble

constructObjectPropertyDouble :: String -> Double ->
                                  IO (GValueConstruct o)
constructObjectPropertyDouble :: String -> Double -> IO (GValueConstruct o)
constructObjectPropertyDouble propName :: String
propName double :: Double
double =
    String
-> Double
-> (GValue -> Double -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Double
double GValue -> Double -> IO ()
set_double GType
gtypeDouble

getObjectPropertyDouble :: GObject a =>
                            a -> String -> IO Double
getObjectPropertyDouble :: a -> String -> IO Double
getObjectPropertyDouble obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO Double) -> GType -> IO Double
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO Double
get_double GType
gtypeDouble

setObjectPropertyBool :: GObject a =>
                         a -> String -> Bool -> IO ()
setObjectPropertyBool :: a -> String -> Bool -> IO ()
setObjectPropertyBool obj :: a
obj propName :: String
propName bool :: Bool
bool =
    a -> String -> Bool -> (GValue -> Bool -> IO ()) -> GType -> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Bool
bool GValue -> Bool -> IO ()
set_boolean GType
gtypeBoolean

constructObjectPropertyBool :: String -> Bool -> IO (GValueConstruct o)
constructObjectPropertyBool :: String -> Bool -> IO (GValueConstruct o)
constructObjectPropertyBool propName :: String
propName bool :: Bool
bool =
    String
-> Bool
-> (GValue -> Bool -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Bool
bool GValue -> Bool -> IO ()
set_boolean GType
gtypeBoolean

getObjectPropertyBool :: GObject a => a -> String -> IO Bool
getObjectPropertyBool :: a -> String -> IO Bool
getObjectPropertyBool obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO Bool) -> GType -> IO Bool
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO Bool
get_boolean GType
gtypeBoolean

setObjectPropertyGType :: GObject a =>
                         a -> String -> GType -> IO ()
setObjectPropertyGType :: a -> String -> GType -> IO ()
setObjectPropertyGType obj :: a
obj propName :: String
propName gtype :: GType
gtype =
    a
-> String -> GType -> (GValue -> GType -> IO ()) -> GType -> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName GType
gtype GValue -> GType -> IO ()
set_gtype GType
gtypeGType

constructObjectPropertyGType :: String -> GType -> IO (GValueConstruct o)
constructObjectPropertyGType :: String -> GType -> IO (GValueConstruct o)
constructObjectPropertyGType propName :: String
propName bool :: GType
bool =
    String
-> GType
-> (GValue -> GType -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName GType
bool GValue -> GType -> IO ()
set_gtype GType
gtypeGType

getObjectPropertyGType :: GObject a => a -> String -> IO GType
getObjectPropertyGType :: a -> String -> IO GType
getObjectPropertyGType obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO GType) -> GType -> IO GType
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO GType
get_gtype GType
gtypeGType

setObjectPropertyObject :: forall a b. (GObject a, GObject b) =>
                           a -> String -> Maybe b -> IO ()
setObjectPropertyObject :: a -> String -> Maybe b -> IO ()
setObjectPropertyObject obj :: a
obj propName :: String
propName maybeObject :: Maybe b
maybeObject = do
  GType
gtype <- GObject b => IO GType
forall a. GObject a => IO GType
gobjectType @b
  Maybe b -> (Ptr b -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
Maybe a -> (Ptr a -> IO c) -> IO c
maybeWithManagedPtr Maybe b
maybeObject ((Ptr b -> IO ()) -> IO ()) -> (Ptr b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \objectPtr :: Ptr b
objectPtr ->
      a
-> String -> Ptr b -> (GValue -> Ptr b -> IO ()) -> GType -> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Ptr b
objectPtr GValue -> Ptr b -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
set_object GType
gtype

constructObjectPropertyObject :: forall a o. GObject a =>
                                 String -> Maybe a -> IO (GValueConstruct o)
constructObjectPropertyObject :: String -> Maybe a -> IO (GValueConstruct o)
constructObjectPropertyObject propName :: String
propName maybeObject :: Maybe a
maybeObject = do
  GType
gtype <- GObject a => IO GType
forall a. GObject a => IO GType
gobjectType @a
  Maybe a
-> (Ptr a -> IO (GValueConstruct o)) -> IO (GValueConstruct o)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
Maybe a -> (Ptr a -> IO c) -> IO c
maybeWithManagedPtr Maybe a
maybeObject ((Ptr a -> IO (GValueConstruct o)) -> IO (GValueConstruct o))
-> (Ptr a -> IO (GValueConstruct o)) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ \objectPtr :: Ptr a
objectPtr ->
      String
-> Ptr a
-> (GValue -> Ptr a -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Ptr a
objectPtr GValue -> Ptr a -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
set_object GType
gtype

getObjectPropertyObject :: forall a b. (GObject a, GObject b) =>
                           a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
getObjectPropertyObject :: a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
getObjectPropertyObject obj :: a
obj propName :: String
propName constructor :: ManagedPtr b -> b
constructor = do
  GType
gtype <- GObject b => IO GType
forall a. GObject a => IO GType
gobjectType @b
  a -> String -> (GValue -> IO (Maybe b)) -> GType -> IO (Maybe b)
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName
                        (\val :: GValue
val -> (GValue -> IO (Ptr b)
forall b. GObject b => GValue -> IO (Ptr b)
get_object GValue
val :: IO (Ptr b))
                            IO (Ptr b) -> (Ptr b -> IO (Maybe b)) -> IO (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr b -> (Ptr b -> IO b) -> IO (Maybe b))
-> (Ptr b -> IO b) -> Ptr b -> IO (Maybe b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr b -> (Ptr b -> IO b) -> IO (Maybe b)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull ((ManagedPtr b -> b) -> Ptr b -> IO b
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr b -> b
constructor))
                      GType
gtype

setObjectPropertyBoxed :: forall a b. (GObject a, BoxedObject b) =>
                          a -> String -> Maybe b -> IO ()
setObjectPropertyBoxed :: a -> String -> Maybe b -> IO ()
setObjectPropertyBoxed obj :: a
obj propName :: String
propName maybeBoxed :: Maybe b
maybeBoxed = do
  GType
gtype <- b -> IO GType
forall a. BoxedObject a => a -> IO GType
boxedType (b
forall a. HasCallStack => a
undefined :: b)
  Maybe b -> (Ptr b -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
Maybe a -> (Ptr a -> IO c) -> IO c
maybeWithManagedPtr Maybe b
maybeBoxed ((Ptr b -> IO ()) -> IO ()) -> (Ptr b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \boxedPtr :: Ptr b
boxedPtr ->
        a
-> String -> Ptr b -> (GValue -> Ptr b -> IO ()) -> GType -> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Ptr b
boxedPtr GValue -> Ptr b -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_boxed GType
gtype

constructObjectPropertyBoxed :: forall a o. (BoxedObject a) =>
                                String -> Maybe a -> IO (GValueConstruct o)
constructObjectPropertyBoxed :: String -> Maybe a -> IO (GValueConstruct o)
constructObjectPropertyBoxed propName :: String
propName maybeBoxed :: Maybe a
maybeBoxed = do
  GType
gtype <- a -> IO GType
forall a. BoxedObject a => a -> IO GType
boxedType (a
forall a. HasCallStack => a
undefined :: a)
  Maybe a
-> (Ptr a -> IO (GValueConstruct o)) -> IO (GValueConstruct o)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
Maybe a -> (Ptr a -> IO c) -> IO c
maybeWithManagedPtr Maybe a
maybeBoxed ((Ptr a -> IO (GValueConstruct o)) -> IO (GValueConstruct o))
-> (Ptr a -> IO (GValueConstruct o)) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ \boxedPtr :: Ptr a
boxedPtr ->
      String
-> Ptr a
-> (GValue -> Ptr a -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Ptr a
boxedPtr GValue -> Ptr a -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_boxed GType
gtype

getObjectPropertyBoxed :: forall a b. (GObject a, BoxedObject b) =>
                          a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
getObjectPropertyBoxed :: a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
getObjectPropertyBoxed obj :: a
obj propName :: String
propName constructor :: ManagedPtr b -> b
constructor = do
  GType
gtype <- b -> IO GType
forall a. BoxedObject a => a -> IO GType
boxedType (b
forall a. HasCallStack => a
undefined :: b)
  a -> String -> (GValue -> IO (Maybe b)) -> GType -> IO (Maybe b)
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName (GValue -> IO (Ptr b)
forall b. GValue -> IO (Ptr b)
get_boxed (GValue -> IO (Ptr b))
-> (Ptr b -> IO (Maybe b)) -> GValue -> IO (Maybe b)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
                                  (Ptr b -> (Ptr b -> IO b) -> IO (Maybe b))
-> (Ptr b -> IO b) -> Ptr b -> IO (Maybe b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr b -> (Ptr b -> IO b) -> IO (Maybe b)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull ((ManagedPtr b -> b) -> Ptr b -> IO b
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr b -> b
constructor))
                    GType
gtype

setObjectPropertyStringArray :: GObject a =>
                                a -> String -> Maybe [Text] -> IO ()
setObjectPropertyStringArray :: a -> String -> Maybe [Text] -> IO ()
setObjectPropertyStringArray obj :: a
obj propName :: String
propName Nothing =
  a
-> String
-> Ptr Any
-> (GValue -> Ptr Any -> IO ())
-> GType
-> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Ptr Any
forall a. Ptr a
nullPtr GValue -> Ptr Any -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_boxed GType
gtypeStrv
setObjectPropertyStringArray obj :: a
obj propName :: String
propName (Just strv :: [Text]
strv) = do
  Ptr CString
cStrv <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
strv
  a
-> String
-> Ptr CString
-> (GValue -> Ptr CString -> IO ())
-> GType
-> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Ptr CString
cStrv GValue -> Ptr CString -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_boxed GType
gtypeStrv
  (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
cStrv
  Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
cStrv

constructObjectPropertyStringArray :: String -> Maybe [Text] ->
                                      IO (GValueConstruct o)
constructObjectPropertyStringArray :: String -> Maybe [Text] -> IO (GValueConstruct o)
constructObjectPropertyStringArray propName :: String
propName Nothing =
  String
-> Ptr Any
-> (GValue -> Ptr Any -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Ptr Any
forall a. Ptr a
nullPtr GValue -> Ptr Any -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_boxed GType
gtypeStrv
constructObjectPropertyStringArray propName :: String
propName (Just strv :: [Text]
strv) = do
  Ptr CString
cStrv <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
strv
  GValueConstruct o
result <- String
-> Ptr CString
-> (GValue -> Ptr CString -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Ptr CString
cStrv GValue -> Ptr CString -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_boxed GType
gtypeStrv
  (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
cStrv
  Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
cStrv
  GValueConstruct o -> IO (GValueConstruct o)
forall (m :: * -> *) a. Monad m => a -> m a
return GValueConstruct o
result

getObjectPropertyStringArray :: GObject a => a -> String -> IO (Maybe [Text])
getObjectPropertyStringArray :: a -> String -> IO (Maybe [Text])
getObjectPropertyStringArray obj :: a
obj propName :: String
propName =
    a
-> String
-> (GValue -> IO (Maybe [Text]))
-> GType
-> IO (Maybe [Text])
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName
                      (GValue -> IO (Ptr CString)
forall b. GValue -> IO (Ptr b)
get_boxed (GValue -> IO (Ptr CString))
-> (Ptr CString -> IO (Maybe [Text]))
-> GValue
-> IO (Maybe [Text])
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
                       (Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> Ptr CString -> IO (Maybe [Text])
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray)
                      GType
gtypeStrv

setObjectPropertyEnum :: (GObject a, Enum b, BoxedEnum b) =>
                         a -> String -> b -> IO ()
setObjectPropertyEnum :: a -> String -> b -> IO ()
setObjectPropertyEnum obj :: a
obj propName :: String
propName enum :: b
enum = do
  GType
gtype <- b -> IO GType
forall a. BoxedEnum a => a -> IO GType
boxedEnumType b
enum
  let cEnum :: CUInt
cEnum = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (b -> Int) -> b -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int
forall a. Enum a => a -> Int
fromEnum) b
enum
  a
-> String -> CUInt -> (GValue -> CUInt -> IO ()) -> GType -> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName CUInt
cEnum GValue -> CUInt -> IO ()
set_enum GType
gtype

constructObjectPropertyEnum :: (Enum a, BoxedEnum a) =>
                               String -> a -> IO (GValueConstruct o)
constructObjectPropertyEnum :: String -> a -> IO (GValueConstruct o)
constructObjectPropertyEnum propName :: String
propName enum :: a
enum = do
  GType
gtype <- a -> IO GType
forall a. BoxedEnum a => a -> IO GType
boxedEnumType a
enum
  let cEnum :: CUInt
cEnum = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (a -> Int) -> a -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum) a
enum
  String
-> CUInt
-> (GValue -> CUInt -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName CUInt
cEnum GValue -> CUInt -> IO ()
set_enum GType
gtype

getObjectPropertyEnum :: forall a b. (GObject a,
                                      Enum b, BoxedEnum b) =>
                         a -> String -> IO b
getObjectPropertyEnum :: a -> String -> IO b
getObjectPropertyEnum obj :: a
obj propName :: String
propName = do
  GType
gtype <- b -> IO GType
forall a. BoxedEnum a => a -> IO GType
boxedEnumType (b
forall a. HasCallStack => a
undefined :: b)
  a -> String -> (GValue -> IO b) -> GType -> IO b
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName
                    (\val :: GValue
val -> Int -> b
forall a. Enum a => Int -> a
toEnum (Int -> b) -> (CUInt -> Int) -> CUInt -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> b) -> IO CUInt -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GValue -> IO CUInt
get_enum GValue
val)
                    GType
gtype

setObjectPropertyFlags :: forall a b. (IsGFlag b, BoxedFlags b, GObject a) =>
                          a -> String -> [b] -> IO ()
setObjectPropertyFlags :: a -> String -> [b] -> IO ()
setObjectPropertyFlags obj :: a
obj propName :: String
propName flags :: [b]
flags = do
  let cFlags :: CUInt
cFlags = [b] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [b]
flags
  GType
gtype <- Proxy b -> IO GType
forall a. BoxedFlags a => Proxy a -> IO GType
boxedFlagsType (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)
  a
-> String -> CUInt -> (GValue -> CUInt -> IO ()) -> GType -> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName CUInt
cFlags GValue -> CUInt -> IO ()
set_flags GType
gtype

constructObjectPropertyFlags :: forall a o. (IsGFlag a, BoxedFlags a)
                                => String -> [a] -> IO (GValueConstruct o)
constructObjectPropertyFlags :: String -> [a] -> IO (GValueConstruct o)
constructObjectPropertyFlags propName :: String
propName flags :: [a]
flags = do
  let cFlags :: CUInt
cFlags = [a] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [a]
flags
  GType
gtype <- Proxy a -> IO GType
forall a. BoxedFlags a => Proxy a -> IO GType
boxedFlagsType (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
  String
-> CUInt
-> (GValue -> CUInt -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName CUInt
cFlags GValue -> CUInt -> IO ()
set_flags GType
gtype

getObjectPropertyFlags :: forall a b. (GObject a, IsGFlag b, BoxedFlags b) =>
                          a -> String -> IO [b]
getObjectPropertyFlags :: a -> String -> IO [b]
getObjectPropertyFlags obj :: a
obj propName :: String
propName = do
  GType
gtype <- Proxy b -> IO GType
forall a. BoxedFlags a => Proxy a -> IO GType
boxedFlagsType (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b)
  a -> String -> (GValue -> IO [b]) -> GType -> IO [b]
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName
                        (\val :: GValue
val -> CUInt -> [b]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags (CUInt -> [b]) -> IO CUInt -> IO [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GValue -> IO CUInt
get_flags GValue
val)
                        GType
gtype

setObjectPropertyClosure :: forall a b. GObject a =>
                          a -> String -> Maybe (GClosure b) -> IO ()
setObjectPropertyClosure :: a -> String -> Maybe (GClosure b) -> IO ()
setObjectPropertyClosure = a -> String -> Maybe (GClosure b) -> IO ()
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> Maybe b -> IO ()
setObjectPropertyBoxed

constructObjectPropertyClosure :: String -> Maybe (GClosure a) -> IO (GValueConstruct o)
constructObjectPropertyClosure :: String -> Maybe (GClosure a) -> IO (GValueConstruct o)
constructObjectPropertyClosure = String -> Maybe (GClosure a) -> IO (GValueConstruct o)
forall a o.
BoxedObject a =>
String -> Maybe a -> IO (GValueConstruct o)
constructObjectPropertyBoxed

getObjectPropertyClosure :: forall a b. GObject a =>
                            a -> String -> IO (Maybe (GClosure b))
getObjectPropertyClosure :: a -> String -> IO (Maybe (GClosure b))
getObjectPropertyClosure obj :: a
obj propName :: String
propName =
  a
-> String
-> (ManagedPtr (GClosure b) -> GClosure b)
-> IO (Maybe (GClosure b))
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
getObjectPropertyBoxed a
obj String
propName ManagedPtr (GClosure b) -> GClosure b
forall a. ManagedPtr (GClosure a) -> GClosure a
GClosure

setObjectPropertyVariant :: GObject a =>
                            a -> String -> Maybe GVariant -> IO ()
setObjectPropertyVariant :: a -> String -> Maybe GVariant -> IO ()
setObjectPropertyVariant obj :: a
obj propName :: String
propName maybeVariant :: Maybe GVariant
maybeVariant =
    Maybe GVariant -> (Ptr GVariant -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
Maybe a -> (Ptr a -> IO c) -> IO c
maybeWithManagedPtr Maybe GVariant
maybeVariant ((Ptr GVariant -> IO ()) -> IO ())
-> (Ptr GVariant -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \variantPtr :: Ptr GVariant
variantPtr ->
        a
-> String
-> Ptr GVariant
-> (GValue -> Ptr GVariant -> IO ())
-> GType
-> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Ptr GVariant
variantPtr GValue -> Ptr GVariant -> IO ()
set_variant GType
gtypeVariant

constructObjectPropertyVariant :: String -> Maybe GVariant
                               -> IO (GValueConstruct o)
constructObjectPropertyVariant :: String -> Maybe GVariant -> IO (GValueConstruct o)
constructObjectPropertyVariant propName :: String
propName maybeVariant :: Maybe GVariant
maybeVariant =
    Maybe GVariant
-> (Ptr GVariant -> IO (GValueConstruct o))
-> IO (GValueConstruct o)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
Maybe a -> (Ptr a -> IO c) -> IO c
maybeWithManagedPtr Maybe GVariant
maybeVariant ((Ptr GVariant -> IO (GValueConstruct o))
 -> IO (GValueConstruct o))
-> (Ptr GVariant -> IO (GValueConstruct o))
-> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ \objPtr :: Ptr GVariant
objPtr ->
        String
-> Ptr GVariant
-> (GValue -> Ptr GVariant -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Ptr GVariant
objPtr GValue -> Ptr GVariant -> IO ()
set_variant GType
gtypeVariant

getObjectPropertyVariant :: GObject a => a -> String ->
                            IO (Maybe GVariant)
getObjectPropertyVariant :: a -> String -> IO (Maybe GVariant)
getObjectPropertyVariant obj :: a
obj propName :: String
propName =
    a
-> String
-> (GValue -> IO (Maybe GVariant))
-> GType
-> IO (Maybe GVariant)
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName (GValue -> IO (Ptr GVariant)
get_variant (GValue -> IO (Ptr GVariant))
-> (Ptr GVariant -> IO (Maybe GVariant))
-> GValue
-> IO (Maybe GVariant)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
                                    (Ptr GVariant
 -> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant))
-> (Ptr GVariant -> IO GVariant)
-> Ptr GVariant
-> IO (Maybe GVariant)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr GVariant
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GVariant -> IO GVariant
newGVariantFromPtr)
                      GType
gtypeVariant

setObjectPropertyByteArray :: GObject a =>
                              a -> String -> Maybe B.ByteString -> IO ()
setObjectPropertyByteArray :: a -> String -> Maybe ByteString -> IO ()
setObjectPropertyByteArray obj :: a
obj propName :: String
propName Nothing =
    a
-> String
-> Ptr Any
-> (GValue -> Ptr Any -> IO ())
-> GType
-> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Ptr Any
forall a. Ptr a
nullPtr GValue -> Ptr Any -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_boxed GType
gtypeByteArray
setObjectPropertyByteArray obj :: a
obj propName :: String
propName (Just bytes :: ByteString
bytes) = do
  Ptr GByteArray
packed <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
bytes
  a
-> String
-> Ptr GByteArray
-> (GValue -> Ptr GByteArray -> IO ())
-> GType
-> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Ptr GByteArray
packed GValue -> Ptr GByteArray -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_boxed GType
gtypeByteArray
  Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
packed

constructObjectPropertyByteArray :: String -> Maybe B.ByteString ->
                                    IO (GValueConstruct o)
constructObjectPropertyByteArray :: String -> Maybe ByteString -> IO (GValueConstruct o)
constructObjectPropertyByteArray propName :: String
propName Nothing =
    String
-> Ptr Any
-> (GValue -> Ptr Any -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Ptr Any
forall a. Ptr a
nullPtr GValue -> Ptr Any -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_boxed GType
gtypeByteArray
constructObjectPropertyByteArray propName :: String
propName (Just bytes :: ByteString
bytes) = do
  Ptr GByteArray
packed <- ByteString -> IO (Ptr GByteArray)
packGByteArray ByteString
bytes
  GValueConstruct o
result <- String
-> Ptr GByteArray
-> (GValue -> Ptr GByteArray -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Ptr GByteArray
packed GValue -> Ptr GByteArray -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_boxed GType
gtypeByteArray
  Ptr GByteArray -> IO ()
unrefGByteArray Ptr GByteArray
packed
  GValueConstruct o -> IO (GValueConstruct o)
forall (m :: * -> *) a. Monad m => a -> m a
return GValueConstruct o
result

getObjectPropertyByteArray :: GObject a =>
                              a -> String -> IO (Maybe B.ByteString)
getObjectPropertyByteArray :: a -> String -> IO (Maybe ByteString)
getObjectPropertyByteArray obj :: a
obj propName :: String
propName =
    a
-> String
-> (GValue -> IO (Maybe ByteString))
-> GType
-> IO (Maybe ByteString)
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName (GValue -> IO (Ptr GByteArray)
forall b. GValue -> IO (Ptr b)
get_boxed (GValue -> IO (Ptr GByteArray))
-> (Ptr GByteArray -> IO (Maybe ByteString))
-> GValue
-> IO (Maybe ByteString)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
                                    (Ptr GByteArray
 -> (Ptr GByteArray -> IO ByteString) -> IO (Maybe ByteString))
-> (Ptr GByteArray -> IO ByteString)
-> Ptr GByteArray
-> IO (Maybe ByteString)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ptr GByteArray
-> (Ptr GByteArray -> IO ByteString) -> IO (Maybe ByteString)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GByteArray -> IO ByteString
unpackGByteArray)
                      GType
gtypeByteArray

setObjectPropertyPtrGList :: GObject a =>
                              a -> String -> [Ptr b] -> IO ()
setObjectPropertyPtrGList :: a -> String -> [Ptr b] -> IO ()
setObjectPropertyPtrGList obj :: a
obj propName :: String
propName ptrs :: [Ptr b]
ptrs = do
  Ptr (GList (Ptr b))
packed <- [Ptr b] -> IO (Ptr (GList (Ptr b)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr b]
ptrs
  a
-> String
-> Ptr (GList (Ptr b))
-> (GValue -> Ptr (GList (Ptr b)) -> IO ())
-> GType
-> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName Ptr (GList (Ptr b))
packed GValue -> Ptr (GList (Ptr b)) -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_boxed GType
gtypePointer
  Ptr (GList (Ptr b)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr b))
packed

constructObjectPropertyPtrGList :: String -> [Ptr a] ->
                                    IO (GValueConstruct o)
constructObjectPropertyPtrGList :: String -> [Ptr a] -> IO (GValueConstruct o)
constructObjectPropertyPtrGList propName :: String
propName ptrs :: [Ptr a]
ptrs = do
  Ptr (GList (Ptr a))
packed <- [Ptr a] -> IO (Ptr (GList (Ptr a)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr a]
ptrs
  GValueConstruct o
result <- String
-> Ptr (GList (Ptr a))
-> (GValue -> Ptr (GList (Ptr a)) -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName Ptr (GList (Ptr a))
packed GValue -> Ptr (GList (Ptr a)) -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_boxed GType
gtypePointer
  Ptr (GList (Ptr a)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr a))
packed
  GValueConstruct o -> IO (GValueConstruct o)
forall (m :: * -> *) a. Monad m => a -> m a
return GValueConstruct o
result

getObjectPropertyPtrGList :: GObject a =>
                              a -> String -> IO [Ptr b]
getObjectPropertyPtrGList :: a -> String -> IO [Ptr b]
getObjectPropertyPtrGList obj :: a
obj propName :: String
propName =
    a -> String -> (GValue -> IO [Ptr b]) -> GType -> IO [Ptr b]
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName (GValue -> IO (Ptr (GList (Ptr b)))
forall b. GValue -> IO (Ptr b)
get_pointer (GValue -> IO (Ptr (GList (Ptr b))))
-> (Ptr (GList (Ptr b)) -> IO [Ptr b]) -> GValue -> IO [Ptr b]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Ptr (GList (Ptr b)) -> IO [Ptr b]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList) GType
gtypePointer

setObjectPropertyHash :: GObject a => a -> String -> b -> IO ()
setObjectPropertyHash :: a -> String -> b -> IO ()
setObjectPropertyHash =
    String -> a -> String -> b -> IO ()
forall a. HasCallStack => String -> a
error (String -> a -> String -> b -> IO ())
-> String -> a -> String -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ "Setting GHashTable properties not supported yet."

constructObjectPropertyHash :: String -> b -> IO (GValueConstruct o)
constructObjectPropertyHash :: String -> b -> IO (GValueConstruct o)
constructObjectPropertyHash =
    String -> String -> b -> IO (GValueConstruct o)
forall a. HasCallStack => String -> a
error (String -> String -> b -> IO (GValueConstruct o))
-> String -> String -> b -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ "Constructing GHashTable properties not supported yet."

getObjectPropertyHash :: GObject a => a -> String -> IO b
getObjectPropertyHash :: a -> String -> IO b
getObjectPropertyHash =
    String -> a -> String -> IO b
forall a. HasCallStack => String -> a
error (String -> a -> String -> IO b) -> String -> a -> String -> IO b
forall a b. (a -> b) -> a -> b
$ "Getting GHashTable properties not supported yet."

setObjectPropertyCallback :: GObject a => a -> String -> FunPtr b -> IO ()
setObjectPropertyCallback :: a -> String -> FunPtr b -> IO ()
setObjectPropertyCallback obj :: a
obj propName :: String
propName funPtr :: FunPtr b
funPtr =
    a
-> String
-> Ptr Any
-> (GValue -> Ptr Any -> IO ())
-> GType
-> IO ()
forall a b.
GObject a =>
a -> String -> b -> (GValue -> b -> IO ()) -> GType -> IO ()
setObjectProperty a
obj String
propName (FunPtr b -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr b
funPtr) GValue -> Ptr Any -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_pointer GType
gtypePointer

constructObjectPropertyCallback :: String -> FunPtr b -> IO (GValueConstruct o)
constructObjectPropertyCallback :: String -> FunPtr b -> IO (GValueConstruct o)
constructObjectPropertyCallback propName :: String
propName funPtr :: FunPtr b
funPtr =
  String
-> Ptr Any
-> (GValue -> Ptr Any -> IO ())
-> GType
-> IO (GValueConstruct o)
forall b o.
String
-> b -> (GValue -> b -> IO ()) -> GType -> IO (GValueConstruct o)
constructObjectProperty String
propName (FunPtr b -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr b
funPtr) GValue -> Ptr Any -> IO ()
forall a. GValue -> Ptr a -> IO ()
set_pointer GType
gtypePointer

getObjectPropertyCallback :: GObject a => a -> String ->
                             (FunPtr b -> c) -> IO (Maybe c)
getObjectPropertyCallback :: a -> String -> (FunPtr b -> c) -> IO (Maybe c)
getObjectPropertyCallback obj :: a
obj propName :: String
propName wrapper :: FunPtr b -> c
wrapper = do
  Ptr Any
ptr <- a -> String -> (GValue -> IO (Ptr Any)) -> GType -> IO (Ptr Any)
forall a b.
GObject a =>
a -> String -> (GValue -> IO b) -> GType -> IO b
getObjectProperty a
obj String
propName GValue -> IO (Ptr Any)
forall b. GValue -> IO (Ptr b)
get_pointer GType
gtypePointer
  if Ptr Any
ptr Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Any
forall a. Ptr a
nullPtr
    then Maybe c -> IO (Maybe c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe c -> IO (Maybe c))
-> (FunPtr b -> Maybe c) -> FunPtr b -> IO (Maybe c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> (FunPtr b -> c) -> FunPtr b -> Maybe c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunPtr b -> c
wrapper (FunPtr b -> IO (Maybe c)) -> FunPtr b -> IO (Maybe c)
forall a b. (a -> b) -> a -> b
$ Ptr Any -> FunPtr b
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
ptr
    else Maybe c -> IO (Maybe c)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe c
forall a. Maybe a
Nothing

-- | Set a property of type `GError`.
setObjectPropertyGError :: forall a. GObject a =>
                          a -> String -> Maybe GError -> IO ()
setObjectPropertyGError :: a -> String -> Maybe GError -> IO ()
setObjectPropertyGError = a -> String -> Maybe GError -> IO ()
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> Maybe b -> IO ()
setObjectPropertyBoxed

-- | Construct a property of type `GError`.
constructObjectPropertyGError :: String -> Maybe GError -> IO (GValueConstruct o)
constructObjectPropertyGError :: String -> Maybe GError -> IO (GValueConstruct o)
constructObjectPropertyGError = String -> Maybe GError -> IO (GValueConstruct o)
forall a o.
BoxedObject a =>
String -> Maybe a -> IO (GValueConstruct o)
constructObjectPropertyBoxed

-- | Get the value of a property of type `GError`.
getObjectPropertyGError :: forall a. GObject a =>
                            a -> String -> IO (Maybe GError)
getObjectPropertyGError :: a -> String -> IO (Maybe GError)
getObjectPropertyGError obj :: a
obj propName :: String
propName =
  a -> String -> (ManagedPtr GError -> GError) -> IO (Maybe GError)
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
getObjectPropertyBoxed a
obj String
propName ManagedPtr GError -> GError
GError