{-# LINE 1 "Data/GI/Base/GObject.hsc" #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.GI.Base.GObject
(
constructGObject
, new'
, gobjectGetUserData
, gobjectSetUserData
, gobjectModifyUserData
, DerivedGObject(..)
, registerGType
, gobjectGetPrivateData
, gobjectSetPrivateData
, gobjectModifyPrivateData
, GObjectClass(..)
, gtypeFromClass
, gtypeFromInstance
, gobjectInstallProperty
, gobjectInstallCIntProperty
, gobjectInstallCStringProperty
) where
import Data.Maybe (catMaybes)
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Proxy (Proxy(..))
import Data.Coerce (coerce)
import Foreign.C (CUInt(..), CString, newCString)
import Foreign.Ptr (Ptr, FunPtr, nullPtr, castPtr, plusPtr)
import Foreign.StablePtr (newStablePtr, deRefStablePtr,
castStablePtrToPtr, castPtrToStablePtr)
import Foreign.Storable (Storable(peek, poke, pokeByteOff, sizeOf))
import Foreign (mallocBytes, copyBytes, free)
{-# LINE 57 "Data/GI/Base/GObject.hsc" #-}
import Data.Text (Text)
import qualified Data.Text as T
import Data.GI.Base.Attributes (AttrOp(..), AttrOpTag(..), AttrLabelProxy,
attrConstruct, attrTransfer,
AttrInfo(..))
import Data.GI.Base.BasicTypes (CGType, GType(..), GObject,
GDestroyNotify, ManagedPtr(..), GParamSpec(..),
TypedObject(glibType),
gtypeName)
import Data.GI.Base.BasicConversions (withTextCString, cstringToText)
import Data.GI.Base.CallStack (HasCallStack, prettyCallStack)
import Data.GI.Base.GParamSpec (PropertyInfo(..),
gParamSpecValue,
CIntPropertyInfo(..), CStringPropertyInfo(..),
gParamSpecCInt, gParamSpecCString,
getGParamSpecGetterSetter,
PropGetSetter(..))
import Data.GI.Base.GQuark (GQuark(..), gQuarkFromString)
import Data.GI.Base.GValue (GValue(..), GValueConstruct(..))
import Data.GI.Base.ManagedPtr (withManagedPtr, touchManagedPtr, wrapObject,
newObject)
import Data.GI.Base.Overloading (ResolveAttribute)
import Data.GI.Base.Signals (on, after)
import Data.GI.Base.Utils (dbgLog)
foreign import ccall "dbg_g_object_new" g_object_new ::
GType -> CUInt -> Ptr CString -> Ptr a -> IO (Ptr b)
constructGObject :: forall o m. (GObject o, MonadIO m)
=> (ManagedPtr o -> o)
-> [AttrOp o 'AttrConstruct]
-> m o
constructGObject :: forall o (m :: * -> *).
(GObject o, MonadIO m) =>
(ManagedPtr o -> o) -> [AttrOp o 'AttrConstruct] -> m o
constructGObject ManagedPtr o -> o
constructor [AttrOp o 'AttrConstruct]
attrs = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
[GValueConstruct o]
props <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AttrOp o 'AttrConstruct -> IO (Maybe (GValueConstruct o))
construct [AttrOp o 'AttrConstruct]
attrs
o
obj <- forall o (m :: * -> *).
(GObject o, MonadIO m) =>
(ManagedPtr o -> o) -> [GValueConstruct o] -> m o
doConstructGObject ManagedPtr o -> o
constructor [GValueConstruct o]
props
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GObject o => o -> AttrOp o 'AttrConstruct -> IO ()
setSignal o
obj) [AttrOp o 'AttrConstruct]
attrs
forall (m :: * -> *) a. Monad m => a -> m a
return o
obj
where
construct :: AttrOp o 'AttrConstruct ->
IO (Maybe (GValueConstruct o))
construct :: AttrOp o 'AttrConstruct -> IO (Maybe (GValueConstruct o))
construct ((AttrLabelProxy attr
_attr :: AttrLabelProxy label) := b
x) =
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
AttrSetTypeConstraint info b) =>
b -> IO (GValueConstruct o)
attrConstruct @(ResolveAttribute label o) b
x
construct ((AttrLabelProxy attr
_attr :: AttrLabelProxy label) :=> IO b
x) =
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO b
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
AttrSetTypeConstraint info b) =>
b -> IO (GValueConstruct o)
attrConstruct @(ResolveAttribute label o))
construct ((AttrLabelProxy attr
_attr :: AttrLabelProxy label) :&= b
x) = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
AttrTransferTypeConstraint info b) =>
Proxy o -> b -> IO (AttrTransferType info)
attrTransfer @(ResolveAttribute label o) (forall {k} (t :: k). Proxy t
Proxy @o) b
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall info o b.
(AttrInfo info, AttrBaseTypeConstraint info o,
AttrSetTypeConstraint info b) =>
b -> IO (GValueConstruct o)
attrConstruct @(ResolveAttribute label o))
construct (On SignalProxy o info
_ (?self::o) => HaskellCallbackType info
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
construct (After SignalProxy o info
_ (?self::o) => HaskellCallbackType info
_) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
setSignal :: GObject o => o -> AttrOp o 'AttrConstruct -> IO ()
setSignal :: GObject o => o -> AttrOp o 'AttrConstruct -> IO ()
setSignal o
obj (On SignalProxy o info
signal (?self::o) => HaskellCallbackType info
callback) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall object info (m :: * -> *).
(GObject object, MonadIO m, SignalInfo info) =>
object
-> SignalProxy object info
-> ((?self::object) => HaskellCallbackType info)
-> m SignalHandlerId
on o
obj SignalProxy o info
signal (?self::o) => HaskellCallbackType info
callback
setSignal o
obj (After SignalProxy o info
signal (?self::o) => HaskellCallbackType info
callback) = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall object info (m :: * -> *).
(GObject object, MonadIO m, SignalInfo info) =>
object
-> SignalProxy object info
-> ((?self::object) => HaskellCallbackType info)
-> m SignalHandlerId
after o
obj SignalProxy o info
signal (?self::o) => HaskellCallbackType info
callback
setSignal o
_ AttrOp o 'AttrConstruct
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
new' :: (MonadIO m, GObject o) =>
(ManagedPtr o -> o) -> [m (GValueConstruct o)] -> m o
new' :: forall (m :: * -> *) o.
(MonadIO m, GObject o) =>
(ManagedPtr o -> o) -> [m (GValueConstruct o)] -> m o
new' ManagedPtr o -> o
constructor [m (GValueConstruct o)]
actions = do
[GValueConstruct o]
props <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [m (GValueConstruct o)]
actions
forall o (m :: * -> *).
(GObject o, MonadIO m) =>
(ManagedPtr o -> o) -> [GValueConstruct o] -> m o
doConstructGObject ManagedPtr o -> o
constructor [GValueConstruct o]
props
doConstructGObject :: forall o m. (GObject o, MonadIO m)
=> (ManagedPtr o -> o) -> [GValueConstruct o] -> m o
doConstructGObject :: forall o (m :: * -> *).
(GObject o, MonadIO m) =>
(ManagedPtr o -> o) -> [GValueConstruct o] -> m o
doConstructGObject ManagedPtr o -> o
constructor [GValueConstruct o]
props = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let nprops :: Int
nprops = forall (t :: * -> *) a. Foldable t => t a -> Int
length [GValueConstruct o]
props
Ptr CString
names <- forall a. Int -> IO (Ptr a)
mallocBytes (Int
nprops forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf forall a. Ptr a
nullPtr)
Ptr GValue
values <- forall a. Int -> IO (Ptr a)
mallocBytes (Int
nprops forall a. Num a => a -> a -> a
* Int
gvalueSize)
Ptr CString -> Ptr GValue -> [GValueConstruct o] -> IO ()
fill Ptr CString
names Ptr GValue
values [GValueConstruct o]
props
GType
gtype <- forall a. TypedObject a => IO GType
glibType @o
Ptr o
result <- forall a b. GType -> CUInt -> Ptr CString -> Ptr a -> IO (Ptr b)
g_object_new GType
gtype (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nprops) Ptr CString
names Ptr GValue
values
Int -> Ptr CString -> IO ()
freeStrings Int
nprops Ptr CString
names
forall a. Ptr a -> IO ()
free Ptr GValue
values
forall a. Ptr a -> IO ()
free Ptr CString
names
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. GValueConstruct o -> GValue
deconstructGValue) [GValueConstruct o]
props
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr o -> o
constructor (Ptr o
result :: Ptr o)
where
deconstructGValue :: GValueConstruct o -> GValue
deconstructGValue :: GValueConstruct o -> GValue
deconstructGValue (GValueConstruct String
_ GValue
v) = GValue
v
gvalueSize :: Int
gvalueSize = (Int
24)
{-# LINE 157 "Data/GI/Base/GObject.hsc" #-}
fill :: Ptr CString -> Ptr GValue -> [GValueConstruct o] -> IO ()
fill :: Ptr CString -> Ptr GValue -> [GValueConstruct o] -> IO ()
fill Ptr CString
_ Ptr GValue
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
fill Ptr CString
namePtr Ptr GValue
dataPtr ((GValueConstruct String
str GValue
gvalue):[GValueConstruct o]
xs) =
do CString
cstr <- String -> IO CString
newCString String
str
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CString
namePtr CString
cstr
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GValue
gvalue forall a b. (a -> b) -> a -> b
$ \Ptr GValue
gvalueptr ->
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr GValue
dataPtr Ptr GValue
gvalueptr Int
gvalueSize
Ptr CString -> Ptr GValue -> [GValueConstruct o] -> IO ()
fill (Ptr CString
namePtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf forall a. Ptr a
nullPtr)
(Ptr GValue
dataPtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
gvalueSize) [GValueConstruct o]
xs
freeStrings :: Int -> Ptr CString -> IO ()
freeStrings :: Int -> Ptr CString -> IO ()
freeStrings Int
0 Ptr CString
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
freeStrings Int
n Ptr CString
namePtr =
do forall a. Storable a => Ptr a -> IO a
peek Ptr CString
namePtr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Ptr a -> IO ()
free
Int -> Ptr CString -> IO ()
freeStrings (Int
nforall a. Num a => a -> a -> a
-Int
1) (Ptr CString
namePtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a. Storable a => a -> Int
sizeOf forall a. Ptr a
nullPtr)
newtype GObjectClass = GObjectClass (Ptr GObjectClass)
class GObject a => DerivedGObject a where
type GObjectParentType a
type GObjectPrivateData a
objectTypeName :: Text
objectClassInit :: GObjectClass -> IO ()
objectInstanceInit :: GObjectClass -> a -> IO (GObjectPrivateData a)
type CGTypeClassInit = GObjectClass -> IO ()
foreign import ccall "wrapper"
mkClassInit :: CGTypeClassInit -> IO (FunPtr CGTypeClassInit)
type CGTypeInstanceInit o = Ptr o -> GObjectClass -> IO ()
foreign import ccall "wrapper"
mkInstanceInit :: CGTypeInstanceInit o -> IO (FunPtr (CGTypeInstanceInit o))
foreign import ccall g_type_from_name :: CString -> IO CGType
foreign import ccall "haskell_gi_register_gtype" register_gtype ::
CGType -> CString -> FunPtr CGTypeClassInit ->
FunPtr (CGTypeInstanceInit o) -> IO CGType
foreign import ccall "haskell_gi_gtype_from_class" gtype_from_class ::
GObjectClass -> IO CGType
gtypeFromClass :: GObjectClass -> IO GType
gtypeFromClass :: GObjectClass -> IO GType
gtypeFromClass GObjectClass
klass = CGType -> GType
GType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GObjectClass -> IO CGType
gtype_from_class GObjectClass
klass
foreign import ccall "haskell_gi_gtype_from_instance" gtype_from_instance ::
Ptr o -> IO CGType
gtypeFromInstance :: GObject o => o -> IO GType
gtypeFromInstance :: forall o. GObject o => o -> IO GType
gtypeFromInstance o
obj = forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr o
obj forall a b. (a -> b) -> a -> b
$ \Ptr o
objPtr ->
(CGType -> GType
GType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall o. Ptr o -> IO CGType
gtype_from_instance Ptr o
objPtr)
foreign import ccall g_param_spec_get_name ::
Ptr GParamSpec -> IO CString
type CPropertyGetter o = Ptr o -> CUInt -> Ptr GValue -> Ptr GParamSpec -> IO ()
foreign import ccall "wrapper"
mkPropertyGetter :: CPropertyGetter o -> IO (FunPtr (CPropertyGetter o))
type CPropertySetter o = Ptr o -> CUInt -> Ptr GValue -> Ptr GParamSpec -> IO ()
foreign import ccall "wrapper"
mkPropertySetter :: CPropertySetter o -> IO (FunPtr (CPropertySetter o))
registerGType :: forall o. (HasCallStack, DerivedGObject o,
GObject (GObjectParentType o),
GObject o) =>
(ManagedPtr o -> o) -> IO GType
registerGType :: forall o.
(HasCallStack, DerivedGObject o, GObject (GObjectParentType o),
GObject o) =>
(ManagedPtr o -> o) -> IO GType
registerGType ManagedPtr o -> o
construct = forall a. Text -> (CString -> IO a) -> IO a
withTextCString (forall a. DerivedGObject a => Text
objectTypeName @o) forall a b. (a -> b) -> a -> b
$ \CString
cTypeName -> do
CGType
cgtype <- CString -> IO CGType
g_type_from_name CString
cTypeName
if CGType
cgtype forall a. Eq a => a -> a -> Bool
/= CGType
0
then forall (m :: * -> *) a. Monad m => a -> m a
return (CGType -> GType
GType CGType
cgtype)
else do
FunPtr CGTypeClassInit
classInit <- CGTypeClassInit -> IO (FunPtr CGTypeClassInit)
mkClassInit (CGTypeClassInit -> CGTypeClassInit
unwrapClassInit forall a b. (a -> b) -> a -> b
$ forall a. DerivedGObject a => CGTypeClassInit
objectClassInit @o)
FunPtr (CGTypeInstanceInit o)
instanceInit <- forall o.
CGTypeInstanceInit o -> IO (FunPtr (CGTypeInstanceInit o))
mkInstanceInit ((GObjectClass -> o -> IO (GObjectPrivateData o))
-> CGTypeInstanceInit o
unwrapInstanceInit forall a b. (a -> b) -> a -> b
$ forall a.
DerivedGObject a =>
GObjectClass -> a -> IO (GObjectPrivateData a)
objectInstanceInit @o)
(GType CGType
parentCGType) <- forall a. TypedObject a => IO GType
glibType @(GObjectParentType o)
CGType -> GType
GType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall o.
CGType
-> CString
-> FunPtr CGTypeClassInit
-> FunPtr (CGTypeInstanceInit o)
-> IO CGType
register_gtype CGType
parentCGType CString
cTypeName FunPtr CGTypeClassInit
classInit FunPtr (CGTypeInstanceInit o)
instanceInit
where
unwrapInstanceInit :: (GObjectClass -> o -> IO (GObjectPrivateData o)) ->
CGTypeInstanceInit o
unwrapInstanceInit :: (GObjectClass -> o -> IO (GObjectPrivateData o))
-> CGTypeInstanceInit o
unwrapInstanceInit GObjectClass -> o -> IO (GObjectPrivateData o)
instanceInit Ptr o
objPtr GObjectClass
klass = do
GObjectPrivateData o
privateData <- do
o
obj <- forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr o -> o
construct (forall a b. Ptr a -> Ptr b
castPtr Ptr o
objPtr :: Ptr o)
GObjectClass -> o -> IO (GObjectPrivateData o)
instanceInit GObjectClass
klass o
obj
forall o.
(HasCallStack, DerivedGObject o) =>
Ptr o -> GObjectPrivateData o -> IO ()
instanceSetPrivateData Ptr o
objPtr GObjectPrivateData o
privateData
unwrapClassInit :: (GObjectClass -> IO ()) -> CGTypeClassInit
unwrapClassInit :: CGTypeClassInit -> CGTypeClassInit
unwrapClassInit CGTypeClassInit
classInit klass :: GObjectClass
klass@(GObjectClass Ptr GObjectClass
klassPtr) = do
FunPtr (CPropertyGetter o)
getFunPtr <- forall o. CPropertyGetter o -> IO (FunPtr (CPropertyGetter o))
mkPropertyGetter CPropertyGetter o
marshallGetter
((\Ptr GObjectClass
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr GObjectClass
hsc_ptr Int
32)) Ptr GObjectClass
klassPtr FunPtr (CPropertyGetter o)
getFunPtr
{-# LINE 275 "Data/GI/Base/GObject.hsc" #-}
setFunPtr <- mkPropertySetter marshallSetter
((\Ptr GObjectClass
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr GObjectClass
hsc_ptr Int
24)) Ptr GObjectClass
klassPtr FunPtr (CPropertyGetter o)
setFunPtr
{-# LINE 277 "Data/GI/Base/GObject.hsc" #-}
classInit klass
marshallSetter :: CPropertySetter o
marshallSetter :: CPropertyGetter o
marshallSetter Ptr o
objPtr CUInt
_ Ptr GValue
gvPtr Ptr GParamSpec
pspecPtr = do
Maybe (PropGetSetter o)
maybeGetSet <- forall o. Ptr GParamSpec -> IO (Maybe (PropGetSetter o))
getGParamSpecGetterSetter Ptr GParamSpec
pspecPtr
case Maybe (PropGetSetter o)
maybeGetSet of
Maybe (PropGetSetter o)
Nothing -> do
Text
pspecName <- Ptr GParamSpec -> IO CString
g_param_spec_get_name Ptr GParamSpec
pspecPtr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => CString -> IO Text
cstringToText
String
typeName <- forall a. TypedObject a => IO GType
glibType @o forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GType -> IO String
gtypeName
Text -> IO ()
dbgLog forall a b. (a -> b) -> a -> b
$ Text
"WARNING: Attempting to set unknown property \""
forall a. Semigroup a => a -> a -> a
<> Text
pspecName forall a. Semigroup a => a -> a -> a
<> Text
"\" of type \"" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
typeName forall a. Semigroup a => a -> a -> a
<> Text
"\"."
Just PropGetSetter o
pgs -> (forall o. PropGetSetter o -> Ptr o -> Ptr GValue -> IO ()
propSetter PropGetSetter o
pgs) Ptr o
objPtr Ptr GValue
gvPtr
marshallGetter :: CPropertyGetter o
marshallGetter :: CPropertyGetter o
marshallGetter Ptr o
objPtr CUInt
_ Ptr GValue
destGValuePtr Ptr GParamSpec
pspecPtr = do
Maybe (PropGetSetter o)
maybeGetSet <- forall o. Ptr GParamSpec -> IO (Maybe (PropGetSetter o))
getGParamSpecGetterSetter Ptr GParamSpec
pspecPtr
case Maybe (PropGetSetter o)
maybeGetSet of
Maybe (PropGetSetter o)
Nothing -> do
Text
pspecName <- Ptr GParamSpec -> IO CString
g_param_spec_get_name Ptr GParamSpec
pspecPtr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => CString -> IO Text
cstringToText
String
typeName <- forall a. TypedObject a => IO GType
glibType @o forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GType -> IO String
gtypeName
Text -> IO ()
dbgLog forall a b. (a -> b) -> a -> b
$ Text
"WARNING: Attempting to get unknown property \""
forall a. Semigroup a => a -> a -> a
<> Text
pspecName forall a. Semigroup a => a -> a -> a
<> Text
"\" of type \"" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
typeName forall a. Semigroup a => a -> a -> a
<> Text
"\"."
Just PropGetSetter o
pgs -> (forall o. PropGetSetter o -> Ptr o -> Ptr GValue -> IO ()
propGetter PropGetSetter o
pgs) Ptr o
objPtr Ptr GValue
destGValuePtr
privateKey :: forall o. DerivedGObject o => IO (GQuark (GObjectPrivateData o))
privateKey :: forall o. DerivedGObject o => IO (GQuark (GObjectPrivateData o))
privateKey = forall a. Text -> IO (GQuark a)
gQuarkFromString forall a b. (a -> b) -> a -> b
$ forall a. DerivedGObject a => Text
objectTypeName @o forall a. Semigroup a => a -> a -> a
<> Text
"::haskell-gi-private-data"
gobjectGetPrivateData :: forall o. (HasCallStack, DerivedGObject o) =>
o -> IO (GObjectPrivateData o)
gobjectGetPrivateData :: forall o.
(HasCallStack, DerivedGObject o) =>
o -> IO (GObjectPrivateData o)
gobjectGetPrivateData o
obj = do
GQuark (GObjectPrivateData o)
key <- forall o. DerivedGObject o => IO (GQuark (GObjectPrivateData o))
privateKey @o
Maybe (GObjectPrivateData o)
maybePriv <- forall o a.
(HasCallStack, GObject o) =>
o -> GQuark a -> IO (Maybe a)
gobjectGetUserData o
obj GQuark (GObjectPrivateData o)
key
case Maybe (GObjectPrivateData o)
maybePriv of
Just GObjectPrivateData o
priv -> forall (m :: * -> *) a. Monad m => a -> m a
return GObjectPrivateData o
priv
Maybe (GObjectPrivateData o)
Nothing -> do
case forall a. ManagedPtr a -> Maybe CallStack
managedPtrAllocCallStack (coerce :: forall a b. Coercible a b => a -> b
coerce o
obj) of
Maybe CallStack
Nothing -> forall a. HasCallStack => String -> a
error (String
"Failed to get private data pointer!\n"
forall a. Semigroup a => a -> a -> a
<> String
"Set the env var HASKELL_GI_DEBUG_MEM=1 to get more info.")
Just CallStack
cs -> forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr o
obj forall a b. (a -> b) -> a -> b
$ \Ptr o
objPtr -> do
let errMsg :: String
errMsg = String
"Failed to get private data pointer for" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Ptr o
objPtr forall a. Semigroup a => a -> a -> a
<> String
"!\n"
forall a. Semigroup a => a -> a -> a
<> String
"Callstack for allocation was:\n"
forall a. Semigroup a => a -> a -> a
<> CallStack -> String
prettyCallStack CallStack
cs forall a. Semigroup a => a -> a -> a
<> String
"\n\n"
forall a. HasCallStack => String -> a
error String
errMsg
foreign import ccall g_object_get_qdata ::
Ptr a -> GQuark b -> IO (Ptr c)
gobjectGetUserData :: (HasCallStack, GObject o) => o -> GQuark a -> IO (Maybe a)
gobjectGetUserData :: forall o a.
(HasCallStack, GObject o) =>
o -> GQuark a -> IO (Maybe a)
gobjectGetUserData o
obj GQuark a
key = do
Ptr ()
dataPtr <- forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr o
obj forall a b. (a -> b) -> a -> b
$ \Ptr o
objPtr ->
forall a b c. Ptr a -> GQuark b -> IO (Ptr c)
g_object_get_qdata Ptr o
objPtr GQuark a
key
if Ptr ()
dataPtr forall a. Eq a => a -> a -> Bool
/= forall a. Ptr a
nullPtr
then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. StablePtr a -> IO a
deRefStablePtr (forall a. Ptr () -> StablePtr a
castPtrToStablePtr Ptr ()
dataPtr)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
foreign import ccall "&hs_free_stable_ptr" ptr_to_hs_free_stable_ptr ::
GDestroyNotify (Ptr ())
foreign import ccall g_object_set_qdata_full ::
Ptr a -> GQuark b -> Ptr () -> GDestroyNotify (Ptr ()) -> IO ()
gobjectSetUserData :: (HasCallStack, GObject o) =>
o -> GQuark a -> a -> IO ()
gobjectSetUserData :: forall o a.
(HasCallStack, GObject o) =>
o -> GQuark a -> a -> IO ()
gobjectSetUserData o
obj GQuark a
key a
value = forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr o
obj forall a b. (a -> b) -> a -> b
$ \Ptr o
objPtr ->
forall o a.
(HasCallStack, GObject o) =>
Ptr o -> GQuark a -> a -> IO ()
instanceSetUserData Ptr o
objPtr GQuark a
key a
value
gobjectModifyUserData :: (HasCallStack, GObject o) =>
o -> GQuark a -> (Maybe a -> a) -> IO ()
gobjectModifyUserData :: forall o a.
(HasCallStack, GObject o) =>
o -> GQuark a -> (Maybe a -> a) -> IO ()
gobjectModifyUserData o
obj GQuark a
key Maybe a -> a
transform = do
Maybe a
userData <- forall o a.
(HasCallStack, GObject o) =>
o -> GQuark a -> IO (Maybe a)
gobjectGetUserData o
obj GQuark a
key
forall o a.
(HasCallStack, GObject o) =>
o -> GQuark a -> a -> IO ()
gobjectSetUserData o
obj GQuark a
key (Maybe a -> a
transform Maybe a
userData)
instanceSetUserData :: (HasCallStack, GObject o) =>
Ptr o -> GQuark a -> a -> IO ()
instanceSetUserData :: forall o a.
(HasCallStack, GObject o) =>
Ptr o -> GQuark a -> a -> IO ()
instanceSetUserData Ptr o
objPtr GQuark a
key a
value = do
StablePtr a
stablePtr <- forall a. a -> IO (StablePtr a)
newStablePtr a
value
forall a b.
Ptr a -> GQuark b -> Ptr () -> GDestroyNotify (Ptr ()) -> IO ()
g_object_set_qdata_full Ptr o
objPtr GQuark a
key (forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr a
stablePtr)
GDestroyNotify (Ptr ())
ptr_to_hs_free_stable_ptr
gobjectSetPrivateData :: forall o. (HasCallStack, DerivedGObject o) =>
o -> GObjectPrivateData o -> IO ()
gobjectSetPrivateData :: forall o.
(HasCallStack, DerivedGObject o) =>
o -> GObjectPrivateData o -> IO ()
gobjectSetPrivateData o
obj GObjectPrivateData o
value = forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr o
obj forall a b. (a -> b) -> a -> b
$ \Ptr o
objPtr ->
forall o.
(HasCallStack, DerivedGObject o) =>
Ptr o -> GObjectPrivateData o -> IO ()
instanceSetPrivateData Ptr o
objPtr GObjectPrivateData o
value
instanceSetPrivateData :: forall o. (HasCallStack, DerivedGObject o) =>
Ptr o -> GObjectPrivateData o -> IO ()
instanceSetPrivateData :: forall o.
(HasCallStack, DerivedGObject o) =>
Ptr o -> GObjectPrivateData o -> IO ()
instanceSetPrivateData Ptr o
objPtr GObjectPrivateData o
priv = do
GQuark (GObjectPrivateData o)
key <- forall o. DerivedGObject o => IO (GQuark (GObjectPrivateData o))
privateKey @o
forall o a.
(HasCallStack, GObject o) =>
Ptr o -> GQuark a -> a -> IO ()
instanceSetUserData Ptr o
objPtr GQuark (GObjectPrivateData o)
key GObjectPrivateData o
priv
foreign import ccall g_object_class_install_property ::
GObjectClass -> CUInt -> Ptr GParamSpec -> IO ()
gobjectModifyPrivateData :: forall o. (HasCallStack, DerivedGObject o) =>
o -> (GObjectPrivateData o -> GObjectPrivateData o)
-> IO ()
gobjectModifyPrivateData :: forall o.
(HasCallStack, DerivedGObject o) =>
o -> (GObjectPrivateData o -> GObjectPrivateData o) -> IO ()
gobjectModifyPrivateData o
obj GObjectPrivateData o -> GObjectPrivateData o
transform = do
GObjectPrivateData o
private <- forall o.
(HasCallStack, DerivedGObject o) =>
o -> IO (GObjectPrivateData o)
gobjectGetPrivateData o
obj
forall o.
(HasCallStack, DerivedGObject o) =>
o -> GObjectPrivateData o -> IO ()
gobjectSetPrivateData o
obj (GObjectPrivateData o -> GObjectPrivateData o
transform GObjectPrivateData o
private)
gobjectInstallProperty :: DerivedGObject o =>
GObjectClass -> PropertyInfo o a -> IO ()
gobjectInstallProperty :: forall o a.
DerivedGObject o =>
GObjectClass -> PropertyInfo o a -> IO ()
gobjectInstallProperty GObjectClass
klass PropertyInfo o a
propInfo = do
GParamSpec
pspec <- forall o a. GObject o => PropertyInfo o a -> IO GParamSpec
gParamSpecValue PropertyInfo o a
propInfo
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GParamSpec
pspec forall a b. (a -> b) -> a -> b
$ \Ptr GParamSpec
pspecPtr ->
GObjectClass -> CUInt -> Ptr GParamSpec -> IO ()
g_object_class_install_property GObjectClass
klass CUInt
1 Ptr GParamSpec
pspecPtr
gobjectInstallCIntProperty :: DerivedGObject o =>
GObjectClass -> CIntPropertyInfo o -> IO ()
gobjectInstallCIntProperty :: forall o.
DerivedGObject o =>
GObjectClass -> CIntPropertyInfo o -> IO ()
gobjectInstallCIntProperty GObjectClass
klass CIntPropertyInfo o
propInfo = do
GParamSpec
pspec <- forall o. GObject o => CIntPropertyInfo o -> IO GParamSpec
gParamSpecCInt CIntPropertyInfo o
propInfo
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GParamSpec
pspec forall a b. (a -> b) -> a -> b
$ \Ptr GParamSpec
pspecPtr ->
GObjectClass -> CUInt -> Ptr GParamSpec -> IO ()
g_object_class_install_property GObjectClass
klass CUInt
1 Ptr GParamSpec
pspecPtr
gobjectInstallCStringProperty :: DerivedGObject o =>
GObjectClass -> CStringPropertyInfo o -> IO ()
gobjectInstallCStringProperty :: forall o.
DerivedGObject o =>
GObjectClass -> CStringPropertyInfo o -> IO ()
gobjectInstallCStringProperty GObjectClass
klass CStringPropertyInfo o
propInfo = do
GParamSpec
pspec <- forall o. GObject o => CStringPropertyInfo o -> IO GParamSpec
gParamSpecCString CStringPropertyInfo o
propInfo
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GParamSpec
pspec forall a b. (a -> b) -> a -> b
$ \Ptr GParamSpec
pspecPtr ->
GObjectClass -> CUInt -> Ptr GParamSpec -> IO ()
g_object_class_install_property GObjectClass
klass CUInt
1 Ptr GParamSpec
pspecPtr