module Data.GI.Base.Properties
( new
, PropertyNotify(..)
, GObjectNotifySignalInfo
, setObjectPropertyString
, setObjectPropertyStringArray
, setObjectPropertyPtr
, setObjectPropertyCInt
, setObjectPropertyCUInt
, setObjectPropertyInt64
, setObjectPropertyUInt64
, setObjectPropertyFloat
, setObjectPropertyDouble
, setObjectPropertyBool
, setObjectPropertyGType
, setObjectPropertyObject
, setObjectPropertyBoxed
, setObjectPropertyEnum
, setObjectPropertyFlags
, setObjectPropertyVariant
, setObjectPropertyByteArray
, setObjectPropertyPtrGList
, setObjectPropertyHash
, getObjectPropertyString
, getObjectPropertyStringArray
, getObjectPropertyPtr
, getObjectPropertyCInt
, getObjectPropertyCUInt
, getObjectPropertyInt64
, getObjectPropertyUInt64
, getObjectPropertyFloat
, getObjectPropertyDouble
, getObjectPropertyBool
, getObjectPropertyGType
, getObjectPropertyObject
, getObjectPropertyBoxed
, getObjectPropertyEnum
, getObjectPropertyFlags
, getObjectPropertyVariant
, getObjectPropertyByteArray
, getObjectPropertyPtrGList
, getObjectPropertyHash
, constructObjectPropertyString
, constructObjectPropertyStringArray
, constructObjectPropertyPtr
, constructObjectPropertyCInt
, constructObjectPropertyCUInt
, constructObjectPropertyInt64
, constructObjectPropertyUInt64
, constructObjectPropertyFloat
, constructObjectPropertyDouble
, constructObjectPropertyBool
, constructObjectPropertyGType
, constructObjectPropertyObject
, constructObjectPropertyBoxed
, constructObjectPropertyEnum
, constructObjectPropertyFlags
, constructObjectPropertyVariant
, constructObjectPropertyByteArray
, constructObjectPropertyPtrGList
, constructObjectPropertyHash
) where
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.Attributes
import Data.GI.Base.GParamSpec (newGParamSpecFromPtr)
import Data.GI.Base.GValue
import Data.GI.Base.GVariant (newGVariantFromPtr)
import Data.GI.Base.Overloading (ResolveAttribute, HasAttr)
import Data.GI.Base.Signals (SignalConnectMode, SignalHandlerId,
connectSignalFunPtr,
SignalInfo(HaskellCallbackType, connectSignal))
import GHC.Exts (Constraint)
import GHC.TypeLits
import Foreign hiding (new)
import Foreign.C
foreign import ccall "dbg_g_object_newv" g_object_newv ::
GType -> CUInt -> Ptr a -> IO (Ptr b)
new :: forall o. GObject o => (ForeignPtr o -> o) ->
[AttrOp o 'AttrConstruct] -> IO o
new constructor attrs = do
props <- mapM construct attrs
let nprops = length props
params <- mallocBytes (nprops*gparameterSize)
fill params props
gtype <- gobjectType (undefined :: o)
result <- g_object_newv gtype (fromIntegral nprops) params
freeStrings nprops params
free params
mapM_ (touchManagedPtr . snd) props
wrapObject constructor (result :: Ptr o)
where
resolve :: proxy attr -> Proxy (ResolveAttribute attr o)
resolve _ = Proxy
construct :: AttrOp o 'AttrConstruct ->
IO (String, GValue)
construct (attr := x) = attrConstruct (resolve attr) x
construct (attr :=> x) = x >>= attrConstruct (resolve attr)
gvalueSize = (24)
gparameterSize = (32)
fill :: Ptr () -> [(String, GValue)] -> IO ()
fill _ [] = return ()
fill dataPtr ((str, gvalue):xs) =
do cstr <- newCString str
poke (castPtr dataPtr) cstr
withManagedPtr gvalue $ \gvalueptr ->
copyBytes (dataPtr `plusPtr` sizeOf nullPtr) gvalueptr gvalueSize
fill (dataPtr `plusPtr` gparameterSize) xs
freeStrings :: Int -> Ptr () -> IO ()
freeStrings 0 _ = return ()
freeStrings n dataPtr =
do cstr <- peek (castPtr dataPtr) :: IO CString
free cstr
freeStrings (n1) (dataPtr `plusPtr` gparameterSize)
data PropertyNotify (s :: Symbol) (propName :: Symbol) (constraint :: * -> Constraint) where
PropertyNotify :: KnownSymbol propName => proxy propName ->
PropertyNotify "notify::[property]" propName (HasAttr propName)
data GObjectNotifySignalInfo
instance SignalInfo GObjectNotifySignalInfo where
type HaskellCallbackType GObjectNotifySignalInfo = GObjectNotifyCallback
connectSignal = connectGObjectNotify
type GObjectNotifyCallback = GParamSpec -> IO ()
gobjectNotifyCallbackWrapper ::
GObjectNotifyCallback -> Ptr () -> Ptr GParamSpec -> Ptr () -> IO ()
gobjectNotifyCallbackWrapper _cb _ pspec _ = do
pspec' <- newGParamSpecFromPtr pspec
_cb pspec'
type GObjectNotifyCallbackC = Ptr () -> Ptr GParamSpec -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkGObjectNotifyCallback :: GObjectNotifyCallbackC -> IO (FunPtr GObjectNotifyCallbackC)
connectGObjectNotify :: forall o i proxy propName constraint.
(GObject o, constraint o, KnownSymbol propName) =>
proxy (i :: *) (propName :: Symbol) (constraint :: * -> Constraint) ->
o -> GObjectNotifyCallback ->
SignalConnectMode -> IO SignalHandlerId
connectGObjectNotify _ obj cb after = do
cb' <- mkGObjectNotifyCallback (gobjectNotifyCallbackWrapper cb)
let signalName = "notify::" ++ symbolVal (Proxy :: Proxy propName)
connectSignalFunPtr obj signalName cb' after
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 obj propName propValue setter (GType gtype) = do
gvalue <- buildGValue (GType gtype) setter propValue
withManagedPtr obj $ \objPtr ->
withCString propName $ \cPropName ->
withManagedPtr gvalue $ \gvalueptr ->
g_object_set_property objPtr cPropName 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 obj propName getter gtype = do
gvalue <- newGValue gtype
withManagedPtr obj $ \objPtr ->
withCString propName $ \cPropName ->
withManagedPtr gvalue $ \gvalueptr ->
g_object_get_property objPtr cPropName gvalueptr
getter gvalue
constructObjectProperty :: String -> b -> (GValue -> b -> IO ()) ->
GType -> IO (String, GValue)
constructObjectProperty propName propValue setter gtype = do
gvalue <- buildGValue gtype setter propValue
return (propName, gvalue)
setObjectPropertyString :: GObject a =>
a -> String -> Text -> IO ()
setObjectPropertyString obj propName str =
setObjectProperty obj propName str set_string (GType 64)
constructObjectPropertyString :: String -> Text ->
IO (String, GValue)
constructObjectPropertyString propName str =
constructObjectProperty propName str set_string (GType 64)
getObjectPropertyString :: GObject a =>
a -> String -> IO Text
getObjectPropertyString obj propName =
getObjectProperty obj propName get_string (GType 64)
setObjectPropertyPtr :: GObject a =>
a -> String -> Ptr b -> IO ()
setObjectPropertyPtr obj propName ptr =
setObjectProperty obj propName ptr set_pointer (GType 68)
constructObjectPropertyPtr :: String -> Ptr b ->
IO (String, GValue)
constructObjectPropertyPtr propName ptr =
constructObjectProperty propName ptr set_pointer (GType 68)
getObjectPropertyPtr :: GObject a =>
a -> String -> IO (Ptr b)
getObjectPropertyPtr obj propName =
getObjectProperty obj propName get_pointer (GType 68)
setObjectPropertyCInt :: GObject a =>
a -> String -> Int32 -> IO ()
setObjectPropertyCInt obj propName int =
setObjectProperty obj propName int set_int32 (GType 24)
constructObjectPropertyCInt :: String -> Int32 ->
IO (String, GValue)
constructObjectPropertyCInt propName int =
constructObjectProperty propName int set_int32 (GType 24)
getObjectPropertyCInt :: GObject a => a -> String -> IO Int32
getObjectPropertyCInt obj propName =
getObjectProperty obj propName get_int32 (GType 24)
setObjectPropertyCUInt :: GObject a =>
a -> String -> Word32 -> IO ()
setObjectPropertyCUInt obj propName uint =
setObjectProperty obj propName uint set_uint32 (GType 28)
constructObjectPropertyCUInt :: String -> Word32 ->
IO (String, GValue)
constructObjectPropertyCUInt propName uint =
constructObjectProperty propName uint set_uint32 (GType 28)
getObjectPropertyCUInt :: GObject a => a -> String -> IO Word32
getObjectPropertyCUInt obj propName =
getObjectProperty obj propName get_uint32 (GType 28)
setObjectPropertyInt64 :: GObject a =>
a -> String -> Int64 -> IO ()
setObjectPropertyInt64 obj propName int64 =
setObjectProperty obj propName int64 set_int64 (GType 40)
constructObjectPropertyInt64 :: String -> Int64 ->
IO (String, GValue)
constructObjectPropertyInt64 propName int64 =
constructObjectProperty propName int64 set_int64 (GType 40)
getObjectPropertyInt64 :: GObject a => a -> String -> IO Int64
getObjectPropertyInt64 obj propName =
getObjectProperty obj propName get_int64 (GType 40)
setObjectPropertyUInt64 :: GObject a =>
a -> String -> Word64 -> IO ()
setObjectPropertyUInt64 obj propName uint64 =
setObjectProperty obj propName uint64 set_uint64 (GType 44)
constructObjectPropertyUInt64 :: String -> Word64 ->
IO (String, GValue)
constructObjectPropertyUInt64 propName uint64 =
constructObjectProperty propName uint64 set_uint64 (GType 44)
getObjectPropertyUInt64 :: GObject a => a -> String -> IO Word64
getObjectPropertyUInt64 obj propName =
getObjectProperty obj propName get_uint64 (GType 44)
setObjectPropertyFloat :: GObject a =>
a -> String -> Float -> IO ()
setObjectPropertyFloat obj propName float =
setObjectProperty obj propName float set_float (GType 56)
constructObjectPropertyFloat :: String -> Float ->
IO (String, GValue)
constructObjectPropertyFloat propName float =
constructObjectProperty propName float set_float (GType 56)
getObjectPropertyFloat :: GObject a =>
a -> String -> IO Float
getObjectPropertyFloat obj propName =
getObjectProperty obj propName get_float (GType 56)
setObjectPropertyDouble :: GObject a =>
a -> String -> Double -> IO ()
setObjectPropertyDouble obj propName double =
setObjectProperty obj propName double set_double (GType 60)
constructObjectPropertyDouble :: String -> Double ->
IO (String, GValue)
constructObjectPropertyDouble propName double =
constructObjectProperty propName double set_double (GType 60)
getObjectPropertyDouble :: GObject a =>
a -> String -> IO Double
getObjectPropertyDouble obj propName =
getObjectProperty obj propName get_double (GType 60)
setObjectPropertyBool :: GObject a =>
a -> String -> Bool -> IO ()
setObjectPropertyBool obj propName bool =
setObjectProperty obj propName bool set_boolean (GType 20)
constructObjectPropertyBool :: String -> Bool -> IO (String, GValue)
constructObjectPropertyBool propName bool =
constructObjectProperty propName bool set_boolean (GType 20)
getObjectPropertyBool :: GObject a => a -> String -> IO Bool
getObjectPropertyBool obj propName =
getObjectProperty obj propName get_boolean (GType 20)
setObjectPropertyGType :: GObject a =>
a -> String -> GType -> IO ()
setObjectPropertyGType obj propName gtype =
setObjectProperty obj propName gtype set_gtype (GType 31984224)
constructObjectPropertyGType :: String -> GType -> IO (String, GValue)
constructObjectPropertyGType propName bool =
constructObjectProperty propName bool set_gtype (GType 31984224)
getObjectPropertyGType :: GObject a => a -> String -> IO GType
getObjectPropertyGType obj propName =
getObjectProperty obj propName get_gtype (GType 31984224)
setObjectPropertyObject :: (GObject a, GObject b) =>
a -> String -> b -> IO ()
setObjectPropertyObject obj propName object = do
gtype <- gobjectType object
withManagedPtr object $ \objectPtr ->
setObjectProperty obj propName objectPtr set_object gtype
constructObjectPropertyObject :: GObject a =>
String -> a -> IO (String, GValue)
constructObjectPropertyObject propName object = do
gtype <- gobjectType object
withManagedPtr object $ \objectPtr ->
constructObjectProperty propName objectPtr set_object gtype
getObjectPropertyObject :: forall a b. (GObject a, GObject b) =>
a -> String -> (ForeignPtr b -> b) -> IO b
getObjectPropertyObject obj propName constructor = do
gtype <- gobjectType (undefined :: b)
getObjectProperty obj propName
(\val -> (get_object val :: IO (Ptr b))
>>= newObject constructor)
gtype
setObjectPropertyBoxed :: (GObject a, BoxedObject b) =>
a -> String -> b -> IO ()
setObjectPropertyBoxed obj propName boxed = do
gtype <- boxedType boxed
withManagedPtr boxed $ \boxedPtr ->
setObjectProperty obj propName boxedPtr set_boxed gtype
constructObjectPropertyBoxed :: (BoxedObject a) => String -> a ->
IO (String, GValue)
constructObjectPropertyBoxed propName boxed = do
gtype <- boxedType boxed
withManagedPtr boxed $ \boxedPtr ->
constructObjectProperty propName boxedPtr set_boxed gtype
getObjectPropertyBoxed :: forall a b. (GObject a, BoxedObject b) =>
a -> String -> (ForeignPtr b -> b) -> IO b
getObjectPropertyBoxed obj propName constructor = do
gtype <- boxedType (undefined :: b)
getObjectProperty obj propName (get_boxed >=> newBoxed constructor) gtype
setObjectPropertyStringArray :: GObject a =>
a -> String -> [Text] -> IO ()
setObjectPropertyStringArray obj propName strv = do
cStrv <- packZeroTerminatedUTF8CArray strv
setObjectProperty obj propName cStrv set_boxed (GType 31989424)
mapZeroTerminatedCArray free cStrv
free cStrv
constructObjectPropertyStringArray :: String -> [Text] ->
IO (String, GValue)
constructObjectPropertyStringArray propName strv = do
cStrv <- packZeroTerminatedUTF8CArray strv
result <- constructObjectProperty propName cStrv set_boxed (GType 31989424)
mapZeroTerminatedCArray free cStrv
free cStrv
return result
getObjectPropertyStringArray :: GObject a =>
a -> String -> IO [Text]
getObjectPropertyStringArray obj propName =
getObjectProperty obj propName
(get_boxed >=> unpackZeroTerminatedUTF8CArray . castPtr)
(GType 31989424)
setObjectPropertyEnum :: (GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
setObjectPropertyEnum obj propName enum = do
gtype <- boxedEnumType enum
let cEnum = (fromIntegral . fromEnum) enum
setObjectProperty obj propName cEnum set_enum gtype
constructObjectPropertyEnum :: (Enum a, BoxedEnum a) =>
String -> a -> IO (String, GValue)
constructObjectPropertyEnum propName enum = do
gtype <- boxedEnumType enum
let cEnum = (fromIntegral . fromEnum) enum
constructObjectProperty propName cEnum set_enum gtype
getObjectPropertyEnum :: forall a b. (GObject a,
Enum b, BoxedEnum b) =>
a -> String -> IO b
getObjectPropertyEnum obj propName = do
gtype <- boxedEnumType (undefined :: b)
getObjectProperty obj propName
(\val -> toEnum . fromIntegral <$> get_enum val)
gtype
setObjectPropertyFlags :: (IsGFlag b, GObject a) =>
a -> String -> [b] -> IO ()
setObjectPropertyFlags obj propName flags =
let cFlags = gflagsToWord flags
in setObjectProperty obj propName cFlags set_flags (GType 52)
constructObjectPropertyFlags :: IsGFlag a => String -> [a] ->
IO (String, GValue)
constructObjectPropertyFlags propName flags =
let cFlags = gflagsToWord flags
in constructObjectProperty propName cFlags set_flags (GType 52)
getObjectPropertyFlags :: (GObject a, IsGFlag b) =>
a -> String -> IO [b]
getObjectPropertyFlags obj propName =
getObjectProperty obj propName
(\val -> wordToGFlags <$> get_flags val)
(GType 52)
setObjectPropertyVariant :: GObject a =>
a -> String -> GVariant -> IO ()
setObjectPropertyVariant obj propName variant =
withManagedPtr variant $ \variantPtr ->
setObjectProperty obj propName variantPtr set_variant
(GType 84)
constructObjectPropertyVariant :: String -> GVariant -> IO (String, GValue)
constructObjectPropertyVariant propName obj =
withManagedPtr obj $ \objPtr ->
constructObjectProperty propName objPtr set_variant
(GType 84)
getObjectPropertyVariant :: GObject a => a -> String ->
IO GVariant
getObjectPropertyVariant obj propName =
getObjectProperty obj propName (get_variant >=> newGVariantFromPtr)
(GType 84)
setObjectPropertyByteArray :: GObject a =>
a -> String -> B.ByteString -> IO ()
setObjectPropertyByteArray obj propName bytes = do
packed <- packGByteArray bytes
setObjectProperty obj propName packed set_boxed (GType 31989712)
unrefGByteArray packed
constructObjectPropertyByteArray :: String -> B.ByteString ->
IO (String, GValue)
constructObjectPropertyByteArray propName bytes = do
packed <- packGByteArray bytes
result <- constructObjectProperty propName packed
set_boxed (GType 31989712)
unrefGByteArray packed
return result
getObjectPropertyByteArray :: GObject a =>
a -> String -> IO B.ByteString
getObjectPropertyByteArray obj propName =
getObjectProperty obj propName (get_boxed >=> unpackGByteArray)
(GType 31989712)
setObjectPropertyPtrGList :: GObject a =>
a -> String -> [Ptr b] -> IO ()
setObjectPropertyPtrGList obj propName ptrs = do
packed <- packGList ptrs
setObjectProperty obj propName packed set_boxed (GType 68)
g_list_free packed
constructObjectPropertyPtrGList :: String -> [Ptr a] ->
IO (String, GValue)
constructObjectPropertyPtrGList propName ptrs = do
packed <- packGList ptrs
result <- constructObjectProperty propName packed
set_boxed (GType 68)
g_list_free packed
return result
getObjectPropertyPtrGList :: GObject a =>
a -> String -> IO [Ptr b]
getObjectPropertyPtrGList obj propName =
getObjectProperty obj propName (get_pointer >=> unpackGList)
(GType 68)
setObjectPropertyHash :: GObject a => a -> String -> b -> IO ()
setObjectPropertyHash =
error $ "Setting GHashTable properties not supported yet."
constructObjectPropertyHash :: String -> b -> IO (String, GValue)
constructObjectPropertyHash =
error $ "Constructing GHashTable properties not supported yet."
getObjectPropertyHash :: GObject a => a -> String -> IO b
getObjectPropertyHash =
error $ "Getting GHashTable properties not supported yet."