haskell-gi-base 0.26.5 → 0.26.6

raw patch · 4 files changed

+88/−12 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/GI/Base/GObject.hsc +60/−7
• Data/GI/Base/GVariant.hsc +7/−3
• csrc/hsgclosure.c +20/−1
• haskell-gi-base.cabal +1/−1

@@ -46,7 +46,7 @@ import Data.Coerce (coerce)  import Foreign.C (CUInt(..), CString, newCString)-import Foreign.Ptr (Ptr, FunPtr, nullPtr, castPtr, plusPtr)+import Foreign.Ptr (Ptr, FunPtr, nullPtr, castPtr, plusPtr, nullFunPtr) import Foreign.StablePtr (newStablePtr, deRefStablePtr,                           castStablePtrToPtr, castPtrToStablePtr) import Foreign.Storable (Storable(peek, poke, pokeByteOff, sizeOf))@@ -61,11 +61,12 @@ import Data.GI.Base.Attributes (AttrOp(..), AttrOpTag(..), AttrLabelProxy,                                 attrConstruct, attrTransfer,                                 AttrInfo(..))-import Data.GI.Base.BasicTypes (CGType, GType(..), GObject,+import Data.GI.Base.BasicTypes (CGType, GType(..), GObject, GSList,                                 GDestroyNotify, ManagedPtr(..), GParamSpec(..),                                 TypedObject(glibType),-                                gtypeName)-import Data.GI.Base.BasicConversions (withTextCString, cstringToText)+                                gtypeName, g_slist_free)+import Data.GI.Base.BasicConversions (withTextCString, cstringToText,+                                      packGSList, mapGSList) import Data.GI.Base.CallStack (HasCallStack, prettyCallStack) import Data.GI.Base.GParamSpec (PropertyInfo(..),                                 gParamSpecValue,@@ -80,7 +81,7 @@                                 newObject) import Data.GI.Base.Overloading (ResolveAttribute) import Data.GI.Base.Signals (on, after)-import Data.GI.Base.Utils (dbgLog)+import Data.GI.Base.Utils (dbgLog, callocBytes, freeMem)  #include <glib-object.h> @@ -189,15 +190,26 @@    -- | Name of the type, it should be unique.   objectTypeName     :: Text+   -- | Code to run when the class is inited. This is a good place to   -- register signals and properties for the type.   objectClassInit    :: GObjectClass -> IO ()+   -- | Code to run when each instance of the type is   -- constructed. Returns the private data to be associated with the   -- new instance (use `gobjectGetPrivateData` and   -- `gobjectSetPrivateData` to manipulate this further).   objectInstanceInit :: GObjectClass -> a -> IO (GObjectPrivateData a) +  -- | List of interfaces implemented by the type. Each element is a+  -- triplet (@gtype@, @interfaceInit@, @interfaceFinalize@), where+  -- @gtype :: IO GType@ is a constructor for the type of the+  -- interface, @interfaceInit :: Ptr () -> IO ()@ is a function that+  -- registers the callbacks in the interface, and @interfaceFinalize+  -- :: Maybe (Ptr () -> IO ())@ is the (optional) finalizer.+  objectInterfaces :: [(IO GType, Ptr () -> IO (), Maybe (Ptr () -> IO ()))]+  objectInterfaces = []+ type CGTypeClassInit = GObjectClass -> IO () foreign import ccall "wrapper"         mkClassInit :: CGTypeClassInit -> IO (FunPtr CGTypeClassInit)@@ -206,11 +218,19 @@ foreign import ccall "wrapper"         mkInstanceInit :: CGTypeInstanceInit o -> IO (FunPtr (CGTypeInstanceInit o)) +type CGTypeInterfaceInit = Ptr () -> Ptr () -> IO ()+foreign import ccall "wrapper"+        mkInterfaceInit :: CGTypeInterfaceInit -> IO (FunPtr CGTypeInterfaceInit)++type CGTypeInterfaceFinalize = Ptr () -> Ptr () -> IO ()+foreign import ccall "wrapper"+        mkInterfaceFinalize :: CGTypeInterfaceFinalize -> IO (FunPtr CGTypeInterfaceFinalize)+ 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+        FunPtr (CGTypeInstanceInit o) -> Ptr (GSList a) -> IO CGType  foreign import ccall "haskell_gi_gtype_from_class" gtype_from_class ::         GObjectClass -> IO CGType@@ -259,7 +279,11 @@       classInit <- mkClassInit (unwrapClassInit $ objectClassInit @o)       instanceInit <- mkInstanceInit (unwrapInstanceInit $ objectInstanceInit @o)       (GType parentCGType) <- glibType @(GObjectParentType o)-      GType <$> register_gtype parentCGType cTypeName classInit instanceInit+      interfaces <- mapM packInterface (objectInterfaces @o) >>= packGSList+      gtype <- GType <$> register_gtype parentCGType cTypeName classInit instanceInit interfaces+      mapGSList freeInterfaceInfo interfaces+      g_slist_free interfaces+      return gtype     where      unwrapInstanceInit :: (GObjectClass -> o -> IO (GObjectPrivateData o)) ->@@ -299,6 +323,35 @@            dbgLog $ "WARNING: Attempting to get unknown property \""                     <> pspecName <> "\" of type \"" <> T.pack typeName <> "\"."          Just pgs -> (propGetter pgs) objPtr destGValuePtr++     packInterface :: (IO GType, Ptr () -> IO (), Maybe (Ptr () -> IO ()))+                   -> IO (Ptr CGType)+     packInterface (ifaceGTypeConstruct, initHs, maybeFinalize) = do+       gtype <- ifaceGTypeConstruct+       info <- callocBytes #{size GInterfaceInfo}+       initFn <- mkInterfaceInit (unwrapInit initHs)+       finalizeFn <- case maybeFinalize of+                     Just finalizeHs -> mkInterfaceFinalize (unwrapFinalize finalizeHs)+                     Nothing -> pure nullFunPtr+       #{poke GInterfaceInfo, interface_init} info initFn+       #{poke GInterfaceInfo, interface_finalize} info finalizeFn++       combined <- callocBytes (#{size GType} + #{size gpointer})+       poke combined (gtypeToCGType gtype)+       poke (combined `plusPtr` #{size GType}) info+       return combined++     unwrapInit :: (Ptr () -> IO ()) -> CGTypeInterfaceInit+     unwrapInit f ptr _data = f ptr++     unwrapFinalize :: (Ptr () -> IO ()) -> CGTypeInterfaceFinalize+     unwrapFinalize = unwrapInit++     freeInterfaceInfo :: Ptr CGType -> IO ()+     freeInterfaceInfo combinedPtr = do+       info <- peek (combinedPtr `plusPtr` #{size GType})+       freeMem info+       freeMem combinedPtr  -- | Quark with the key to the private data for this object type. privateKey :: forall o. DerivedGObject o => IO (GQuark (GObjectPrivateData o))

@@ -643,6 +643,12 @@              [0..(n_children-1)]         else return [] +-- No type checking is done here, it is assumed that the caller knows+-- that the passed variant is indeed of a container type with at least+-- one child.+gvariant_get_child :: (Ptr GVariant) -> IO GVariant+gvariant_get_child vptr = g_variant_get_child_value vptr 0 >>= wrapGVariantPtr+ instance IsGVariant a => IsGVariant (Maybe a) where     toGVariant   = gvariantFromMaybe     fromGVariant = gvariantToMaybe@@ -829,9 +835,7 @@  gvariantToSinglet :: forall a. IsGVariant a => GVariant -> IO (Maybe a) gvariantToSinglet = withExplicitType fmt-                    (gvariant_get_children-                     >=> return . head-                     >=> unsafeFromGVariant)+                    (gvariant_get_child >=> unsafeFromGVariant)     where fmt = toGVariantFormatString (undefined :: GVariantSinglet a)  instance (IsGVariant a, IsGVariant b) => IsGVariant (a,b) where

@@ -309,11 +309,17 @@  static pthread_mutex_t gtypes_mutex = PTHREAD_MUTEX_INITIALIZER; +typedef struct {+  GType gtype;+  GInterfaceInfo *info;+} CombinedInterfaceInfo;+ /* Register a new type into the GObject class hierarchy, if it has not    been registered already */ GType haskell_gi_register_gtype (GType parent, const char *name,                                  GClassInitFunc class_init,-                                 GInstanceInitFunc instance_init)+                                 GInstanceInitFunc instance_init,+                                 GSList* interfaces) {   GType result; @@ -331,11 +337,24 @@                                             query.class_size, class_init,                                             query.instance_size, instance_init,                                             0);+    while (interfaces != NULL) {+      CombinedInterfaceInfo *info = (CombinedInterfaceInfo*) interfaces->data;+      g_type_add_interface_static (result, info->gtype, info->info);+      interfaces = interfaces -> next;+    }   } else {     /* Free the memory associated with the HsFunPtrs that we are        given, to avoid a (small) memory leak. */     hs_free_fun_ptr ((HsFunPtr)class_init);     hs_free_fun_ptr ((HsFunPtr)instance_init);++    while (interfaces != NULL) {+      CombinedInterfaceInfo *info = (CombinedInterfaceInfo*) interfaces->data;+      hs_free_fun_ptr ((HsFunPtr) info -> info -> interface_init);+      if (info -> info -> interface_finalize)+        hs_free_fun_ptr ((HsFunPtr) info -> info -> interface_finalize);+      interfaces = interfaces -> next;+    }   }   pthread_mutex_unlock(&gtypes_mutex); 

@@ -1,5 +1,5 @@ name:                haskell-gi-base-version:             0.26.5+version:             0.26.6 synopsis:            Foundation for libraries generated by haskell-gi description:         Foundation for libraries generated by haskell-gi homepage:            https://github.com/haskell-gi/haskell-gi