haskell-gi-base 0.21.5 → 0.22.0

raw patch · 21 files changed

+1164/−517 lines, 21 filesdep −transformersdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: transformers

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Data/GI/Base.hs +2/−4
• Data/GI/Base/Attributes.hs +6/−13
• Data/GI/Base/BasicConversions.hsc +4/−4
• Data/GI/Base/BasicTypes.hs +0/−201
• Data/GI/Base/BasicTypes.hsc +187/−0
• Data/GI/Base/Closure.hs +0/−41
• Data/GI/Base/Constructible.hs +2/−1
• Data/GI/Base/GClosure.hs +68/−0
• Data/GI/Base/GObject.hsc +275/−13
• Data/GI/Base/GParamSpec.hsc +316/−12
• Data/GI/Base/GQuark.hsc +22/−0
• Data/GI/Base/GType.hsc +44/−29
• Data/GI/Base/GValue.hsc +27/−5
• Data/GI/Base/ManagedPtr.hs +20/−11
• Data/GI/Base/Overloading.hs +45/−144
• Data/GI/Base/Properties.hsc +21/−4
• Data/GI/Base/ShortPrelude.hs +2/−4
• Data/GI/Base/Signals.hsc +19/−21
• c/hsgclosure.c +94/−0
• haskell-gi-base.cabal +6/−10

@@ -1,3 +1,7 @@+### 0.22.0+++ Require base >= 0.4.9 (GHC version >= 8.0), so that we can use TypeApplications.+ ### 0.21.5  + Add [releaseObject](https://hackage.haskell.org/package/haskell-gi-base-0.21.5/docs/Data-GI-Base-ManagedPtr.html#v:releaseObject), a function useful for manually releasing memory associated to GObjects.

@@ -8,11 +8,10 @@     ( module Data.GI.Base.Attributes     , module Data.GI.Base.BasicConversions     , module Data.GI.Base.BasicTypes-    , module Data.GI.Base.Closure+    , module Data.GI.Base.GClosure     , module Data.GI.Base.Constructible     , module Data.GI.Base.GError     , module Data.GI.Base.GHashTable-    , module Data.GI.Base.GObject     , module Data.GI.Base.GValue     , module Data.GI.Base.GVariant     , module Data.GI.Base.ManagedPtr@@ -22,11 +21,10 @@ import Data.GI.Base.Attributes (get, set, AttrOp(..)) import Data.GI.Base.BasicConversions import Data.GI.Base.BasicTypes-import Data.GI.Base.Closure+import Data.GI.Base.GClosure (GClosure) import Data.GI.Base.Constructible (new) import Data.GI.Base.GError import Data.GI.Base.GHashTable-import Data.GI.Base.GObject (new') import Data.GI.Base.GValue (GValue(..), IsGValue(..)) import Data.GI.Base.GVariant import Data.GI.Base.ManagedPtr

@@ -95,7 +95,7 @@ -- 'IO' monad rather than being pure. -- -- Attributes can also be set during construction of a--- `Data.GI.Base.BasicTypes.GObject` using `Data.GI.Base.Properties.new`+-- `Data.GI.Base.BasicTypes.GObject` using `Data.GI.Base.Constructible.new` -- -- > button <- new Button [_label := "Can't touch this!", _sensitive := False] --@@ -150,29 +150,22 @@ import Data.Proxy (Proxy(..))  import Data.GI.Base.GValue (GValueConstruct)-import Data.GI.Base.Overloading (HasAttributeList,-                                 ResolveAttribute, IsLabelProxy(..))+import Data.GI.Base.Overloading (HasAttributeList, ResolveAttribute)  import GHC.TypeLits import GHC.Exts (Constraint) -#if MIN_VERSION_base(4,9,0) import GHC.OverloadedLabels (IsLabel(..))-#endif  infixr 0 :=,:~,:=>,:~>  -- | A proxy for attribute labels. data AttrLabelProxy (a :: Symbol) = AttrLabelProxy --- | Support for overloaded labels.-instance a ~ x => IsLabelProxy x (AttrLabelProxy a) where-    fromLabelProxy _ = AttrLabelProxy- #if MIN_VERSION_base(4,10,0) instance a ~ x => IsLabel x (AttrLabelProxy a) where     fromLabel = AttrLabelProxy-#elif MIN_VERSION_base(4,9,0)+#else instance a ~ x => IsLabel x (AttrLabelProxy a) where     fromLabel _ = AttrLabelProxy #endif@@ -204,7 +197,7 @@     -- attributes).     attrClear :: AttrBaseTypeConstraint info o =>                  Proxy info -> o -> IO ()-    -- | Build a `GValue` representing the attribute.+    -- | Build a `Data.GI.Base.GValue.GValue` representing the attribute.     attrConstruct :: (AttrBaseTypeConstraint info o,                       AttrSetTypeConstraint info b) =>                      Proxy info -> b -> IO (GValueConstruct o)@@ -271,8 +264,8 @@                                      AttrOpAllowed 'AttrSet info obj,                                      (AttrSetTypeConstraint info) value) --- | Constraint on a @obj@\/@value@ pair so that `new` works on values--- of type @@value@.+-- | Constraint on a @obj@\/@value@ pair so that+-- `Data.GI.Base.Constructible.new` works on values of type @value@. type AttrConstructC info obj attr value = (HasAttributeList obj,                                            info ~ ResolveAttribute attr obj,                                            AttrInfo info,

@@ -115,11 +115,11 @@ foreign import ccall "g_list_prepend" g_list_prepend ::     Ptr (GList (Ptr a)) -> Ptr a -> IO (Ptr (GList (Ptr a))) --- Given a Haskell list of items, construct a GList with those values.+-- | Given a Haskell list of items, construct a GList with those values. packGList   :: [Ptr a] -> IO (Ptr (GList (Ptr a))) packGList l = foldM g_list_prepend nullPtr $ reverse l --- Given a GSList construct the corresponding Haskell list.+-- | Given a GSList construct the corresponding Haskell list. unpackGList   :: Ptr (GList (Ptr a)) -> IO [Ptr a] unpackGList gsl     | gsl == nullPtr = return []@@ -134,11 +134,11 @@ foreign import ccall "g_slist_prepend" g_slist_prepend ::     Ptr (GSList (Ptr a)) -> Ptr a -> IO (Ptr (GSList (Ptr a))) --- Given a Haskell list of items, construct a GSList with those values.+-- | Given a Haskell list of items, construct a GSList with those values. packGSList   :: [Ptr a] -> IO (Ptr (GSList (Ptr a))) packGSList l = foldM g_slist_prepend nullPtr $ reverse l --- Given a GSList construct the corresponding Haskell list.+-- | Given a GSList construct the corresponding Haskell list. unpackGSList   :: Ptr (GSList (Ptr a)) -> IO [Ptr a] unpackGSList gsl = unpackGList (castPtr gsl) 

@@ -1,201 +0,0 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances,-  DeriveDataTypeable, TypeFamilies, ScopedTypeVariables #-}-#if !MIN_VERSION_base(4,8,0)-{-# LANGUAGE OverlappingInstances #-}-#endif-#if MIN_VERSION_base(4,9,0)-{-# LANGUAGE DataKinds, TypeOperators, UndecidableInstances #-}-#endif--- | Basic types used in the bindings.-module Data.GI.Base.BasicTypes-    (-      -- * GType related-      module Data.GI.Base.GType         -- reexported for convenience--     -- * Memory management-    , ManagedPtr(..)-    , ManagedPtrNewtype-    , BoxedObject(..)-    , BoxedEnum(..)-    , BoxedFlags(..)-    , GObject(..)-    , WrappedPtr(..)-    , UnexpectedNullPointerReturn(..)-    , NullToNothing(..)--    -- * Basic GLib \/ GObject types-    , GVariant(..)-    , GParamSpec(..)--    , GArray(..)-    , GPtrArray(..)-    , GByteArray(..)-    , GHashTable(..)-    , GList(..)-    , g_list_free-    , GSList(..)-    , g_slist_free--    , IsGFlag--    , PtrWrapped(..)-    , GDestroyNotify-    ) where--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-#endif-import Control.Exception (Exception, catch)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Coerce (Coercible)-import Data.IORef (IORef)-import Data.Proxy (Proxy)-import qualified Data.Text as T-import Data.Typeable (Typeable)-import Foreign.Ptr (Ptr, FunPtr)-import Foreign.ForeignPtr (ForeignPtr)--import Data.GI.Base.CallStack (CallStack)-import Data.GI.Base.GType---- | Thin wrapper over `ForeignPtr`, supporting the extra notion of--- `disowning`, that is, not running the finalizers associated with--- the foreign ptr.-data ManagedPtr a = ManagedPtr {-      managedForeignPtr :: ForeignPtr a-    , managedPtrAllocCallStack :: Maybe CallStack-    -- ^ `CallStack` for the call that created the pointer.-    , managedPtrIsDisowned :: IORef (Maybe CallStack)-    -- ^ When disowned, the `CallStack` for the disowning call.-    }---- | A constraint ensuring that the given type is coercible to a--- ManagedPtr. It will hold for newtypes of the form------ > newtype Foo = Foo (ManagedPtr Foo)------ which is the typical shape of wrapped 'GObject's.-type ManagedPtrNewtype a = Coercible a (ManagedPtr ())--- Notice that the Coercible here is to ManagedPtr (), instead of--- "ManagedPtr a", which would be the most natural thing. Both are--- representationally equivalent, so this is not a big deal. This is--- to work around a problem in ghc 7.10:--- https://ghc.haskell.org/trac/ghc/ticket/10715---- | Wrapped boxed structures, identified by their `GType`.-class ManagedPtrNewtype a => BoxedObject a where-    boxedType :: a -> IO GType -- This should not use the value of its-                               -- argument.---- | Enums with an associated `GType`.-class BoxedEnum a where-    boxedEnumType :: a -> IO GType---- | Flags with an associated `GType`.-class BoxedFlags a where-    boxedFlagsType :: Proxy a -> IO GType---- | Pointers to structs/unions without an associated `GType`.-class ManagedPtrNewtype a => WrappedPtr a where-    -- | Allocate a zero-initialized block of memory for the given type.-    wrappedPtrCalloc :: IO (Ptr a)-    -- | Make a copy of the given `WrappedPtr`.-    wrappedPtrCopy   :: a -> IO a-    -- | A pointer to a function for freeing the given pointer, or-    -- `Nothing` is the memory associated to the pointer does not need-    -- to be freed.-    wrappedPtrFree   :: Maybe (FunPtr (Ptr a -> IO ()))---- | A wrapped `GObject`.-class ManagedPtrNewtype a => GObject a where-    -- | The `GType` for this object.-    gobjectType :: a -> IO GType---- | A common omission in the introspection data is missing (nullable)--- annotations for return types, when they clearly are nullable. (A--- common idiom is "Returns: valid value, or %NULL if something went--- wrong.")------ Haskell wrappers will raise this exception if the return value is--- an unexpected `Foreign.Ptr.nullPtr`.-data UnexpectedNullPointerReturn =-    UnexpectedNullPointerReturn { nullPtrErrorMsg :: T.Text }-                                deriving (Typeable)--instance Show UnexpectedNullPointerReturn where-  show r = T.unpack (nullPtrErrorMsg r)--instance Exception UnexpectedNullPointerReturn--type family UnMaybe a :: * where-    UnMaybe (Maybe a) = a-    UnMaybe a         = a--{-# DEPRECATED nullToNothing ["This will be removed in future versions of haskell-gi.", "If you know of wrong introspection data in a binding please report it as an issue at", "http://github.com/haskell-gi/haskell-gi", "so that it can be fixed."] #-}-class NullToNothing a where-    -- | Some functions are not marked as having a nullable return type-    -- in the introspection data.  The result is that they currently do-    -- not return a Maybe type.  This functions lets you work around this-    -- in a way that will not break when the introspection data is fixed.-    ---    -- When you want to call a `someHaskellGIFunction` that may return null-    -- wrap the call like this.-    ---    -- > nullToNothing (someHaskellGIFunction x y)-    ---    -- The result will be a Maybe type even if the introspection data has-    -- not been fixed for `someHaskellGIFunction` yet.-    nullToNothing :: MonadIO m => IO a -> m (Maybe (UnMaybe a))--instance-#if MIN_VERSION_base(4,8,0)-    {-# OVERLAPPABLE #-}-#endif-    a ~ UnMaybe a => NullToNothing a where-        nullToNothing f = liftIO $-            (Just <$> f) `catch` (\(_::UnexpectedNullPointerReturn) -> return Nothing)--instance NullToNothing (Maybe a) where-    nullToNothing = liftIO---- | A <https://developer.gnome.org/glib/stable/glib-GVariant.html GVariant>. See "Data.GI.Base.GVariant" for further methods.-newtype GVariant = GVariant (ManagedPtr GVariant)---- | A <https://developer.gnome.org/gobject/stable/gobject-GParamSpec.html GParamSpec>. See "Data.GI.Base.GParamSpec" for further methods.-newtype GParamSpec = GParamSpec (ManagedPtr GParamSpec)---- | An enum usable as a flag for a function.-class Enum a => IsGFlag a---- | A <https://developer.gnome.org/glib/stable/glib-Arrays.html GArray>. Marshalling for this type is done in "Data.GI.Base.BasicConversions", it is mapped to a list on the Haskell side.-data GArray a = GArray (Ptr (GArray a))---- | A <https://developer.gnome.org/glib/stable/glib-Pointer-Arrays.html GPtrArray>. Marshalling for this type is done in "Data.GI.Base.BasicConversions", it is mapped to a list on the Haskell side.-data GPtrArray a = GPtrArray (Ptr (GPtrArray a))---- | A <https://developer.gnome.org/glib/stable/glib-Byte-Arrays.html GByteArray>. Marshalling for this type is done in "Data.GI.Base.BasicConversions", it is packed to a 'Data.ByteString.ByteString' on the Haskell side.-data GByteArray = GByteArray (Ptr GByteArray)---- | A <https://developer.gnome.org/glib/stable/glib-Hash-Tables.html GHashTable>. It is mapped to a 'Data.Map.Map' on the Haskell side.-data GHashTable a b = GHashTable (Ptr (GHashTable a b))---- | A <https://developer.gnome.org/glib/stable/glib-Doubly-Linked-Lists.html GList>, mapped to a list on the Haskell side. Marshalling is done in "Data.GI.Base.BasicConversions".-data GList a = GList (Ptr (GList a))---- | A <https://developer.gnome.org/glib/stable/glib-Singly-Linked-Lists.html GSList>, mapped to a list on the Haskell side. Marshalling is done in "Data.GI.Base.BasicConversions".-data GSList a = GSList (Ptr (GSList a))---- | Some APIs, such as `GHashTable`, pass around scalar types--- wrapped into a pointer. We encode such a type as follows.-newtype PtrWrapped a = PtrWrapped {unwrapPtr :: Ptr a}---- | Destroy the memory associated with a given pointer.-type GDestroyNotify a = FunPtr (Ptr a -> IO ())---- | Free the given 'GList'.-foreign import ccall "g_list_free" g_list_free ::-    Ptr (GList a) -> IO ()---- | Free the given 'GSList'.-foreign import ccall "g_slist_free" g_slist_free ::-    Ptr (GSList a) -> IO ()

@@ -0,0 +1,187 @@+{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances,+  DeriveDataTypeable, TypeFamilies, ScopedTypeVariables #-}+{-# LANGUAGE DataKinds, TypeOperators, UndecidableInstances #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++-- | Basic types used in the bindings.+module Data.GI.Base.BasicTypes+    (+     -- * Memory management+      ManagedPtr(..)+    , ManagedPtrNewtype+    , BoxedObject(..)+    , BoxedEnum(..)+    , BoxedFlags(..)+    , WrappedPtr(..)+    , UnexpectedNullPointerReturn(..)++    -- * Basic GLib \/ GObject types+    , GObject(..)+    , GType(..)+    , CGType+    , gtypeName+    , GVariant(..)+    , GParamSpec(..)+    , noGParamSpec++    , GArray(..)+    , GPtrArray(..)+    , GByteArray(..)+    , GHashTable(..)+    , GList(..)+    , g_list_free+    , GSList(..)+    , g_slist_free++    , IsGFlag++    , PtrWrapped(..)+    , GDestroyNotify+    ) where++import Control.Exception (Exception)++import Data.Coerce (Coercible)+import Data.IORef (IORef)+import Data.Proxy (Proxy)+import qualified Data.Text as T+import Data.Typeable (Typeable)+import Data.Word++import Foreign.C (CString, peekCString)+import Foreign.Ptr (Ptr, FunPtr)+import Foreign.ForeignPtr (ForeignPtr)++import Data.GI.Base.CallStack (CallStack)+import Data.GI.Base.Overloading (HasParentTypes)++#include <glib-object.h>++-- | Thin wrapper over `ForeignPtr`, supporting the extra notion of+-- `disowning`, that is, not running the finalizers associated with+-- the foreign ptr.+data ManagedPtr a = ManagedPtr {+      managedForeignPtr :: ForeignPtr a+    , managedPtrAllocCallStack :: Maybe CallStack+    -- ^ `CallStack` for the call that created the pointer.+    , managedPtrIsDisowned :: IORef (Maybe CallStack)+    -- ^ When disowned, the `CallStack` for the disowning call.+    }++-- | A constraint ensuring that the given type is coercible to a+-- ManagedPtr. It will hold for newtypes of the form+--+-- > newtype Foo = Foo (ManagedPtr Foo)+--+-- which is the typical shape of wrapped 'GObject's.+type ManagedPtrNewtype a = Coercible a (ManagedPtr ())+-- Notice that the Coercible here is to ManagedPtr (), instead of+-- "ManagedPtr a", which would be the most natural thing. Both are+-- representationally equivalent, so this is not a big deal. This is+-- to work around a problem in ghc 7.10:+-- https://ghc.haskell.org/trac/ghc/ticket/10715++-- | Wrapped boxed structures, identified by their `GType`.+class ManagedPtrNewtype a => BoxedObject a where+    boxedType :: a -> IO GType -- This should not use the value of its+                               -- argument.++-- | Enums with an associated `GType`.+class BoxedEnum a where+    boxedEnumType :: a -> IO GType++-- | Flags with an associated `GType`.+class BoxedFlags a where+    boxedFlagsType :: Proxy a -> IO GType++-- | Pointers to structs/unions without an associated `GType`.+class ManagedPtrNewtype a => WrappedPtr a where+    -- | Allocate a zero-initialized block of memory for the given type.+    wrappedPtrCalloc :: IO (Ptr a)+    -- | Make a copy of the given `WrappedPtr`.+    wrappedPtrCopy   :: a -> IO a+    -- | A pointer to a function for freeing the given pointer, or+    -- `Nothing` is the memory associated to the pointer does not need+    -- to be freed.+    wrappedPtrFree   :: Maybe (GDestroyNotify a)++-- | A wrapped `GObject`.+class (ManagedPtrNewtype a, HasParentTypes a) => GObject a where+    -- | The `GType` for this object.+    gobjectType :: IO GType++-- | A type identifier in the GLib type system. This is the low-level+-- type associated with the representation in memory, when using this+-- on the Haskell side use `GType` below.+type CGType = #type GType++-- | A newtype for use on the haskell side.+newtype GType = GType {gtypeToCGType :: CGType}++foreign import ccall "g_type_name" g_type_name :: GType -> IO CString++-- | Get the name assigned to the given `GType`.+gtypeName :: GType -> IO String+gtypeName gtype = g_type_name gtype >>= peekCString++-- | A common omission in the introspection data is missing (nullable)+-- annotations for return types, when they clearly are nullable. (A+-- common idiom is "Returns: valid value, or %NULL if something went+-- wrong.")+--+-- Haskell wrappers will raise this exception if the return value is+-- an unexpected `Foreign.Ptr.nullPtr`.+data UnexpectedNullPointerReturn =+    UnexpectedNullPointerReturn { nullPtrErrorMsg :: T.Text }+                                deriving (Typeable)++instance Show UnexpectedNullPointerReturn where+  show r = T.unpack (nullPtrErrorMsg r)++instance Exception UnexpectedNullPointerReturn++-- | A <https://developer.gnome.org/glib/stable/glib-GVariant.html GVariant>. See "Data.GI.Base.GVariant" for further methods.+newtype GVariant = GVariant (ManagedPtr GVariant)++-- | A <https://developer.gnome.org/gobject/stable/gobject-GParamSpec.html GParamSpec>. See "Data.GI.Base.GParamSpec" for further methods.+newtype GParamSpec = GParamSpec (ManagedPtr GParamSpec)++-- | A convenient synonym for @Nothing :: Maybe GParamSpec@.+noGParamSpec :: Maybe GParamSpec+noGParamSpec = Nothing++-- | An enum usable as a flag for a function.+class Enum a => IsGFlag a++-- | A <https://developer.gnome.org/glib/stable/glib-Arrays.html GArray>. Marshalling for this type is done in "Data.GI.Base.BasicConversions", it is mapped to a list on the Haskell side.+data GArray a = GArray (Ptr (GArray a))++-- | A <https://developer.gnome.org/glib/stable/glib-Pointer-Arrays.html GPtrArray>. Marshalling for this type is done in "Data.GI.Base.BasicConversions", it is mapped to a list on the Haskell side.+data GPtrArray a = GPtrArray (Ptr (GPtrArray a))++-- | A <https://developer.gnome.org/glib/stable/glib-Byte-Arrays.html GByteArray>. Marshalling for this type is done in "Data.GI.Base.BasicConversions", it is packed to a 'Data.ByteString.ByteString' on the Haskell side.+data GByteArray = GByteArray (Ptr GByteArray)++-- | A <https://developer.gnome.org/glib/stable/glib-Hash-Tables.html GHashTable>. It is mapped to a 'Data.Map.Map' on the Haskell side.+data GHashTable a b = GHashTable (Ptr (GHashTable a b))++-- | A <https://developer.gnome.org/glib/stable/glib-Doubly-Linked-Lists.html GList>, mapped to a list on the Haskell side. Marshalling is done in "Data.GI.Base.BasicConversions".+data GList a = GList (Ptr (GList a))++-- | A <https://developer.gnome.org/glib/stable/glib-Singly-Linked-Lists.html GSList>, mapped to a list on the Haskell side. Marshalling is done in "Data.GI.Base.BasicConversions".+data GSList a = GSList (Ptr (GSList a))++-- | Some APIs, such as `GHashTable`, pass around scalar types+-- wrapped into a pointer. We encode such a type as follows.+newtype PtrWrapped a = PtrWrapped {unwrapPtr :: Ptr a}++-- | Destroy the memory associated with a given pointer.+type GDestroyNotify a = FunPtr (Ptr a -> IO ())++-- | Free the given 'GList'.+foreign import ccall "g_list_free" g_list_free ::+    Ptr (GList a) -> IO ()++-- | Free the given 'GSList'.+foreign import ccall "g_slist_free" g_slist_free ::+    Ptr (GSList a) -> IO ()

@@ -1,41 +0,0 @@--- Some helper functions to create closures.-module Data.GI.Base.Closure-    ( Closure(..)-    , newCClosure-    , noClosure-    ) where--import Foreign--import Data.GI.Base.BasicTypes-import Data.GI.Base.ManagedPtr (wrapBoxed)-import Data.GI.Base.Utils (safeFreeFunPtrPtr)--newtype Closure = Closure (ManagedPtr Closure)--noClosure :: Maybe Closure-noClosure = Nothing--foreign import ccall "g_closure_get_type" c_g_closure_get_type ::-    IO GType--instance BoxedObject Closure where-    boxedType _ = c_g_closure_get_type---foreign import ccall "g_cclosure_new" g_cclosure_new-    :: FunPtr a -> Ptr () -> FunPtr c -> IO (Ptr Closure)--foreign import ccall "g_closure_ref" g_closure_ref-    :: Ptr Closure -> IO (Ptr Closure)--foreign import ccall "g_closure_sink" g_closure_sink-    :: Ptr Closure -> IO ()--newCClosure :: FunPtr a -> IO Closure-newCClosure ptr = do-  closure <- g_cclosure_new ptr nullPtr safeFreeFunPtrPtr-  -- The Haskell runtime will manage the memory associated to the-  -- closure, so ref and sink to let GLib know this.-  g_closure_ref closure >>= g_closure_sink-  wrapBoxed Closure closure

@@ -20,7 +20,8 @@  -- | Constructible types, i.e. those which can be allocated by `new`. class Constructible a (tag :: AttrOpTag) where-    new :: MonadIO m => (ManagedPtr a -> a) -> [AttrOp a tag] -> m a+  -- | Allocate a new instance of the given type, with the given attributes.+  new :: MonadIO m => (ManagedPtr a -> a) -> [AttrOp a tag] -> m a  -- | Default instance, assuming we have a `GObject`. instance

@@ -0,0 +1,68 @@+-- | Some helper functions for dealing with @GClosure@s.+module Data.GI.Base.GClosure+    ( GClosure(..)+    , newGClosure+    , wrapGClosurePtr+    , newGClosureFromPtr+    , noGClosure+    , unrefGClosure+    , disownGClosure+    ) where++import Foreign++import Control.Monad.IO.Class (MonadIO, liftIO)++import Data.GI.Base.BasicTypes+import Data.GI.Base.CallStack (HasCallStack)+import Data.GI.Base.ManagedPtr (newBoxed, wrapBoxed, freeBoxed,+                                disownManagedPtr)++-- | The basic type. This corresponds to a wrapped @GClosure@ on the C+-- side, which is a boxed object.+newtype GClosure a = GClosure (ManagedPtr (GClosure a))++-- | A convenience alias for @Nothing :: Maybe (GClosure a)@.+noGClosure :: Maybe (GClosure a)+noGClosure = Nothing++foreign import ccall "g_closure_get_type" c_g_closure_get_type ::+    IO GType++instance BoxedObject (GClosure a) where+    boxedType _ = c_g_closure_get_type++foreign import ccall "g_cclosure_new" g_cclosure_new+    :: FunPtr a -> Ptr () -> FunPtr c -> IO (Ptr (GClosure a))++-- Releasing the `FunPtr` for the signal handler.+foreign import ccall "& haskell_gi_release_signal_closure"+    ptr_to_release_closure :: FunPtr (Ptr () -> Ptr () -> IO ())++-- | Create a new `GClosure` holding the given `FunPtr`. Note that+-- after calling this the `FunPtr` will be freed whenever the+-- `GClosure` is garbage collected, so it is generally not safe to+-- refer to the generated `FunPtr` after this function returns.+newGClosure :: MonadIO m => FunPtr a -> m (GClosure a)+newGClosure ptr = liftIO $ do+  closure <- g_cclosure_new ptr nullPtr ptr_to_release_closure+  wrapGClosurePtr closure++-- | Take ownership of a passed in 'Ptr' to a 'GClosure'.+wrapGClosurePtr :: Ptr (GClosure a) -> IO (GClosure a)+wrapGClosurePtr = wrapBoxed GClosure++-- | Construct a Haskell wrapper for the 'GClosure', without assuming+-- ownership.+newGClosureFromPtr :: Ptr (GClosure a) -> IO (GClosure a)+newGClosureFromPtr = newBoxed GClosure++-- | Decrease the reference count of the given 'GClosure'. If the+-- reference count reaches 0 the memory will be released.+unrefGClosure :: (HasCallStack, MonadIO m) => GClosure a -> m ()+unrefGClosure closure = liftIO $ freeBoxed closure++-- | Disown (that is, remove from te purview of the Haskell Garbage+-- Collector) the given 'GClosure'.+disownGClosure :: GClosure a -> IO (Ptr (GClosure a))+disownGClosure = disownManagedPtr

@@ -1,22 +1,72 @@-{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE OverloadedStrings #-} +-- | This module constains helpers for dealing with `GObject`-derived+-- types.+ module Data.GI.Base.GObject-    ( constructGObject-    , new'+    ( -- * Constructing new `GObject`s+      constructGObject++    -- * User data+    , gobjectGetUserData+    , gobjectSetUserData++    -- * Deriving new object types+    , DerivedGObject(..)+    , registerGType+    , gobjectGetPrivateData+    , gobjectSetPrivateData++    , GObjectClass+    , gtypeFromClass+    , gtypeFromInstance++    -- * Installing properties for derived objects+    , gobjectInstallProperty+    , gobjectInstallCIntProperty+    , gobjectInstallCStringProperty     ) where  import Control.Monad.IO.Class (MonadIO, liftIO)+ import Data.Proxy (Proxy(..))+import Data.Coerce (coerce)  import Foreign.C (CUInt(..), CString, newCString)+import Foreign.Ptr (FunPtr)+import Foreign.StablePtr (newStablePtr, deRefStablePtr,+                          castStablePtrToPtr, castPtrToStablePtr) import Foreign +import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Text as T+ import Data.GI.Base.Attributes (AttrOp(..), AttrOpTag(..), AttrLabelProxy,                                 attrConstruct)-import Data.GI.Base.BasicTypes (GType(..), GObject(..), ManagedPtr)+import Data.GI.Base.BasicTypes (CGType, GType(..), GObject(..),+                                GDestroyNotify, ManagedPtr(..), GParamSpec(..),+                                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) import Data.GI.Base.Overloading (ResolveAttribute)+import Data.GI.Base.Utils (dbgLog)  #include <glib-object.h> @@ -24,7 +74,8 @@     GType -> CUInt -> Ptr CString -> Ptr a -> IO (Ptr b)  -- | Construct a GObject given the constructor and a list of settable--- attributes.+-- attributes. See `Data.GI.Base.Constructible.new` for a more general+-- version. constructGObject :: forall o m. (GObject o, MonadIO m)     => (ManagedPtr o -> o)     -> [AttrOp o 'AttrConstruct]@@ -49,7 +100,7 @@   names <- mallocBytes (nprops * sizeOf nullPtr)   values <- mallocBytes (nprops * gvalueSize)   fill names values props-  gtype <- gobjectType (undefined :: o)+  gtype <- gobjectType @o   result <- g_object_new gtype (fromIntegral nprops) names values   freeStrings nprops names   free values@@ -89,10 +140,221 @@         do peek namePtr >>= free            freeStrings (n-1) (namePtr `plusPtr` sizeOf nullPtr) --- | Construct the given `GObject`, given a set of actions--- constructing desired `GValue`s to set at construction time.-new' :: (MonadIO m, GObject o) =>-        (ManagedPtr o -> o) -> [IO (GValueConstruct o)] -> m o-new' constructor actions = do-  props <- liftIO $ sequence (actions)-  doConstructGObject constructor props+-- | Opaque wrapper around @GObjectClass@ on the C-side.+newtype GObjectClass = GObjectClass (Ptr GObjectClass)++-- | This typeclass contains the data necessary for defining a new+-- `GObject` type from Haskell.+class GObject a => DerivedGObject a where+  -- | The parent type+  type GObjectParentType a+  -- | Type of the private data for each instance.+  type GObjectPrivateData a++  -- | 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 -> 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++-- | Find the `GType` associated to a given `GObjectClass`.+gtypeFromClass :: GObjectClass -> IO GType+gtypeFromClass klass = GType <$> gtype_from_class klass++foreign import ccall "haskell_gi_gtype_from_instance" gtype_from_instance ::+        Ptr o -> IO CGType++-- | Find the `GType` for a given `GObject`.+gtypeFromInstance :: GObject o => o -> IO GType+gtypeFromInstance obj = withManagedPtr obj $ \objPtr ->+                            (GType <$> gtype_from_instance 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))++-- | Register the given type into the @GObject@ type system and return+-- the resulting `GType`, if it has not been registered already. If+-- the type has been registered already the existing `GType` will be+-- returned instead.+--+-- Note that for this function to work the type must be an instance of+-- `DerivedGObject`.+registerGType :: forall o. (HasCallStack, DerivedGObject o,+                            GObject (GObjectParentType o)) =>+                 (ManagedPtr o -> o) -> IO GType+registerGType _ = withTextCString (objectTypeName @o) $ \cTypeName -> do+  cgtype <- g_type_from_name cTypeName+  if cgtype /= 0+    then return (GType cgtype)  -- Already registered+    else do+      classInit <- mkClassInit (unwrapClassInit $ objectClassInit @o)+      instanceInit <- mkInstanceInit (unwrapInstanceInit $ objectInstanceInit @o)+      (GType parentCGType) <- gobjectType @(GObjectParentType o)+      GType <$> register_gtype parentCGType cTypeName classInit instanceInit++   where+     unwrapInstanceInit :: (GObjectClass -> IO (GObjectPrivateData o)) ->+                           CGTypeInstanceInit o+     unwrapInstanceInit instanceInit objPtr klass = do+       privateData <- instanceInit klass+       instanceSetPrivateData objPtr privateData++     unwrapClassInit :: (GObjectClass -> IO ()) -> CGTypeClassInit+     unwrapClassInit classInit klass@(GObjectClass klassPtr) = do+       getFunPtr <- mkPropertyGetter marshallGetter+       (#poke GObjectClass, get_property) klassPtr getFunPtr+       setFunPtr <- mkPropertySetter marshallSetter+       (#poke GObjectClass, set_property) klassPtr setFunPtr+       classInit klass++     marshallSetter :: CPropertySetter o+     marshallSetter objPtr _ gvPtr pspecPtr = do+       maybeGetSet <- getGParamSpecGetterSetter pspecPtr+       case maybeGetSet of+         Nothing -> do+           pspecName <- g_param_spec_get_name pspecPtr >>= cstringToText+           typeName <- gobjectType @o >>= gtypeName+           dbgLog $ "WARNING: Attempting to set unknown property \""+                    <> pspecName <> "\" of type \"" <> T.pack typeName <> "\"."+         Just pgs -> (propSetter pgs) objPtr gvPtr++     marshallGetter :: CPropertyGetter o+     marshallGetter objPtr _ destGValuePtr pspecPtr = do+       maybeGetSet <- getGParamSpecGetterSetter pspecPtr+       case maybeGetSet of+         Nothing -> do+           pspecName <- g_param_spec_get_name pspecPtr >>= cstringToText+           typeName <- gobjectType @o >>= gtypeName+           dbgLog $ "WARNING: Attempting to get unknown property \""+                    <> pspecName <> "\" of type \"" <> T.pack typeName <> "\"."+         Just pgs -> (propGetter pgs) objPtr destGValuePtr++-- | Quark with the key to the private data for this object type.+privateKey :: forall o. DerivedGObject o => IO (GQuark (GObjectPrivateData o))+privateKey = gQuarkFromString $ objectTypeName @o <> "::haskell-gi-private-data"++-- | Get the private data associated with the given object.+gobjectGetPrivateData :: forall o. (HasCallStack, DerivedGObject o) =>+                            o -> IO (GObjectPrivateData o)+gobjectGetPrivateData obj = do+  key <- privateKey @o+  maybePriv <- gobjectGetUserData obj key+  case maybePriv of+    Just priv -> return priv+    Nothing -> do+      case managedPtrAllocCallStack (coerce obj) of+        Nothing -> error ("Failed to get private data pointer!\n"+                          <> "Set the env var HASKELL_GI_DEBUG_MEM=1 to get more info.")+        Just cs -> withManagedPtr obj $ \objPtr -> do+          let errMsg = "Failed to get private data pointer for" <> show objPtr <> "!\n"+                       <> "Callstack for allocation was:\n"+                       <> prettyCallStack cs <> "\n\n"+          error errMsg++foreign import ccall g_object_get_qdata ::+   Ptr a -> GQuark b -> IO (Ptr c)++-- | Get the value of a given key for the object.+gobjectGetUserData :: (HasCallStack, GObject o) => o -> GQuark a -> IO (Maybe a)+gobjectGetUserData obj key = do+  dataPtr <- withManagedPtr obj $ \objPtr ->+                 g_object_get_qdata objPtr key+  if dataPtr /= nullPtr+    then Just <$> deRefStablePtr (castPtrToStablePtr dataPtr)+    else return Nothing++foreign import ccall "&hs_free_stable_ptr" ptr_to_hs_free_stable_ptr ::+        FunPtr (GDestroyNotify a)++foreign import ccall g_object_set_qdata_full ::+        Ptr a -> GQuark b -> Ptr () -> FunPtr (GDestroyNotify ()) -> IO ()++-- | Set the value of the user data for the given `GObject` to a+-- `StablePtr` to the given Haskell object. The `StablePtr` will be+-- freed when the object is destroyed, or the value is replaced.+gobjectSetUserData :: (HasCallStack, GObject o) =>+                   o -> GQuark a -> a -> IO ()+gobjectSetUserData obj key value = withManagedPtr obj $ \objPtr ->+  instanceSetUserData objPtr key value++-- | Like `gobjectSetUserData`, but it works on the raw object pointer+-- (so this is unsafe, unless used in a context where we are sure that+-- the GC will not release the object while we run).+instanceSetUserData :: (HasCallStack, GObject o) =>+                    Ptr o -> GQuark a -> a -> IO ()+instanceSetUserData objPtr key value = do+  stablePtr <- newStablePtr value+  g_object_set_qdata_full objPtr key (castStablePtrToPtr stablePtr)+                             ptr_to_hs_free_stable_ptr++-- | Set the private data associated with the given object.+gobjectSetPrivateData :: forall o. (HasCallStack, DerivedGObject o) =>+                         o -> GObjectPrivateData o -> IO ()+gobjectSetPrivateData obj value = withManagedPtr obj $ \objPtr ->+  instanceSetPrivateData objPtr value++-- | Set the private data for a given instance.+instanceSetPrivateData :: forall o. (HasCallStack, DerivedGObject o) =>+                          Ptr o -> GObjectPrivateData o -> IO ()+instanceSetPrivateData objPtr priv = do+  key <- privateKey @o+  instanceSetUserData objPtr key priv++foreign import ccall g_object_class_install_property ::+   GObjectClass -> CUInt -> Ptr GParamSpec -> IO ()++-- | Add a Haskell object-valued property to the given object class.+gobjectInstallProperty :: DerivedGObject o =>+                            GObjectClass -> PropertyInfo o a -> IO ()+gobjectInstallProperty klass propInfo = do+  pspec <- gParamSpecValue propInfo+  withManagedPtr pspec $ \pspecPtr ->+    g_object_class_install_property klass 1 pspecPtr++-- | Add a `Foreign.C.CInt`-valued property to the given object class.+gobjectInstallCIntProperty :: DerivedGObject o =>+                              GObjectClass -> CIntPropertyInfo o -> IO ()+gobjectInstallCIntProperty klass propInfo = do+  pspec <- gParamSpecCInt propInfo+  withManagedPtr pspec $ \pspecPtr ->+    g_object_class_install_property klass 1 pspecPtr++-- | Add a `CString`-valued property to the given object class.+gobjectInstallCStringProperty :: DerivedGObject o =>+                              GObjectClass -> CStringPropertyInfo o -> IO ()+gobjectInstallCStringProperty klass propInfo = do+  pspec <- gParamSpecCString propInfo+  withManagedPtr pspec $ \pspecPtr ->+    g_object_class_install_property klass 1 pspecPtr

@@ -1,23 +1,53 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- | Management of `GParamSpec`s. module Data.GI.Base.GParamSpec-    ( noGParamSpec+  ( -- * Memory management+    wrapGParamSpecPtr+  , newGParamSpecFromPtr+  , unrefGParamSpec+  , disownGParamSpec -    , wrapGParamSpecPtr-    , newGParamSpecFromPtr-    , unrefGParamSpec-    , disownGParamSpec-    ) where+  -- * GParamSpec building+  , PropertyInfo(..)+  , gParamSpecValue+  , CStringPropertyInfo(..)+  , gParamSpecCString+  , CIntPropertyInfo(..)+  , gParamSpecCInt -import Foreign.Ptr+  -- * Get\/Set+  , PropGetSetter(..)+  , getGParamSpecGetterSetter+  ) where++import Foreign.C (CInt(..), CString)+import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr)+import Foreign.StablePtr (newStablePtr, deRefStablePtr,+                          castStablePtrToPtr, castPtrToStablePtr) import Control.Monad (void)+import Data.Coerce (coerce)+import Data.Maybe (fromMaybe)+import Data.Text (Text) -import Data.GI.Base.ManagedPtr (newManagedPtr', withManagedPtr, disownManagedPtr)-import Data.GI.Base.BasicTypes (GParamSpec(..))+import Data.GI.Base.ManagedPtr (newManagedPtr', withManagedPtr,+                                disownManagedPtr,+                                newObject, withTransient)+import Data.GI.Base.BasicConversions (gflagsToWord, withTextCString)+import Data.GI.Base.BasicTypes (GObject(..), GParamSpec(..),+                                GType(..), IsGFlag, ManagedPtr)+import Data.GI.Base.GQuark (GQuark(..), gQuarkFromString)+import Data.GI.Base.GType (gtypeStablePtr)+import qualified Data.GI.Base.GValue as GV+import Data.GI.Base.GValue (GValue(..), IsGValue(..), take_stablePtr)  #include <glib-object.h> -noGParamSpec :: Maybe GParamSpec-noGParamSpec = Nothing- foreign import ccall "g_param_spec_ref_sink" g_param_spec_ref_sink ::     Ptr GParamSpec -> IO (Ptr GParamSpec) foreign import ccall "g_param_spec_ref" g_param_spec_ref ::@@ -50,3 +80,277 @@ -- collected. disownGParamSpec :: GParamSpec -> IO (Ptr GParamSpec) disownGParamSpec = disownManagedPtr++{- | Flags controlling the behaviour of the the parameters. -}+data GParamFlag = GParamReadable+                 {- ^ the parameter is readable -}+                 | GParamWritable+                 {- ^ the parameter is writable -}+                 | GParamConstruct+                 {- ^ the parameter will be set upon object construction -}+                 | GParamConstructOnly+                 {- ^ the parameter can only be set upon object construction -}+                 | GParamExplicitNotify+                 {- ^ calls to 'GI.GObject.Objects.Object.objectSetProperty' for this+property will not automatically result in a \"notify\" signal being+emitted: the implementation must call+'GI.GObject.Objects.Object.objectNotify' themselves in case the+property actually changes. -}+                 | AnotherGParamFlag Int+                 -- ^ Catch-all for unknown values+                 deriving (Show, Eq)++instance Enum GParamFlag where+    fromEnum GParamReadable = #const G_PARAM_READABLE+    fromEnum GParamWritable = #const G_PARAM_WRITABLE+    fromEnum GParamConstruct = #const G_PARAM_CONSTRUCT+    fromEnum GParamConstructOnly = #const G_PARAM_CONSTRUCT_ONLY+    fromEnum GParamExplicitNotify = #const G_PARAM_EXPLICIT_NOTIFY+    fromEnum (AnotherGParamFlag k) = k++    toEnum (#const G_PARAM_READABLE) = GParamReadable+    toEnum (#const G_PARAM_WRITABLE) = GParamWritable+    toEnum (#const G_PARAM_CONSTRUCT) = GParamConstruct+    toEnum (#const G_PARAM_CONSTRUCT_ONLY) = GParamConstructOnly+    toEnum (#const G_PARAM_EXPLICIT_NOTIFY) = GParamExplicitNotify+    toEnum k = AnotherGParamFlag k++instance Ord GParamFlag where+    compare a b = compare (fromEnum a) (fromEnum b)++instance IsGFlag GParamFlag++-- | Default set of flags when constructing properties.+defaultFlags :: Num a => a+defaultFlags = gflagsToWord [GParamReadable, GParamWritable,+                             GParamExplicitNotify]++-- | Low-level getter and setter for the property.+data PropGetSetter o = PropGetSetter+  { propGetter :: Ptr o -> Ptr GValue -> IO ()+  , propSetter :: Ptr o -> Ptr GValue -> IO ()+  }++-- | The `GQuark` pointing to the setter and getter of the property.+pspecQuark :: IO (GQuark (PropGetSetter o))+pspecQuark = gQuarkFromString "haskell-gi-get-set"++-- | The basic constructor for a GObject. They are all isomorphic.+newtype GObjectConstructor = GObjectConstructor (ManagedPtr GObjectConstructor)++-- | Construct a copy of the object from the given pointer.+objectFromPtr :: forall a o. GObject o => Ptr a -> IO o+objectFromPtr objPtr = newObject @o @o (coerce @_ @(ManagedPtr o -> o) GObjectConstructor) (castPtr objPtr)++-- | Wrap a Haskell getter/setter into a lower level one.+wrapGetSet :: forall o a. (GObject o, IsGValue a) =>+              (o -> IO a)       -- ^ Haskell side getter+           -> (o -> a -> IO ()) -- ^ Haskell side setter+           -> (GValue -> a -> IO ()) -- ^ Setter for the `GValue`+           -> PropGetSetter o+wrapGetSet getter setter gvalueSetter = PropGetSetter {+  propGetter = \objPtr destPtr -> do+      value <- objectFromPtr objPtr >>= getter+      withTransient GValue destPtr $ \dest -> gvalueSetter dest value+  , propSetter = \objPtr newGValuePtr ->+      withTransient GValue newGValuePtr $ \newGValue -> do+        obj <- objectFromPtr objPtr+        value <- fromGValue newGValue+        setter obj value+  }++-- | Information on a property encoding a Haskell value. Note that+-- from the C side this property will appear as an opaque pointer. Use+-- the specialized constructors below for creating properties+-- meaningful from the C side.+--+-- A property name consists of segments consisting of ASCII letters+-- and digits, separated by either the \'-\' or \'_\' character. The+-- first character of a property name must be a letter. Names which+-- violate these rules lead to undefined behaviour.+--+-- When creating and looking up a property, either separator can be+-- used, but they cannot be mixed. Using \'-\' is considerably more+-- efficient and in fact required when using property names as detail+-- strings for signals.+--+-- Beyond the name, properties have two more descriptive strings+-- associated with them, the @nick@, which should be suitable for use+-- as a label for the property in a property editor, and the @blurb@,+-- which should be a somewhat longer description, suitable for e.g. a+-- tooltip. The @nick@ and @blurb@ should ideally be localized.+data PropertyInfo o a = PropertyInfo+  { name    :: Text              -- ^ Identifier for the property.+  , nick    :: Text              -- ^ Identifier for display to the user.+  , blurb   :: Text              -- ^ Description of the property.+  , setter :: o -> a -> IO ()    -- ^ Handler invoked when the+                                 -- property is being set.+  , getter :: o -> IO a          -- ^ Handler that returns the current+                                 -- value of the property.+  , flags   :: Maybe [GParamFlag] -- ^ Set of flags, or `Nothing` for+                                 -- the default set of flags.+  }++foreign import ccall g_param_spec_boxed ::+  CString -> CString -> CString -> GType -> CInt -> IO (Ptr GParamSpec)++-- | Create a `GParamSpec` for a Haskell value.+gParamSpecValue :: forall o a. GObject o => PropertyInfo o a -> IO GParamSpec+gParamSpecValue (PropertyInfo {..}) =+  withTextCString name $ \cname ->+    withTextCString nick $ \cnick ->+      withTextCString blurb $ \cblurb -> do+        ctype <- gtypeStablePtr+        pspecPtr <- g_param_spec_boxed cname cnick cblurb+                       ctype+                       (maybe defaultFlags gflagsToWord flags)+        quark <- pspecQuark @o+        gParamSpecSetQData pspecPtr quark+          (PropGetSetter { propGetter = getter', propSetter = setter'})+        wrapGParamSpecPtr pspecPtr+  where+    getter' :: Ptr o -> Ptr GValue -> IO ()+    getter' objPtr destPtr = do+      stablePtr <- objectFromPtr objPtr >>= getter >>= newStablePtr+      take_stablePtr destPtr stablePtr++    setter' :: Ptr o -> (Ptr GValue) -> IO ()+    setter' objPtr gvPtr = withTransient GValue gvPtr $ \gv -> do+      obj <- objectFromPtr objPtr+      val <- fromGValue gv >>= deRefStablePtr+      setter obj val++-- | Information on a property of type `CInt` to be registered. A+-- property name consists of segments consisting of ASCII letters and+-- digits, separated by either the \'-\' or \'_\' character. The first+-- character of a property name must be a letter. Names which violate+-- these rules lead to undefined behaviour.+--+-- When creating and looking up a property, either separator can be+-- used, but they cannot be mixed. Using \'-\' is considerably more+-- efficient and in fact required when using property names as detail+-- strings for signals.+--+-- Beyond the name, properties have two more descriptive strings+-- associated with them, the @nick@, which should be suitable for use+-- as a label for the property in a property editor, and the @blurb@,+-- which should be a somewhat longer description, suitable for e.g. a+-- tooltip. The @nick@ and @blurb@ should ideally be localized.+data CIntPropertyInfo o = CIntPropertyInfo+  { name    :: Text              -- ^ Identifier for the property.+  , nick    :: Text              -- ^ Identifier for display to the user.+  , blurb   :: Text              -- ^ Description of the property.+  , defaultValue :: CInt         -- ^ Default value.+  , setter :: o -> CInt -> IO () -- ^ Handler invoked when the+                                 -- property is being set.+  , getter :: o -> IO CInt       -- ^ Handler that returns the current+                                 -- value of the property.+  , flags   :: Maybe [GParamFlag] -- ^ Set of flags, or `Nothing` for+                                 -- the default set of flags.+  , minValue :: Maybe CInt       -- ^ Minimum value, or `Nothing`,+                                 -- which would be replaced by+                                 -- @MININT@.+  , maxValue :: Maybe CInt       -- ^ Maximum value, or `Nothing`,+                                 -- which would be replaced by+                                 -- @MAXINT@.+  }++foreign import ccall g_param_spec_int ::+   CString -> CString -> CString -> CInt -> CInt -> CInt -> CInt+        -> IO (Ptr GParamSpec)++-- | Create a `GParamSpec` for an integer param.+gParamSpecCInt :: GObject o => CIntPropertyInfo o -> IO GParamSpec+gParamSpecCInt (CIntPropertyInfo {..}) =+  withTextCString name $ \cname ->+    withTextCString nick $ \cnick ->+      withTextCString blurb $ \cblurb -> do+        pspecPtr <- g_param_spec_int cname cnick cblurb+                                     (fromMaybe minBound minValue)+                                     (fromMaybe maxBound maxValue)+                                     defaultValue+                                     (maybe defaultFlags gflagsToWord flags)+        quark <- pspecQuark+        gParamSpecSetQData pspecPtr quark (wrapGetSet getter setter GV.set_int)+        wrapGParamSpecPtr pspecPtr++-- | Information on a property of type `Text` to be registered. A+-- property name consists of segments consisting of ASCII letters and+-- digits, separated by either the \'-\' or \'_\' character. The first+-- character of a property name must be a letter. Names which violate+-- these rules lead to undefined behaviour.+--+-- When creating and looking up a property, either separator can be+-- used, but they cannot be mixed. Using \'-\' is considerably more+-- efficient and in fact required when using property names as detail+-- strings for signals.+--+-- Beyond the name, properties have two more descriptive strings+-- associated with them, the @nick@, which should be suitable for use+-- as a label for the property in a property editor, and the @blurb@,+-- which should be a somewhat longer description, suitable for e.g. a+-- tooltip. The @nick@ and @blurb@ should ideally be localized.+data CStringPropertyInfo o = CStringPropertyInfo+  { name   :: Text+  , nick   :: Text+  , blurb  :: Text+  , defaultValue :: Maybe Text+  , flags  :: Maybe [GParamFlag]+  , setter :: o -> Maybe Text -> IO ()+  , getter :: o -> IO (Maybe Text)+  }++foreign import ccall g_param_spec_string ::+  CString -> CString -> CString -> CString -> CInt -> IO (Ptr GParamSpec)++-- | Create a `GParamSpec` for a string param.+gParamSpecCString :: GObject o => CStringPropertyInfo o -> IO GParamSpec+gParamSpecCString (CStringPropertyInfo {..}) =+  withTextCString name $ \cname ->+    withTextCString nick $ \cnick ->+      withTextCString blurb $ \cblurb -> do+        pspecPtr <- case defaultValue of+          Nothing -> g_param_spec_string cname cnick cblurb nullPtr+                          (maybe defaultFlags gflagsToWord flags)+          Just value ->+            withTextCString value $ \cdefault ->+              g_param_spec_string cname cnick cblurb cdefault+                    (maybe defaultFlags gflagsToWord flags)+        quark <- pspecQuark+        gParamSpecSetQData pspecPtr quark (wrapGetSet getter setter GV.set_string)+        wrapGParamSpecPtr pspecPtr++foreign import ccall g_param_spec_set_qdata_full ::+  Ptr GParamSpec -> GQuark a -> Ptr b -> FunPtr (Ptr c -> IO ()) -> IO ()++foreign import ccall "&hs_free_stable_ptr" ptr_to_hs_free_stable_ptr ::+        FunPtr (Ptr a -> IO ())++-- | Set the given user data on the `GParamSpec`.+gParamSpecSetQData :: Ptr GParamSpec -> GQuark a -> a -> IO ()+gParamSpecSetQData pspecPtr quark d = do+  ptr <- newStablePtr d+  g_param_spec_set_qdata_full pspecPtr quark+                              (castStablePtrToPtr ptr)+                              ptr_to_hs_free_stable_ptr++foreign import ccall g_param_spec_get_qdata ::+  Ptr GParamSpec -> GQuark a -> IO (Ptr b)++-- | Get the user data for the given `GQuark` on the `GParamSpec`.+gParamSpecGetQData :: Ptr GParamSpec -> GQuark a -> IO (Maybe a)+gParamSpecGetQData pspecPtr quark = do+  ptr <- g_param_spec_get_qdata pspecPtr quark+  if ptr /= nullPtr+    then Just <$> deRefStablePtr (castPtrToStablePtr ptr)+    else return Nothing++-- | Attempt to get the Haskell setter and getter for the given+-- `GParamSpec`. This will only be possible if the `GParamSpec` was+-- created with one of the functions above, if this is not the case+-- the function will return `Nothing`.+getGParamSpecGetterSetter :: forall o. Ptr GParamSpec ->+                              IO (Maybe (PropGetSetter o))+getGParamSpecGetterSetter pspecPtr = do+  quark <- pspecQuark @o+  gParamSpecGetQData pspecPtr quark

@@ -0,0 +1,22 @@+-- | Basic support for `GQuark`s.+module Data.GI.Base.GQuark+  ( GQuark(..)+  , gQuarkFromString+  ) where++import Data.Text (Text)+import Data.Word+import Foreign.C (CString)++import Data.GI.Base.BasicConversions (withTextCString)++#include <glib-object.h>++-- | A `GQuark`, which is simply an integer.+newtype GQuark a = GQuark (#type GQuark)++foreign import ccall g_quark_from_string :: CString -> IO (GQuark a)++-- | Construct a GQuark from the given string.+gQuarkFromString :: Text -> IO (GQuark a)+gQuarkFromString text = withTextCString text g_quark_from_string

@@ -1,11 +1,8 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | Basic `GType`s. module Data.GI.Base.GType-    ( GType(..)-    , CGType--    , gtypeName--    , gtypeString+    ( gtypeString     , gtypePointer     , gtypeInt     , gtypeUInt@@ -23,26 +20,20 @@     , gtypeVariant     , gtypeByteArray     , gtypeInvalid-    ) where -import Data.Word-import Foreign.C.String (CString, peekCString)--#include <glib-object.h>+    , gtypeStablePtr+    ) where --- | A type identifier in the GLib type system. This is the low-level--- type associated with the representation in memory, when using this--- on the Haskell side use `GType` below.-type CGType = #type GType+import Control.Monad ((>=>)) --- | A newtype for use on the haskell side.-newtype GType = GType {gtypeToCGType :: CGType}+import Foreign.C.String (CString)+import Foreign.Ptr (FunPtr)+import Foreign.StablePtr (StablePtr, newStablePtr, deRefStablePtr) -foreign import ccall "g_type_name" g_type_name :: GType -> IO CString+import Data.GI.Base.BasicConversions (withTextCString)+import Data.GI.Base.BasicTypes (GType(..), CGType) --- | Get the name assigned to the given `GType`.-gtypeName :: GType -> IO String-gtypeName gtype = g_type_name gtype >>= peekCString+#include <glib-object.h>  {-| [Note: compile-time vs run-time GTypes] @@ -68,19 +59,19 @@ gtypePointer :: GType gtypePointer = GType #const G_TYPE_POINTER --- | `GType` for signed integers (`gint` or `gint32`).+-- | `GType` for signed integers (@gint@ or @gint32@). gtypeInt :: GType gtypeInt = GType #const G_TYPE_INT --- | `GType` for unsigned integers (`guint` or `guint32`).+-- | `GType` for unsigned integers (@guint@ or @guint32@). gtypeUInt :: GType gtypeUInt = GType #const G_TYPE_UINT --- | `GType` for `glong`.+-- | `GType` for @glong@. gtypeLong :: GType gtypeLong = GType #const G_TYPE_LONG --- | `GType` for `gulong`.+-- | `GType` for @gulong@. gtypeULong :: GType gtypeULong = GType #const G_TYPE_ULONG @@ -104,11 +95,11 @@ gtypeBoolean :: GType gtypeBoolean = GType #const G_TYPE_BOOLEAN --- | `GType` corresponding to a `BoxedObject`.+-- | `GType` corresponding to a boxed object. gtypeBoxed :: GType gtypeBoxed = GType #const G_TYPE_BOXED --- | `GType` corresponding to a `GObject`.+-- | `GType` corresponding to a @GObject@. gtypeObject :: GType gtypeObject = GType #const G_TYPE_OBJECT @@ -117,7 +108,7 @@ gtypeInvalid :: GType gtypeInvalid = GType #const G_TYPE_INVALID --- | The `GType` corresponding to a `GVariant`.+-- | The `GType` corresponding to a @GVariant@. gtypeVariant :: GType gtypeVariant = GType #const G_TYPE_VARIANT @@ -137,6 +128,30 @@  foreign import ccall "g_byte_array_get_type" g_byte_array_get_type :: CGType --- | `GType` for a boxed type holding a `GByteArray`.+-- | `GType` for a boxed type holding a @GByteArray@. gtypeByteArray :: GType gtypeByteArray = GType g_byte_array_get_type++-- | Given a `StablePtr`, make a new `StablePtr` to the same+-- underlying Haskell value.+duplicateStablePtr :: StablePtr a -> IO (StablePtr a)+duplicateStablePtr = deRefStablePtr >=> newStablePtr++foreign import ccall "wrapper"+  mkStablePtrDuplicator :: (StablePtr a -> IO (StablePtr a)) ->+                            IO (FunPtr (StablePtr a -> IO (StablePtr a)))++foreign import ccall haskell_gi_register_Boxed_HsStablePtr ::+  CString -> FunPtr (StablePtr a -> IO (StablePtr a)) -> IO GType++foreign import ccall haskell_gi_Boxed_StablePtr_GType :: IO CGType++-- | The `GType` for boxed `StablePtr`s.+gtypeStablePtr :: IO GType+gtypeStablePtr = withTextCString "Boxed-HsStablePtr" $ \cTypeName -> do+  cgtype <- haskell_gi_Boxed_StablePtr_GType+  if cgtype /= 0+    then return (GType cgtype) -- Already registered+    else do+      duplicator <- mkStablePtrDuplicator duplicateStablePtr+      haskell_gi_register_Boxed_HsStablePtr cTypeName duplicator

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} module Data.GI.Base.GValue     (     -- * Constructing GValues@@ -49,14 +50,13 @@     , get_enum     , set_flags     , get_flags+    , set_stablePtr+    , get_stablePtr+    , take_stablePtr     ) where  #include <glib-object.h> -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>))-#endif- import Data.Coerce (coerce) import Data.Word import Data.Int@@ -66,13 +66,15 @@                         CLong(..), CULong(..)) import Foreign.C.String (CString) import Foreign.Ptr (Ptr, nullPtr)+import Foreign.StablePtr (StablePtr, castStablePtrToPtr, castPtrToStablePtr)  import Data.GI.Base.BasicTypes import Data.GI.Base.BasicConversions (cstringToText, textToCString)-+import Data.GI.Base.GType import Data.GI.Base.ManagedPtr import Data.GI.Base.Utils (callocBytes, freeMem) +-- | Haskell-side representation of a @GValue@. newtype GValue = GValue (ManagedPtr GValue)  -- | A convenience alias for @`Nothing` :: `Maybe` `GValue`@.@@ -175,6 +177,12 @@     toGValue = buildGValue gtypeGType set_gtype     fromGValue = get_gtype +instance IsGValue (StablePtr a) where+    toGValue val = do+      gtype <- gtypeStablePtr+      buildGValue gtype set_stablePtr val+    fromGValue = get_stablePtr+ foreign import ccall "g_value_set_string" _set_string ::     Ptr GValue -> CString -> IO () foreign import ccall "g_value_get_string" _get_string ::@@ -384,3 +392,17 @@  get_flags :: GValue -> IO CUInt get_flags gv = withManagedPtr gv _get_flags++-- | Set the value of `GValue` containing a `StablePtr`+set_stablePtr :: GValue -> StablePtr a -> IO ()+set_stablePtr gv ptr = withManagedPtr gv $ flip _set_boxed (castStablePtrToPtr ptr)++foreign import ccall g_value_take_boxed :: Ptr GValue -> StablePtr a -> IO ()++-- | Like `set_stablePtr`, but the `GValue` takes ownership of the `StablePtr`+take_stablePtr :: Ptr GValue -> StablePtr a -> IO ()+take_stablePtr = g_value_take_boxed++-- | Get the value of a `GValue` containing a `StablePtr`+get_stablePtr :: GValue -> IO (StablePtr a)+get_stablePtr gv = castPtrToStablePtr <$> withManagedPtr gv _get_boxed

@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-} -- For HasCallStack compatibility {-# LANGUAGE ImplicitParams, KindSignatures, ConstraintKinds #-}+{-# LANGUAGE TypeApplications #-}  -- | We wrap most objects in a "managed pointer", which is basically a -- 'ForeignPtr' of the appropriate type together with a notion of@@ -27,6 +28,7 @@     -- * Safe casting     , castTo     , unsafeCastTo+    , checkInstanceType      -- * Wrappers     , newObject@@ -207,20 +209,26 @@  -- Safe casting machinery foreign import ccall unsafe "check_object_type"-    c_check_object_type :: Ptr o -> CGType -> CInt+    c_check_object_type :: Ptr o -> CGType -> IO CInt +-- | Check whether the given object is an instance of the given type.+checkInstanceType :: GObject o => o -> GType -> IO Bool+checkInstanceType obj (GType cgtype) = withManagedPtr obj $ \objPtr -> do+  check <- c_check_object_type objPtr cgtype+  return $ check /= 0+ -- | Cast to the given type, checking that the cast is valid. If it is -- not, we return `Nothing`. Usage: -- -- > maybeWidget <- castTo Widget label castTo :: forall o o'. (GObject o, GObject o') =>           (ManagedPtr o' -> o') -> o -> IO (Maybe o')-castTo constructor obj =-    withManagedPtr obj $ \objPtr -> do-      GType t <- gobjectType (undefined :: o')-      if c_check_object_type objPtr t /= 1-        then return Nothing-        else Just <$> newObject constructor objPtr+castTo constructor obj = withManagedPtr obj $ \objPtr -> do+  gtype <- gobjectType @o'+  isInstance <- checkInstanceType obj gtype+  if isInstance+    then Just <$> newObject constructor objPtr+    else return Nothing  -- | Cast to the given type, assuming that the cast will succeed. This -- function will call `error` if the cast is illegal.@@ -228,11 +236,12 @@                 (ManagedPtr o' -> o') -> o -> IO o' unsafeCastTo constructor obj =   withManagedPtr obj $ \objPtr -> do-    GType t <- gobjectType (undefined :: o')-    if c_check_object_type objPtr t /= 1+    gtype <- gobjectType @o'+    isInstance <- checkInstanceType obj gtype+    if not isInstance       then do-      srcType <- gobjectType obj >>= gtypeName-      destType <- gobjectType (undefined :: o') >>= gtypeName+      srcType <- gobjectType @o >>= gtypeName+      destType <- gobjectType @o' >>= gtypeName       error $ "unsafeCastTo :: invalid conversion from " ++ srcType ++ " to "         ++ destType ++ " requested."       else newObject constructor objPtr

@@ -2,15 +2,14 @@              TypeFamilies, UndecidableInstances, EmptyDataDecls,              MultiParamTypeClasses, FlexibleInstances, ConstraintKinds #-} --- | Helpers for dealing with `GObject`s.+-- | Helpers for dealing with overladed properties, signals and+-- methods.  module Data.GI.Base.Overloading     ( -- * Type level inheritance       ParentTypes+    , HasParentTypes     , IsDescendantOf-#if MIN_VERSION_base(4,9,0)-    , UnknownAncestorError-#endif      -- * Looking up attributes in parent types     , AttributeList@@ -28,99 +27,58 @@     , MethodInfo(..)     , MethodProxy(..)     , MethodResolutionFailed--    -- * Overloaded labels-    , IsLabelProxy(..)--#if MIN_VERSION_base(4,9,0)-    , module GHC.OverloadedLabels       -- Reexported for convenience-#endif     ) where  import GHC.Exts (Constraint) import GHC.TypeLits-import Data.Proxy (Proxy) -#if MIN_VERSION_base(4,9,0)-import GHC.OverloadedLabels (IsLabel(..))-#endif---- | Support for overloaded labels in ghc < 8.0. This is like the--- `IsLabel` class introduced in ghc 8.0 (for use with the--- OverloadedLabels extension) with the difference that the `Proxy`--- argument is lifted. (Using the unlifted Proxy# type in user code is--- a bit of a pain, hence the choice.)-class IsLabelProxy (x :: Symbol) a where-  fromLabelProxy :: Proxy x -> a---- | Join two lists.-type family JoinLists (as :: [a]) (bs :: [a]) :: [a] where-    JoinLists '[] bs = bs-    JoinLists (a ': as) bs = a ': JoinLists as bs- -- | Look in the given list of (symbol, tag) tuples for the tag -- corresponding to the given symbol. If not found raise the given -- type error. type family FindElement (m :: Symbol) (ms :: [(Symbol, *)])-#if !MIN_VERSION_base(4,9,0)-    (typeError :: *)-#else-    (typeError :: ErrorMessage)-#endif-    :: * where-    FindElement m '[] typeError =-#if !MIN_VERSION_base(4,9,0)-        typeError-#else-        TypeError typeError-#endif+    (typeError :: ErrorMessage) :: * where+    FindElement m '[] typeError = TypeError typeError     FindElement m ('(m, o) ': ms) typeError = o     FindElement m ('(m', o) ': ms) typeError = FindElement m ms typeError --- | Result of a ancestor check. Basically a Bool type with a bit of--- extra info in order to improve typechecker error messages.-data AncestorCheck t a = HasAncestor a t-#if !MIN_VERSION_base(4,9,0)-                       | DoesNotHaveRequiredAncestor Symbol t Symbol a-#endif--#if MIN_VERSION_base(4,9,0)--- | Type error to be generated when an ancestor check fails.-type family UnknownAncestorError (a :: *) (t :: *) where-    UnknownAncestorError a t =-        TypeError ('Text "Required ancestor ‘" ':<>: 'ShowType a-                   ':<>: 'Text "’ not found for type ‘"-                   ':<>: 'ShowType t ':<>: 'Text "’.")-#endif- -- | Check whether a type appears in a list. We specialize the -- names/types a bit so the error messages are more informative.-type family CheckForAncestorType t (a :: *) (as :: [*]) :: AncestorCheck * * where-    CheckForAncestorType t a '[] =-#if !MIN_VERSION_base(4,9,0)-        'DoesNotHaveRequiredAncestor "Error: Required ancestor" a "not found for type" t-#else-        UnknownAncestorError a t-#endif-    CheckForAncestorType t a (a ': as) = 'HasAncestor a t-    CheckForAncestorType t a (b ': as) = CheckForAncestorType t a as+type family CheckForAncestorType t (a :: *) (as :: [*]) :: Constraint where+  CheckForAncestorType t a '[] = TypeError ('Text "Required ancestor ‘"+                                            ':<>: 'ShowType a+                                            ':<>: 'Text "’ not found for type ‘"+                                            ':<>: 'ShowType t ':<>: 'Text "’.")+  CheckForAncestorType t a (a ': as) = ()+  CheckForAncestorType t a (b ': as) = CheckForAncestorType t a as --- | Check that a type is in the list of `GObjectParents` of another--- `GObject`-derived type.+-- | Check that a type is in the list of `ParentTypes` of another+-- type. type family IsDescendantOf (parent :: *) (descendant :: *) :: Constraint where     -- Every object is defined to be a descendant of itself.-    IsDescendantOf d d = () ~ ()-    IsDescendantOf p d = CheckForAncestorType d p (ParentTypes d) ~ 'HasAncestor p d+    IsDescendantOf d d = ()+    IsDescendantOf p d = CheckForAncestorType d p (ParentTypes d) --- | The direct parents of this object: its direct parent type, if any,--- and the interfaces it implements. The interfaces inherited from--- parent types can be omitted.+-- | All the types that are ascendants of this type, including+-- interfaces that the type implements. type family ParentTypes a :: [*] +-- | A constraint on a type, to be fulfilled whenever it has a type+-- instance for `ParentTypes`. This leads to nicer errors, thanks to+-- the overlappable instance below.+class HasParentTypes o++-- | Default instance, which will give rise to an error for types+-- without an associated `ParentTypes` instance.+instance {-# OVERLAPPABLE #-}+    TypeError ('Text "Type ‘" ':<>: 'ShowType a ':<>:+               'Text "’ does not have any known parent types.")+    => HasParentTypes a+ -- | The list of attributes defined for a given type. Each element of -- the list is a tuple, with the first element of the tuple the name -- of the attribute, and the second the type encoding the information--- of the attribute. This type will be an instance of `AttrInfo`.+-- of the attribute. This type will be an instance of+-- `Data.GI.Base.Attributes.AttrInfo`. type family AttributeList a :: [(Symbol, *)]  -- | A constraint on a type, to be fulfilled whenever it has a type@@ -128,117 +86,64 @@ -- reporting. class HasAttributeList a -#if MIN_VERSION_base(4,9,0)--- Default instance, which will give rise to an error for types+-- | Default instance, which will give rise to an error for types -- without an associated `AttributeList`. instance {-# OVERLAPPABLE #-}     TypeError ('Text "Type ‘" ':<>: 'ShowType a ':<>:                'Text "’ does not have any known attributes.")     => HasAttributeList a-#endif -#if !MIN_VERSION_base(4,9,0)--- | Datatype returned when the attribute is not found, hopefully making--- the resulting error messages somewhat clearer.-data UnknownAttribute (msg1 :: Symbol) (s :: Symbol) (msg2 :: Symbol) (o :: *)-#endif- -- | Return the type encoding the attribute information for a given -- type and attribute. type family ResolveAttribute (s :: Symbol) (o :: *) :: * where     ResolveAttribute s o = FindElement s (AttributeList o)-#if !MIN_VERSION_base(4,9,0)-                           (UnknownAttribute "Error: could not find attribute" s "for object" o)-#else                            ('Text "Unknown attribute ‘" ':<>:                             'Text s ':<>: 'Text "’ for object ‘" ':<>:                             'ShowType o ':<>: 'Text "’.")-#endif  -- | Whether a given type is in the given list. If found, return -- @success@, otherwise return @failure@. type family IsElem (e :: Symbol) (es :: [(Symbol, *)]) (success :: k)-#if !MIN_VERSION_base(4,9,0)-    (failure :: k)-#else-    (failure :: ErrorMessage)-#endif-        :: k where-    IsElem e '[] success failure =-#if !MIN_VERSION_base(4,9,0)-        failure-#else-        TypeError failure-#endif+    (failure :: ErrorMessage) :: k where+    IsElem e '[] success failure = TypeError failure     IsElem e ( '(e, t) ': es) success failure = success     IsElem e ( '(other, t) ': es) s f = IsElem e es s f --- | Isomorphic to Bool, but having some extra debug information.-data AttributeCheck a t = HasAttribute-#if !MIN_VERSION_base(4,9,0)-                        | DoesNotHaveAttribute Symbol a Symbol t-#endif- -- | A constraint imposing that the given object has the given attribute.-type family HasAttribute (attr :: Symbol) (o :: *) where+type family HasAttribute (attr :: Symbol) (o :: *) :: Constraint where     HasAttribute attr o = IsElem attr (AttributeList o)-                          'HasAttribute-#if !MIN_VERSION_base(4,9,0)-                          ('DoesNotHaveAttribute "Error: attribute" attr "not found for type" o)-#else+                          (() :: Constraint) -- success                           ('Text "Attribute ‘" ':<>: 'Text attr ':<>:                            'Text "’ not found for type ‘" ':<>:                            'ShowType o ':<>: 'Text "’.")-#endif-                          ~ 'HasAttribute  -- | A constraint that enforces that the given type has a given attribute. class HasAttr (attr :: Symbol) (o :: *) instance HasAttribute attr o => HasAttr attr o --- | The list of signals defined for a given type. Each element of--- the list is a tuple, with the first element of the tuple the name--- of the signal, and the second the type encoding the information of--- the signal. This type will be an instance of `SignalInfo`.+-- | The list of signals defined for a given type. Each element of the+-- list is a tuple, with the first element of the tuple the name of+-- the signal, and the second the type encoding the information of the+-- signal. This type will be an instance of+-- `Data.GI.Base.Signals.SignalInfo`. type family SignalList a :: [(Symbol, *)] -#if !MIN_VERSION_base(4,9,0)--- | Datatype returned when the signal is not found, hopefully making--- the resulting error messages somewhat clearer.-data UnknownSignal (msg1 :: Symbol) (s :: Symbol) (msg2 :: Symbol) (o :: *)-#endif- -- | Return the type encoding the signal information for a given -- type and signal. type family ResolveSignal (s :: Symbol) (o :: *) :: * where     ResolveSignal s o = FindElement s (SignalList o)-#if !MIN_VERSION_base(4,9,0)-                        (UnknownSignal "Error: could not find signal" s "for object" o)-#else                         ('Text "Unknown signal ‘" ':<>:                          'Text s ':<>: 'Text "’ for object ‘" ':<>:                          'ShowType o ':<>: 'Text "’.")-#endif --- | Isomorphic to Bool, but having some extra debug information.-data SignalCheck s t = HasSignal-#if !MIN_VERSION_base(4,9,0)-                     | DoesNotHaveSignal Symbol s Symbol t-#endif- -- | A constraint enforcing that the signal exists for the given -- object, or one of its ancestors.-type family HasSignal (s :: Symbol) (o :: *) where+type family HasSignal (s :: Symbol) (o :: *) :: Constraint where     HasSignal s o = IsElem s (SignalList o)-                    'HasSignal-#if !MIN_VERSION_base(4,9,0)-                    ('DoesNotHaveSignal "Error: signal" s "not found for type" o)-#else+                    (() :: Constraint) -- success                     ('Text "Signal ‘" ':<>: 'Text s ':<>:                      'Text "’ not found for type ‘" ':<>:                      'ShowType o ':<>: 'Text "’.")-#endif-                    ~ 'HasSignal  -- | Class for types containing the information about an overloaded -- method of type `o -> s`.@@ -250,14 +155,10 @@ -- the autogenerated bindings. data MethodProxy a = MethodProxy -#if !MIN_VERSION_base(4,9,0)--- | Datatype returned when the method is not found, hopefully making+-- | Returned when the method is not found, hopefully making -- the resulting error messages somewhat clearer.-data MethodResolutionFailed (label :: Symbol) (o :: *)-#else type family MethodResolutionFailed (method :: Symbol) (o :: *) where     MethodResolutionFailed m o =         TypeError ('Text "Unknown method ‘" ':<>:                    'Text m ':<>: 'Text "’ for type ‘" ':<>:                    'ShowType o ':<>: 'Text "’.")-#endif

@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}  module Data.GI.Base.Properties     ( setObjectPropertyString@@ -20,6 +20,7 @@     , setObjectPropertyBoxed     , setObjectPropertyEnum     , setObjectPropertyFlags+    , setObjectPropertyClosure     , setObjectPropertyVariant     , setObjectPropertyByteArray     , setObjectPropertyPtrGList@@ -45,6 +46,7 @@     , getObjectPropertyBoxed     , getObjectPropertyEnum     , getObjectPropertyFlags+    , getObjectPropertyClosure     , getObjectPropertyVariant     , getObjectPropertyByteArray     , getObjectPropertyPtrGList@@ -70,6 +72,7 @@     , constructObjectPropertyBoxed     , constructObjectPropertyEnum     , constructObjectPropertyFlags+    , constructObjectPropertyClosure     , constructObjectPropertyVariant     , constructObjectPropertyByteArray     , constructObjectPropertyPtrGList@@ -90,6 +93,8 @@ import Data.GI.Base.BasicConversions import Data.GI.Base.ManagedPtr 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) @@ -332,21 +337,21 @@ setObjectPropertyObject :: forall a b. (GObject a, GObject b) =>                            a -> String -> Maybe b -> IO () setObjectPropertyObject obj propName maybeObject = do-  gtype <- gobjectType (undefined :: b)+  gtype <- gobjectType @b   maybeWithManagedPtr maybeObject $ \objectPtr ->       setObjectProperty obj propName objectPtr set_object gtype  constructObjectPropertyObject :: forall a o. GObject a =>                                  String -> Maybe a -> IO (GValueConstruct o) constructObjectPropertyObject propName maybeObject = do-  gtype <- gobjectType (undefined :: a)+  gtype <- gobjectType @a   maybeWithManagedPtr maybeObject $ \objectPtr ->       constructObjectProperty propName objectPtr set_object gtype  getObjectPropertyObject :: forall a b. (GObject a, GObject b) =>                            a -> String -> (ManagedPtr b -> b) -> IO (Maybe b) getObjectPropertyObject obj propName constructor = do-  gtype <- gobjectType (undefined :: b)+  gtype <- gobjectType @b   getObjectProperty obj propName                         (\val -> (get_object val :: IO (Ptr b))                             >>= flip convertIfNonNull (newObject constructor))@@ -446,6 +451,18 @@   getObjectProperty obj propName                         (\val -> wordToGFlags <$> get_flags val)                         gtype++setObjectPropertyClosure :: forall a b. GObject a =>+                          a -> String -> Maybe (GClosure b) -> IO ()+setObjectPropertyClosure = setObjectPropertyBoxed++constructObjectPropertyClosure :: String -> Maybe (GClosure a) -> IO (GValueConstruct o)+constructObjectPropertyClosure = constructObjectPropertyBoxed++getObjectPropertyClosure :: forall a b. GObject a =>+                            a -> String -> IO (Maybe (GClosure b))+getObjectPropertyClosure obj propName =+  getObjectPropertyBoxed obj propName GClosure  setObjectPropertyVariant :: GObject a =>                             a -> String -> Maybe GVariant -> IO ()

@@ -20,7 +20,7 @@     , module Data.GI.Base.Attributes     , module Data.GI.Base.BasicTypes     , module Data.GI.Base.BasicConversions-    , module Data.GI.Base.Closure+    , module Data.GI.Base.GClosure     , module Data.GI.Base.Constructible     , module Data.GI.Base.GError     , module Data.GI.Base.GHashTable@@ -29,7 +29,6 @@     , module Data.GI.Base.GVariant     , module Data.GI.Base.GValue     , module Data.GI.Base.ManagedPtr-    , module Data.GI.Base.Properties     , module Data.GI.Base.Signals     , module Data.GI.Base.Utils @@ -78,8 +77,8 @@ import Data.GI.Base.Attributes hiding (get, set) import Data.GI.Base.BasicTypes import Data.GI.Base.BasicConversions-import Data.GI.Base.Closure import Data.GI.Base.Constructible+import Data.GI.Base.GClosure (GClosure) import Data.GI.Base.GError import Data.GI.Base.GHashTable import Data.GI.Base.GObject@@ -87,7 +86,6 @@ import Data.GI.Base.GVariant import Data.GI.Base.GValue import Data.GI.Base.ManagedPtr-import Data.GI.Base.Properties import Data.GI.Base.Signals (SignalConnectMode(..), connectSignalFunPtr, SignalHandlerId, SignalInfo(..), GObjectNotifySignalInfo) import Data.GI.Base.Utils 

@@ -17,6 +17,7 @@     , SignalProxy(..)     , SignalConnectMode(..)     , connectSignalFunPtr+    , disconnectSignalHandler     , SignalHandlerId     , SignalInfo(..)     , GObjectNotifySignalInfo@@ -27,6 +28,7 @@  import Foreign import Foreign.C+import Foreign.Ptr (nullPtr)  import GHC.TypeLits @@ -34,9 +36,7 @@ import Data.GI.Base.BasicTypes import Data.GI.Base.GParamSpec (newGParamSpecFromPtr) import Data.GI.Base.ManagedPtr (withManagedPtr)-import Data.GI.Base.Overloading (ResolveSignal,-                                 IsLabelProxy(..), ResolveAttribute)-import Data.GI.Base.Utils (safeFreeFunPtrPtr)+import Data.GI.Base.Overloading (ResolveSignal, ResolveAttribute)  #if MIN_VERSION_base(4,9,0) import GHC.OverloadedLabels (IsLabel(..))@@ -47,10 +47,6 @@ -- | Type of a `GObject` signal handler id. type SignalHandlerId = CULong --- | A class that provides a constraint satisfied by every type.-class NoConstraint a-instance NoConstraint a- -- | Support for overloaded signal connectors. data SignalProxy (object :: *) (info :: *) where     SignalProxy :: SignalProxy o info@@ -61,21 +57,11 @@                       SignalProxy o (GObjectNotifySignalInfo pl)  -- | Support for overloaded labels.-instance-#if !MIN_VERSION_base(4,9,0)-    -- This gives better error reporting in ghc < 8.0.-       (HasSignal slot object, info ~ ResolveSignal slot object)-#else-       info ~ ResolveSignal slot object-#endif-    => IsLabelProxy slot (SignalProxy object info) where-    fromLabelProxy _ = SignalProxy- #if MIN_VERSION_base(4,10,0) instance info ~ ResolveSignal slot object =>     IsLabel slot (SignalProxy object info) where     fromLabel = SignalProxy-#elif MIN_VERSION_base(4,9,0)+#else instance info ~ ResolveSignal slot object =>     IsLabel slot (SignalProxy object info) where     fromLabel _ = SignalProxy@@ -119,7 +105,7 @@ after o p c = liftIO $ connectSignal p o c SignalConnectAfter  -- Connecting GObjects to signals-foreign import ccall "g_signal_connect_data" g_signal_connect_data ::+foreign import ccall g_signal_connect_data ::     Ptr a ->                            -- instance     CString ->                          -- detailed_signal     FunPtr b ->                         -- c_handler@@ -128,6 +114,10 @@     CUInt ->                            -- connect_flags     IO SignalHandlerId +-- Releasing the `FunPtr` for the signal handler.+foreign import ccall "& haskell_gi_release_signal_closure"+    ptr_to_release_closure :: FunPtr (Ptr () -> Ptr () -> IO ())+ -- | Connect a signal to a handler, given as a `FunPtr`. connectSignalFunPtr :: GObject o =>                   o -> String -> FunPtr a -> SignalConnectMode -> IO SignalHandlerId@@ -137,8 +127,16 @@                 SignalConnectBefore -> 0   withCString signal $ \csignal ->     withManagedPtr object $ \objPtr ->-        g_signal_connect_data objPtr csignal fn (castFunPtrToPtr fn) safeFreeFunPtrPtr flags+      g_signal_connect_data objPtr csignal fn nullPtr ptr_to_release_closure flags +foreign import ccall g_signal_handler_disconnect :: Ptr o -> SignalHandlerId -> IO ()++-- | Disconnect a previously connected signal.+disconnectSignalHandler :: GObject o => o -> SignalHandlerId -> IO ()+disconnectSignalHandler obj handlerId =+  withManagedPtr obj $ \objPtr ->+        g_signal_handler_disconnect objPtr handlerId+ -- | Connection information for a "notify" signal indicating that a -- specific property changed (see `PropertyNotify` for the relevant -- constructor).@@ -148,7 +146,7 @@   type HaskellCallbackType (GObjectNotifySignalInfo propName) = GObjectNotifyCallback   connectSignal = connectGObjectNotify (symbolVal (Proxy :: Proxy propName)) --- | Type for a `GObject` `notify` callback.+-- | Type for a `GObject` "notify" callback. type GObjectNotifyCallback = GParamSpec -> IO ()  gobjectNotifyCallbackWrapper ::

@@ -271,3 +271,97 @@   if (ptr != NULL)     freeHaskellFunctionPtr(ptr); }++/* Returns the GType associated to a class instance */+GType haskell_gi_gtype_from_class (gpointer klass)+{+  return G_TYPE_FROM_CLASS (klass);+}++/* Returns the GType associated to a given instance */+GType haskell_gi_gtype_from_instance (gpointer instance)+{+  return G_TYPE_FROM_INSTANCE (instance);+}++static pthread_mutex_t gtypes_mutex = PTHREAD_MUTEX_INITIALIZER;++/* 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)+{+  GType result;++  /* We lock here in order to make sure that we don't try to register+     the same type twice. */+  pthread_mutex_lock(&gtypes_mutex);+  result = g_type_from_name (name);++  if (result == 0) {+    /* Note that class_init and instance_init are HsFunPtrs, which we+       keep alive for the duration of the program. */+    GTypeQuery query;+    g_type_query (parent, &query);+    result = g_type_register_static_simple (parent, name,+                                            query.class_size, class_init,+                                            query.instance_size, instance_init,+                                            0);+  } 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);+  }+  pthread_mutex_unlock(&gtypes_mutex);++  return result;+}++static pthread_mutex_t stablePtr_mutex = PTHREAD_MUTEX_INITIALIZER;++static GType stablePtr_gtype = 0;++GType haskell_gi_Boxed_StablePtr_GType (void)+{+  return stablePtr_gtype;+}++/* Register the Haskell StablePtr type as a boxed type. */+GType haskell_gi_register_Boxed_HsStablePtr+        (const char *typeName, HsStablePtr (*duplicator)(HsStablePtr))+{+  GType result;++  /* Lock so that we avoid trying to register twice, which would give+     rise to a small memory leak for the duplicator FunPtr */+  pthread_mutex_lock(&stablePtr_mutex);++  if (stablePtr_gtype != 0) {+    hs_free_fun_ptr ((HsFunPtr)duplicator);+    result = stablePtr_gtype;+  } else {+    result = g_boxed_type_register_static (typeName, duplicator,+                                           hs_free_stable_ptr);+    stablePtr_gtype = result;+  }++  pthread_mutex_unlock(&stablePtr_mutex);++  return result;+}++/* Release the FunPtr allocated for a Haskell signal handler */+void+haskell_gi_release_signal_closure (gpointer unused,+                                   GCClosure *closure)+{+  lock_log();+  dbg_log("Releasing a signal closure %p\n", closure->callback);++  hs_free_fun_ptr (closure->callback);++  dbg_log("\tDone.\n");+  unlock_log();+}

@@ -1,5 +1,5 @@ name:                haskell-gi-base-version:             0.21.5+version:             0.22.0 synopsis:            Foundation for libraries generated by haskell-gi description:         Foundation for libraries generated by haskell-gi homepage:            https://github.com/haskell-gi/haskell-gi-base@@ -27,11 +27,12 @@                        Data.GI.Base.BasicConversions,                        Data.GI.Base.BasicTypes,                        Data.GI.Base.CallStack,-                       Data.GI.Base.Closure,                        Data.GI.Base.Constructible,                        Data.GI.Base.GError,+                       Data.GI.Base.GClosure,                        Data.GI.Base.GHashTable,                        Data.GI.Base.GObject,+                       Data.GI.Base.GQuark,                        Data.GI.Base.GType,                        Data.GI.Base.GValue,                        Data.GI.Base.GVariant,@@ -44,20 +45,15 @@                        Data.GI.Base.Utils    pkgconfig-depends:   gobject-2.0 >= 2.32, glib-2.0-  build-depends:       base >= 4.7 && < 5,+  build-depends:       base >= 4.9 && < 5,                        bytestring,                        containers,                        text >= 1.0 -  if !impl(ghc >= 8.0)-    build-depends:     transformers--  if impl(ghc >= 8.0)-    ghc-options: -Wall -Wno-redundant-constraints -fwarn-incomplete-patterns-  else-    ghc-options: -Wall -fwarn-incomplete-patterns+  ghc-options: -Wall -Wno-redundant-constraints -fwarn-incomplete-patterns    build-tools:         hsc2hs   cc-options:          -fPIC   extensions:          CPP, ForeignFunctionInterface, DoAndIfThenElse, MonoLocalBinds+  other-extensions:    TypeApplications, ScopedTypeVariables   c-sources:           c/hsgclosure.c