haskell-gi-base 0.22.2 → 0.23.0

raw patch · 17 files changed

+419/−191 lines, 17 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/GI/Base.hs +3/−1
• Data/GI/Base/Attributes.hs +167/−38
• Data/GI/Base/BasicTypes.hsc +6/−1
• Data/GI/Base/Constructible.hs +1/−4
• Data/GI/Base/GObject.hsc +48/−17
• Data/GI/Base/GParamSpec.hsc +1/−2
• Data/GI/Base/GType.hsc +8/−28
• Data/GI/Base/GValue.hsc +1/−3
• Data/GI/Base/GVariant.hsc +2/−3
• Data/GI/Base/Overloading.hs +32/−13
• Data/GI/Base/Overloading.hs-boot +3/−0
• Data/GI/Base/Properties.hsc +19/−0
• Data/GI/Base/ShortPrelude.hs +1/−1
• Data/GI/Base/Signals.hsc +99/−45
• Data/GI/Base/Utils.hsc +9/−6
• c/hsgclosure.c +14/−25
• haskell-gi-base.cabal +5/−4

@@ -16,6 +16,7 @@     , module Data.GI.Base.GVariant     , module Data.GI.Base.ManagedPtr     , module Data.GI.Base.Signals+    , module Data.GI.Base.Overloading     ) where  import Data.GI.Base.Attributes (get, set, AttrOp(..))@@ -28,4 +29,5 @@ import Data.GI.Base.GValue (GValue(..), IsGValue(..)) import Data.GI.Base.GVariant import Data.GI.Base.ManagedPtr-import Data.GI.Base.Signals (on, after, SignalProxy(PropertyNotify))+import Data.GI.Base.Signals (on, after, SignalProxy(PropertyNotify, (:::)))+import Data.GI.Base.Overloading (asA)

@@ -1,6 +1,7 @@ {-# LANGUAGE GADTs, ScopedTypeVariables, DataKinds, KindSignatures,   TypeFamilies, TypeOperators, MultiParamTypeClasses, ConstraintKinds,-  UndecidableInstances, FlexibleInstances #-}+  UndecidableInstances, FlexibleInstances, TypeApplications,+  DefaultSignatures, PolyKinds, AllowAmbiguousTypes #-}  -- | --@@ -147,11 +148,11 @@  import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Proxy (Proxy(..))- import Data.GI.Base.GValue (GValueConstruct) import Data.GI.Base.Overloading (HasAttributeList, ResolveAttribute) +import Data.Proxy (Proxy(..))+ import GHC.TypeLits import GHC.Exts (Constraint) @@ -174,42 +175,97 @@ class AttrInfo (info :: *) where     -- | The operations that are allowed on the attribute.     type AttrAllowedOps info :: [AttrOpTag]-    -- | Constraint on the value being set.-    type AttrSetTypeConstraint info :: * -> Constraint+     -- | Constraint on the type for which we are allowed to     -- create\/set\/get the attribute.     type AttrBaseTypeConstraint info :: * -> Constraint+     -- | Type returned by `attrGet`.     type AttrGetType info++    -- | Constraint on the value being set.+    type AttrSetTypeConstraint info :: * -> Constraint+    type AttrSetTypeConstraint info = (~) (AttrGetType info)++    -- | Constraint on the value being set, with allocation allowed+    -- (see ':&=' below).+    type AttrTransferTypeConstraint info :: * -> Constraint+    type AttrTransferTypeConstraint info = (~) (AttrTransferType info)++    -- | Type resulting from the allocation.+    type AttrTransferType info :: *+    type AttrTransferType info = AttrGetType info+     -- | Name of the attribute.     type AttrLabel info :: Symbol+     -- | Type which introduces the attribute.     type AttrOrigin info+     -- | Get the value of the given attribute.     attrGet :: AttrBaseTypeConstraint info o =>-               Proxy info -> o -> IO (AttrGetType info)+               o -> IO (AttrGetType info)+    default attrGet :: -- Make sure that a non-default method+                       -- implementation is provided if AttrGet+                       -- is set.+                        CheckNotElem 'AttrGet (AttrAllowedOps info)+                         (GetNotProvidedError info) =>+                       o -> IO (AttrGetType info)+    attrGet = undefined+     -- | Set the value of the given attribute, after the object having     -- the attribute has already been created.     attrSet :: (AttrBaseTypeConstraint info o,                 AttrSetTypeConstraint info b) =>-               Proxy info -> o -> b -> IO ()+               o -> b -> IO ()+    default attrSet :: -- Make sure that a non-default method+                        -- implementation is provided if AttrSet+                        -- is set.+                        CheckNotElem 'AttrSet (AttrAllowedOps info)+                         (SetNotProvidedError info) =>+                       o -> b -> IO ()+    attrSet = undefined+     -- | Set the value of the given attribute to @NULL@ (for nullable     -- attributes).     attrClear :: AttrBaseTypeConstraint info o =>-                 Proxy info -> o -> IO ()+                 o -> IO ()+    default attrClear ::  -- Make sure that a non-default method+                          -- implementation is provided if AttrClear+                          -- is set.+                          CheckNotElem 'AttrClear (AttrAllowedOps info)+                                       (ClearNotProvidedError info) =>+                      o -> IO ()+    attrClear = undefined+     -- | Build a `Data.GI.Base.GValue.GValue` representing the attribute.     attrConstruct :: (AttrBaseTypeConstraint info o,                       AttrSetTypeConstraint info b) =>-                     Proxy info -> b -> IO (GValueConstruct o)+                     b -> IO (GValueConstruct o)+    default attrConstruct :: -- Make sure that a non-default method+                             -- implementation is provided if AttrConstruct+                             -- is set.+                             CheckNotElem 'AttrConstruct (AttrAllowedOps info)+                               (ConstructNotProvidedError info) =>+                      b -> IO (GValueConstruct o)+    attrConstruct = undefined --- | Result of checking whether an op is allowed on an attribute.-data OpAllowed tag attrName definingType useType =-    OpIsAllowed-#if !MIN_VERSION_base(4,9,0)-        | AttrOpNotAllowed Symbol tag Symbol definingType Symbol attrName-#endif+    -- | Allocate memory as necessary to generate a settable type from+    -- the transfer type. This is useful for types which needs+    -- allocations for marshalling from Haskell to C, this makes the+    -- allocation explicit.+    attrTransfer :: forall o b. (AttrBaseTypeConstraint info o,+                               AttrTransferTypeConstraint info b) =>+                    Proxy o -> b -> IO (AttrTransferType info)+    default attrTransfer :: forall o b. (AttrBaseTypeConstraint info o,+                             AttrTransferTypeConstraint info b,+                             b ~ AttrGetType info,+                             b ~ AttrTransferType info) =>+                            Proxy o -> b -> IO (AttrTransferType info)+    attrTransfer _ = return -#if MIN_VERSION_base(4,9,0)+-- | Pretty print a type, indicating the parent type that introduced+-- the attribute, if different. type family TypeOriginInfo definingType useType :: ErrorMessage where     TypeOriginInfo definingType definingType =         'Text "‘" ':<>: 'ShowType definingType ':<>: 'Text "’"@@ -217,35 +273,85 @@         'Text "‘" ':<>: 'ShowType useType ':<>:         'Text "’ (inherited from parent type ‘" ':<>:         'ShowType definingType ':<>: 'Text "’)"-#endif  -- | Look in the given list to see if the given `AttrOp` is a member, -- if not return an error type.-type family AttrOpIsAllowed (tag :: AttrOpTag) (ops :: [AttrOpTag]) (label :: Symbol) (definingType :: *) (useType :: *) :: OpAllowed AttrOpTag Symbol * * where+type family AttrOpIsAllowed (tag :: AttrOpTag) (ops :: [AttrOpTag]) (label :: Symbol) (definingType :: *) (useType :: *) :: Constraint where     AttrOpIsAllowed tag '[] label definingType useType =-#if !MIN_VERSION_base(4,9,0)-        'AttrOpNotAllowed "Error: operation " tag " not allowed for attribute " definingType "." label-#else         TypeError ('Text "Attribute ‘" ':<>: 'Text label ':<>:                    'Text "’ for type " ':<>:                    TypeOriginInfo definingType useType ':<>:                    'Text " is not " ':<>:                    'Text (AttrOpText tag) ':<>: 'Text ".")-#endif-    AttrOpIsAllowed tag (tag ': ops) label definingType useType = 'OpIsAllowed+    AttrOpIsAllowed tag (tag ': ops) label definingType useType = ()     AttrOpIsAllowed tag (other ': ops) label definingType useType = AttrOpIsAllowed tag ops label definingType useType  -- | Whether a given `AttrOpTag` is allowed on an attribute, given the -- info type. type family AttrOpAllowed (tag :: AttrOpTag) (info :: *) (useType :: *) :: Constraint where     AttrOpAllowed tag info useType =-        AttrOpIsAllowed tag (AttrAllowedOps info) (AttrLabel info) (AttrOrigin info) useType ~ 'OpIsAllowed+        AttrOpIsAllowed tag (AttrAllowedOps info) (AttrLabel info) (AttrOrigin info) useType +-- | Error to be raised when an operation is allowed, but an+-- implementation has not been provided.+type family OpNotProvidedError (info :: o) (op :: AttrOpTag) (methodName :: Symbol) :: ErrorMessage where+  OpNotProvidedError info op methodName =+    'Text "The attribute ‘" ':<>: 'Text (AttrLabel info) ':<>:+    'Text "’ for type ‘" ':<>:+    'ShowType (AttrOrigin info) ':<>:+    'Text "’ is declared as " ':<>:+    'Text (AttrOpText op) ':<>:+    'Text ", but no implementation of ‘" ':<>:+    'Text methodName ':<>:+    'Text "’ has been provided."+    ':$$: 'Text "Either provide an implementation of ‘" ':<>:+    'Text methodName ':<>:+    'Text "’ or remove ‘" ':<>:+    'ShowType op ':<>:+    'Text "’ from ‘AttrAllowedOps’."++-- | Error to be raised when AttrClear is allowed, but an+-- implementation has not been provided.+type family ClearNotProvidedError (info :: o) :: ErrorMessage where+  ClearNotProvidedError info = OpNotProvidedError info 'AttrClear "attrClear"++-- | Error to be raised when AttrGet is allowed, but an+-- implementation has not been provided.+type family GetNotProvidedError (info :: o) :: ErrorMessage where+  GetNotProvidedError info = OpNotProvidedError info 'AttrGet "attrGet"++-- | Error to be raised when AttrSet is allowed, but an+-- implementation has not been provided.+type family SetNotProvidedError (info :: o) :: ErrorMessage where+  SetNotProvidedError info = OpNotProvidedError info 'AttrSet "attrSet"++-- | Error to be raised when AttrConstruct is allowed, but an+-- implementation has not been provided.+type family ConstructNotProvidedError (info :: o) :: ErrorMessage where+  ConstructNotProvidedError info = OpNotProvidedError info 'AttrConstruct "attrConstruct"++-- | Check if the given element is a member, and if so raise the given+-- error.+type family CheckNotElem (a :: k) (as :: [k]) (msg :: ErrorMessage) :: Constraint where+  CheckNotElem a '[] msg = ()+  CheckNotElem a (a ': rest) msg = TypeError msg+  CheckNotElem a (other ': rest) msg = CheckNotElem a rest msg+ -- | Possible operations on an attribute.-data AttrOpTag = AttrGet | AttrSet | AttrConstruct | AttrClear+data AttrOpTag = AttrGet+               -- ^ It is possible to read the value of the attribute+               -- with `get`.+               | AttrSet+               -- ^ It is possible to write the value of the attribute+               -- with `set`.+               | AttrConstruct+               -- ^ It is possible to set the value of the attribute+               -- in `Data.GI.Base.Constructible.new`.+               | AttrClear+               -- ^ It is possible to clear the value of the+               -- (nullable) attribute with `clear`.   deriving (Eq, Ord, Enum, Bounded, Show) -#if MIN_VERSION_base(4,9,0) -- | A user friendly description of the `AttrOpTag`, useful when -- printing type errors. type family AttrOpText (tag :: AttrOpTag) :: Symbol where@@ -253,7 +359,6 @@     AttrOpText 'AttrSet = "settable"     AttrOpText 'AttrConstruct = "constructible"     AttrOpText 'AttrClear = "nullable"-#endif  -- | Constraint on a @obj@\/@attr@ pair so that `set` works on values -- of type @value@.@@ -313,22 +418,46 @@               (AttrSetTypeConstraint info) b,               a ~ (AttrGetType info)) =>              AttrLabelProxy (attr :: Symbol) -> (a -> IO b) -> AttrOp obj tag+    -- | Assign a value to an attribute, allocating any necessary+    -- memory for representing the Haskell value as a C value. Note+    -- that it is the responsibility of the caller to make sure that+    -- the memory is freed when no longer used, otherwise there will+    -- be a memory leak. In the majority of cases you probably want to+    -- use ':=' instead, which has no potential memory leaks (at the+    -- cost of sometimes requiring some explicit Haskell -> C+    -- marshalling).+    (:&=) :: (HasAttributeList obj,+              info ~ ResolveAttribute attr obj,+              AttrInfo info,+              AttrBaseTypeConstraint info obj,+              AttrOpAllowed tag info obj,+              (AttrTransferTypeConstraint info) b,+              AttrSetTypeConstraint info (AttrTransferType info)) =>+             AttrLabelProxy (attr :: Symbol) -> b -> AttrOp obj tag  -- | Set a number of properties for some object. set :: forall o m. MonadIO m => o -> [AttrOp o 'AttrSet] -> m () set obj = liftIO . mapM_ app  where-   resolve :: AttrLabelProxy attr -> Proxy (ResolveAttribute attr o)-   resolve _ = Proxy-    app :: AttrOp o 'AttrSet -> IO ()-   app (attr :=  x) = attrSet (resolve attr) obj x-   app (attr :=> x) = x >>= attrSet (resolve attr) obj-   app (attr :~  f) = attrGet (resolve attr) obj >>=-                      \v -> attrSet (resolve attr) obj (f v)-   app (attr :~> f) = attrGet (resolve attr) obj >>= f >>=-                      attrSet (resolve attr) obj+   app ((_attr :: AttrLabelProxy label) :=  x) =+     attrSet @(ResolveAttribute label o) obj x +   app ((_attr :: AttrLabelProxy label) :=> x) =+     x >>= attrSet @(ResolveAttribute label o) obj++   app ((_attr :: AttrLabelProxy label) :~  f) =+     attrGet @(ResolveAttribute label o) obj >>=+     \v -> attrSet @(ResolveAttribute label o) obj (f v)++   app ((_attr :: AttrLabelProxy label) :~> f) =+     attrGet @(ResolveAttribute label o) obj >>= f >>=+     attrSet @(ResolveAttribute label o) obj++   app ((_attr :: AttrLabelProxy label) :&= x) =+     attrTransfer @(ResolveAttribute label o) (Proxy @o) x >>=+     attrSet @(ResolveAttribute label o) obj+ -- | Constraints on a @obj@\/@attr@ pair so `get` is possible, -- producing a value of type @result@. type AttrGetC info obj attr result = (HasAttributeList obj,@@ -342,7 +471,7 @@ get :: forall info attr obj result m.        (AttrGetC info obj attr result, MonadIO m) =>         obj -> AttrLabelProxy (attr :: Symbol) -> m result-get o _ = liftIO $ attrGet (Proxy :: Proxy info) o+get o _ = liftIO $ attrGet @info o  -- | Constraint on a @obj@\/@attr@ pair so that `clear` is allowed. type AttrClearC info obj attr = (HasAttributeList obj,@@ -355,4 +484,4 @@ clear :: forall info attr obj m.          (AttrClearC info obj attr, MonadIO m) =>          obj -> AttrLabelProxy (attr :: Symbol) -> m ()-clear o _ = liftIO $ attrClear (Proxy :: Proxy info) o+clear o _ = liftIO $ attrClear @info o

@@ -53,7 +53,7 @@ import Foreign.ForeignPtr (ForeignPtr)  import Data.GI.Base.CallStack (CallStack)-import Data.GI.Base.Overloading (HasParentTypes)+import {-# SOURCE #-} Data.GI.Base.Overloading (HasParentTypes)  #include <glib-object.h> @@ -67,6 +67,11 @@     , managedPtrIsDisowned :: IORef (Maybe CallStack)     -- ^ When disowned, the `CallStack` for the disowning call.     }++-- | Two 'ManagedPtr's are equal if they wrap the same underlying+-- C 'Ptr'.+instance Eq (ManagedPtr a) where+  a == b = managedForeignPtr a == managedForeignPtr b  -- | A constraint ensuring that the given type is coercible to a -- ManagedPtr. It will hold for newtypes of the form

@@ -24,9 +24,6 @@   new :: MonadIO m => (ManagedPtr a -> a) -> [AttrOp a tag] -> m a  -- | Default instance, assuming we have a `GObject`.-instance-#if MIN_VERSION_base(4,8,0)-    {-# OVERLAPPABLE #-}-#endif+instance {-# OVERLAPPABLE #-}     (GObject a, tag ~ 'AttrConstruct) => Constructible a tag where         new = constructGObject

@@ -18,14 +18,16 @@     -- * User data     , gobjectGetUserData     , gobjectSetUserData+    , gobjectModifyUserData      -- * Deriving new object types     , DerivedGObject(..)     , registerGType     , gobjectGetPrivateData     , gobjectSetPrivateData+    , gobjectModifyPrivateData -    , GObjectClass+    , GObjectClass(..)     , gtypeFromClass     , gtypeFromInstance @@ -41,17 +43,22 @@ import Data.Coerce (coerce)  import Foreign.C (CUInt(..), CString, newCString)+#if !MIN_VERSION_base(4,13,0) import Foreign.Ptr (FunPtr) import Foreign.StablePtr (newStablePtr, deRefStablePtr,                           castStablePtrToPtr, castPtrToStablePtr)+#endif import Foreign +#if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))+#endif import Data.Text (Text) import qualified Data.Text as T  import Data.GI.Base.Attributes (AttrOp(..), AttrOpTag(..), AttrLabelProxy,-                                attrConstruct)+                                attrConstruct, attrTransfer,+                                AttrInfo(..)) import Data.GI.Base.BasicTypes (CGType, GType(..), GObject(..),                                 GDestroyNotify, ManagedPtr(..), GParamSpec(..),                                 gtypeName)@@ -65,7 +72,8 @@                                 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.ManagedPtr (withManagedPtr, touchManagedPtr, wrapObject,+                                newObject) import Data.GI.Base.Overloading (ResolveAttribute) import Data.GI.Base.Utils (dbgLog) @@ -85,14 +93,18 @@   props <- mapM construct attrs   doConstructGObject constructor props   where-    resolve :: AttrLabelProxy attr -> Proxy (ResolveAttribute attr o)-    resolve _ = Proxy-     construct :: AttrOp o 'AttrConstruct ->                  IO (GValueConstruct o)-    construct (attr := x) = attrConstruct (resolve attr) x-    construct (attr :=> x) = x >>= attrConstruct (resolve attr)+    construct ((_attr :: AttrLabelProxy label) := x) =+      attrConstruct @(ResolveAttribute label o) x +    construct ((_attr :: AttrLabelProxy label) :=> x) =+      x >>= attrConstruct @(ResolveAttribute label o)++    construct ((_attr :: AttrLabelProxy label) :&= x) =+      attrTransfer @(ResolveAttribute label o) (Proxy @o) x >>=+      attrConstruct @(ResolveAttribute label o)+ -- | Construct the given `GObject`, given a set of actions -- constructing desired `GValue`s to set at construction time. new' :: (MonadIO m, GObject o) =>@@ -149,7 +161,7 @@         do peek namePtr >>= free            freeStrings (n-1) (namePtr `plusPtr` sizeOf nullPtr) --- | Opaque wrapper around @GObjectClass@ on the C-side.+-- | Wrapper around @GObjectClass@ on the C-side. newtype GObjectClass = GObjectClass (Ptr GObjectClass)  -- | This typeclass contains the data necessary for defining a new@@ -169,7 +181,7 @@   -- 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)+  objectInstanceInit :: GObjectClass -> a -> IO (GObjectPrivateData a)  type CGTypeClassInit = GObjectClass -> IO () foreign import ccall "wrapper"@@ -221,9 +233,10 @@ -- Note that for this function to work the type must be an instance of -- `DerivedGObject`. registerGType :: forall o. (HasCallStack, DerivedGObject o,-                            GObject (GObjectParentType o)) =>+                            GObject (GObjectParentType o),+                            GObject o) =>                  (ManagedPtr o -> o) -> IO GType-registerGType _ = withTextCString (objectTypeName @o) $ \cTypeName -> do+registerGType construct = withTextCString (objectTypeName @o) $ \cTypeName -> do   cgtype <- g_type_from_name cTypeName   if cgtype /= 0     then return (GType cgtype)  -- Already registered@@ -234,10 +247,12 @@       GType <$> register_gtype parentCGType cTypeName classInit instanceInit     where-     unwrapInstanceInit :: (GObjectClass -> IO (GObjectPrivateData o)) ->+     unwrapInstanceInit :: (GObjectClass -> o -> IO (GObjectPrivateData o)) ->                            CGTypeInstanceInit o      unwrapInstanceInit instanceInit objPtr klass = do-       privateData <- instanceInit klass+       privateData <- do+         obj <- newObject construct (castPtr objPtr :: Ptr o)+         instanceInit klass obj        instanceSetPrivateData objPtr privateData       unwrapClassInit :: (GObjectClass -> IO ()) -> CGTypeClassInit@@ -318,9 +333,17 @@ 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).+-- | A combination of `gobjectGetUserData` and `gobjectSetUserData`,+-- for convenience.+gobjectModifyUserData :: (HasCallStack, GObject o) =>+                   o -> GQuark a -> (Maybe a -> a) -> IO ()+gobjectModifyUserData obj key transform = do+  userData <- gobjectGetUserData obj key+  gobjectSetUserData obj key (transform userData)++-- | Like `gobjectSetUserData`, but it works on the raw object pointer.+-- Note that 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@@ -343,6 +366,14 @@  foreign import ccall g_object_class_install_property ::    GObjectClass -> CUInt -> Ptr GParamSpec -> IO ()++-- | Modify the private data for the given object.+gobjectModifyPrivateData :: forall o. (HasCallStack, DerivedGObject o) =>+                         o -> (GObjectPrivateData o -> GObjectPrivateData o)+                         -> IO ()+gobjectModifyPrivateData obj transform = do+  private <- gobjectGetPrivateData obj+  gobjectSetPrivateData obj (transform private)  -- | Add a Haskell object-valued property to the given object class. gobjectInstallProperty :: DerivedGObject o =>

@@ -200,9 +200,8 @@   withTextCString name $ \cname ->     withTextCString nick $ \cnick ->       withTextCString blurb $ \cblurb -> do-        ctype <- gtypeStablePtr         pspecPtr <- g_param_spec_boxed cname cnick cblurb-                       ctype+                       gtypeStablePtr                        (maybe defaultFlags gflagsToWord flags)         quark <- pspecQuark @o         gParamSpecSetQData pspecPtr quark

@@ -13,6 +13,7 @@     , gtypeFloat     , gtypeDouble     , gtypeBoolean+    , gtypeError     , gtypeGType     , gtypeStrv     , gtypeBoxed@@ -24,13 +25,6 @@     , gtypeStablePtr     ) where -import Control.Monad ((>=>))--import Foreign.C.String (CString)-import Foreign.Ptr (FunPtr)-import Foreign.StablePtr (StablePtr, newStablePtr, deRefStablePtr)--import Data.GI.Base.BasicConversions (withTextCString) import Data.GI.Base.BasicTypes (GType(..), CGType)  #include <glib-object.h>@@ -112,6 +106,10 @@ gtypeVariant :: GType gtypeVariant = GType #const G_TYPE_VARIANT +-- | The `GType` corresponding to 'Data.GI.Base.GError.GError'.+gtypeError :: GType+gtypeError = GType #const G_TYPE_ERROR+ {- Run-time types -}  foreign import ccall "g_gtype_get_type" g_gtype_get_type :: CGType@@ -132,26 +130,8 @@ 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+foreign import ccall haskell_gi_StablePtr_get_type :: 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+gtypeStablePtr :: GType+gtypeStablePtr = GType haskell_gi_StablePtr_get_type

@@ -178,9 +178,7 @@     fromGValue = get_gtype  instance IsGValue (StablePtr a) where-    toGValue val = do-      gtype <- gtypeStablePtr-      buildGValue gtype set_stablePtr val+    toGValue = buildGValue gtypeStablePtr set_stablePtr     fromGValue = get_stablePtr  foreign import ccall "g_value_set_string" _set_string ::

@@ -133,9 +133,6 @@  #include <glib-object.h> -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>), (<*>))-#endif import Control.Monad (when, void, (>=>)) import Control.Exception.Base (bracket) @@ -144,7 +141,9 @@ import qualified Data.ByteString as B import Data.Word import Data.Int+#if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))+#endif import Data.Maybe (isJust, fromJust) import qualified Data.Map as M 

@@ -1,6 +1,7 @@ {-# LANGUAGE TypeOperators, KindSignatures, DataKinds, PolyKinds,              TypeFamilies, UndecidableInstances, EmptyDataDecls,-             MultiParamTypeClasses, FlexibleInstances, ConstraintKinds #-}+             MultiParamTypeClasses, FlexibleInstances, ConstraintKinds,+             AllowAmbiguousTypes, FlexibleContexts #-}  -- | Helpers for dealing with overladed properties, signals and -- methods.@@ -11,6 +12,8 @@     , HasParentTypes     , IsDescendantOf +    , asA+     -- * Looking up attributes in parent types     , AttributeList     , HasAttributeList@@ -24,14 +27,18 @@     , HasSignal      -- * Looking up methods in parent types-    , MethodInfo(..)-    , MethodProxy(..)     , MethodResolutionFailed+    , UnsupportedMethodError+    , MethodInfo(..)     ) where +import Data.Coerce (coerce)+ import GHC.Exts (Constraint) import GHC.TypeLits +import Data.GI.Base.BasicTypes (ManagedPtrNewtype, ManagedPtr(..))+ -- | 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.@@ -65,7 +72,7 @@ -- | 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+class HasParentTypes (o :: *)  -- | Default instance, which will give rise to an error for types -- without an associated `ParentTypes` instance.@@ -74,6 +81,15 @@                'Text "’ does not have any known parent types.")     => HasParentTypes a +-- | Safe coercions to a parent class. For instance:+--+-- > #show $ label `asA` Gtk.Widget+--+asA :: (ManagedPtrNewtype a, ManagedPtrNewtype b,+        HasParentTypes b, IsDescendantOf a b)+    => b -> (ManagedPtr a -> a) -> a+asA obj _constructor = coerce obj+ -- | 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@@ -145,15 +161,13 @@                      'Text "’ not found for type ‘" ':<>:                      'ShowType o ':<>: 'Text "’.") --- | Class for types containing the information about an overloaded--- method of type `o -> s`.-class MethodInfo i o s where-    overloadedMethod :: MethodProxy i -> o -> s---- | Proxy for passing a type to `overloadedMethod`. We do not use--- `Data.Proxy.Proxy` directly since it clashes with types defined in--- the autogenerated bindings.-data MethodProxy a = MethodProxy+-- | A constraint that always fails with a type error, for+-- documentation purposes.+type family UnsupportedMethodError (s :: Symbol) (o :: *) :: * where+  UnsupportedMethodError s o =+    TypeError ('Text "Unsupported method ‘" ':<>:+               'Text s ':<>: 'Text "’ for object ‘" ':<>:+               'ShowType o ':<>: 'Text "’.")  -- | Returned when the method is not found, hopefully making -- the resulting error messages somewhat clearer.@@ -162,3 +176,8 @@         TypeError ('Text "Unknown method ‘" ':<>:                    'Text m ':<>: 'Text "’ for type ‘" ':<>:                    'ShowType o ':<>: 'Text "’.")++-- | Class for types containing the information about an overloaded+-- method of type @o -> s@.+class MethodInfo i o s where+    overloadedMethod :: o -> s

@@ -0,0 +1,3 @@+module Data.GI.Base.Overloading (HasParentTypes) where++class HasParentTypes o

@@ -26,6 +26,7 @@     , setObjectPropertyPtrGList     , setObjectPropertyHash     , setObjectPropertyCallback+    , setObjectPropertyGError      , getObjectPropertyString     , getObjectPropertyStringArray@@ -52,6 +53,7 @@     , getObjectPropertyPtrGList     , getObjectPropertyHash     , getObjectPropertyCallback+    , getObjectPropertyGError      , constructObjectPropertyString     , constructObjectPropertyStringArray@@ -78,6 +80,7 @@     , constructObjectPropertyPtrGList     , constructObjectPropertyHash     , constructObjectPropertyCallback+    , constructObjectPropertyGError     ) where  #if !MIN_VERSION_base(4,8,0)@@ -92,6 +95,7 @@ import Data.GI.Base.BasicTypes import Data.GI.Base.BasicConversions import Data.GI.Base.ManagedPtr+import Data.GI.Base.GError (GError(..)) import Data.GI.Base.GValue import Data.GI.Base.GType import Data.GI.Base.GClosure (GClosure(..))@@ -556,3 +560,18 @@   if ptr /= nullPtr     then return . Just . wrapper $ castPtrToFunPtr ptr     else return Nothing++-- | Set a property of type `GError`.+setObjectPropertyGError :: forall a. GObject a =>+                          a -> String -> Maybe GError -> IO ()+setObjectPropertyGError = setObjectPropertyBoxed++-- | Construct a property of type `GError`.+constructObjectPropertyGError :: String -> Maybe GError -> IO (GValueConstruct o)+constructObjectPropertyGError = constructObjectPropertyBoxed++-- | Get the value of a property of type `GError`.+getObjectPropertyGError :: forall a. GObject a =>+                            a -> String -> IO (Maybe GError)+getObjectPropertyGError obj propName =+  getObjectPropertyBoxed obj propName GError

@@ -45,7 +45,7 @@     , (++)     , (=<<)     , (>=>)-    , Bool(..)+    , Bool()     , Float     , Double     , undefined

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -9,8 +10,36 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-} --- | Routines for connecting `GObject`s to signals.+-- | Routines for connecting `GObject`s to signals. There are two+-- basic variants, 'on' and 'after', which correspond to+-- <https://developer.gnome.org/gobject/stable/gobject-Signals.html#g-signal-connect g_signal_connect> and <https://developer.gnome.org/gobject/stable/gobject-Signals.html#g-signal-connect-after g_signal_connect_after>, respectively.+--+-- Basic usage is+--+-- @ 'on' widget #signalName $ do ... @+--+-- or+--+-- @ 'after' widget #signalName $ do ... @+--+-- Note that in the Haskell bindings we represent the signal name in+-- camelCase, so a signal like <https://webkitgtk.org/reference/webkit2gtk/stable/WebKitUserContentManager.html#WebKitUserContentManager-script-message-received script-message-received> in the original API becomes <https://hackage.haskell.org/package/gi-webkit2-4.0.24/docs/GI-WebKit2-Objects-UserContentManager.html#g:16 scriptMessageReceived> in the bindings.+--+-- There are two variants of note. If you want to provide a detail+-- when connecting the signal you can use ':::', as follows:+--+-- @ 'on' widget (#scriptMessageReceived ':::' "handlerName") $ do ... @+--+-- On the other hand, if you want to connect to the "<https://hackage.haskell.org/package/gi-gobject-2.0.21/docs/GI-GObject-Objects-Object.html#g:30 notify>" signal for a property of a widget, it is recommended to use instead 'PropertyNotify', as follows:+--+-- @ 'on' widget ('PropertyNotify' #propertyName) $ do ... @+--+-- which has the advantage that it will be checked at compile time+-- that the widget does indeed have the property "@propertyName@". module Data.GI.Base.Signals     ( on     , after@@ -21,63 +50,72 @@     , SignalHandlerId     , SignalInfo(..)     , GObjectNotifySignalInfo+    , SignalCodeGenError     ) where  import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Proxy (Proxy(..))+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid ((<>))+#endif  import Foreign import Foreign.C+#if !MIN_VERSION_base(4,13,0) import Foreign.Ptr (nullPtr)+#endif  import GHC.TypeLits -import Data.GI.Base.Attributes (AttrLabelProxy, AttrInfo(AttrLabel))+import qualified Data.Text as T+import Data.Text (Text)++import Data.GI.Base.Attributes (AttrLabelProxy(..), AttrInfo(AttrLabel))+import Data.GI.Base.BasicConversions (withTextCString) import Data.GI.Base.BasicTypes import Data.GI.Base.GParamSpec (newGParamSpecFromPtr) import Data.GI.Base.ManagedPtr (withManagedPtr) import Data.GI.Base.Overloading (ResolveSignal, ResolveAttribute) -#if MIN_VERSION_base(4,9,0) import GHC.OverloadedLabels (IsLabel(..))-#else-import Data.GI.Base.Overloading (HasSignal)-#endif  -- | Type of a `GObject` signal handler id. type SignalHandlerId = CULong  -- | Support for overloaded signal connectors. data SignalProxy (object :: *) (info :: *) where-    SignalProxy :: SignalProxy o info-    PropertyNotify :: (info ~ ResolveAttribute propName o,-                       AttrInfo info,-                       pl ~ AttrLabel info) =>-                      AttrLabelProxy propName ->-                      SignalProxy o (GObjectNotifySignalInfo pl)+  -- | A basic signal name connector.+  SignalProxy :: SignalProxy o info+  -- | A signal connector annotated with a detail.+  (:::) :: forall o info. SignalProxy o info -> Text -> SignalProxy o info+  -- | A signal connector for the @notify@ signal on the given property.+  PropertyNotify :: (info ~ ResolveAttribute propName o,+                     AttrInfo info,+                     pl ~ AttrLabel info, KnownSymbol pl) =>+                    AttrLabelProxy propName ->+                    SignalProxy o GObjectNotifySignalInfo  -- | Support for overloaded labels.-#if MIN_VERSION_base(4,10,0)-instance info ~ ResolveSignal slot object =>+instance (info ~ ResolveSignal slot object) =>     IsLabel slot (SignalProxy object info) where+#if MIN_VERSION_base(4,10,0)     fromLabel = SignalProxy #else-instance info ~ ResolveSignal slot object =>-    IsLabel slot (SignalProxy object info) where     fromLabel _ = SignalProxy #endif  -- | Information about an overloaded signal. class SignalInfo (info :: *) where-    type HaskellCallbackType info-    -- | Connect a Haskell function to a signal of the given `GObject`,-    -- specifying whether the handler will be called before or after-    -- the default handler.+    -- | The type for the signal handler.+    type HaskellCallbackType info :: *+    -- | Connect a Haskell function to a signal of the given+    -- `GObject`, specifying whether the handler will be called before+    -- or after the default handler.     connectSignal :: GObject o =>-                     SignalProxy o info ->                      o ->                      HaskellCallbackType info ->                      SignalConnectMode ->+                     Maybe Text ->                      IO SignalHandlerId  -- | Whether to connect a handler to a signal with `connectSignal` so@@ -85,25 +123,30 @@ data SignalConnectMode = SignalConnectBefore  -- ^ Run before the default handler.         | SignalConnectAfter -- ^ Run after the default handler. --- | Same as `connectSignal`, specifying from the beginning that the--- handler is to be run before the default handler.------ > on object signal handler = liftIO $ connectSignal signal object handler SignalConnectBefore+-- | Connect a signal to a signal handler. on :: forall object info m.       (GObject object, MonadIO m, SignalInfo info) =>       object -> SignalProxy object info              -> HaskellCallbackType info -> m SignalHandlerId-on o p c = liftIO $ connectSignal p o c SignalConnectBefore+on o p c =+  liftIO $ connectSignal @info o c SignalConnectBefore (proxyDetail p)  -- | Connect a signal to a handler, running the handler after the default one.------ > after object signal handler = liftIO $ connectSignal signal object handler SignalConnectAfter after :: forall object info m.       (GObject object, MonadIO m, SignalInfo info) =>       object -> SignalProxy object info              -> HaskellCallbackType info -> m SignalHandlerId-after o p c = liftIO $ connectSignal p o c SignalConnectAfter+after o p c =+  liftIO $ connectSignal @info o c SignalConnectAfter (proxyDetail p) +-- | Given a signal proxy, determine the corresponding detail.+proxyDetail :: forall object info. SignalProxy object info -> Maybe Text+proxyDetail p = case p of+  SignalProxy -> Nothing+  (_ ::: detail) -> Just detail+  PropertyNotify (AttrLabelProxy :: AttrLabelProxy propName) ->+    Just . T.pack $ symbolVal (Proxy @(AttrLabel (ResolveAttribute propName object)))+ -- Connecting GObjects to signals foreign import ccall g_signal_connect_data ::     Ptr a ->                            -- instance@@ -120,12 +163,16 @@  -- | Connect a signal to a handler, given as a `FunPtr`. connectSignalFunPtr :: GObject o =>-                  o -> String -> FunPtr a -> SignalConnectMode -> IO SignalHandlerId-connectSignalFunPtr object signal fn mode = do+                  o -> Text -> FunPtr a -> SignalConnectMode ->+                  Maybe Text -> IO SignalHandlerId+connectSignalFunPtr object signal fn mode maybeDetail = do   let flags = case mode of                 SignalConnectAfter -> 1                 SignalConnectBefore -> 0-  withCString signal $ \csignal ->+      signalSpec = case maybeDetail of+                     Nothing -> signal+                     Just detail -> signal <> "::" <> detail+  withTextCString signalSpec $ \csignal ->     withManagedPtr object $ \objPtr ->       g_signal_connect_data objPtr csignal fn nullPtr ptr_to_release_closure flags @@ -140,11 +187,10 @@ -- | Connection information for a "notify" signal indicating that a -- specific property changed (see `PropertyNotify` for the relevant -- constructor).-data GObjectNotifySignalInfo (propName :: Symbol)-instance KnownSymbol propName =>-    SignalInfo (GObjectNotifySignalInfo propName) where-  type HaskellCallbackType (GObjectNotifySignalInfo propName) = GObjectNotifyCallback-  connectSignal = connectGObjectNotify (symbolVal (Proxy :: Proxy propName))+data GObjectNotifySignalInfo+instance SignalInfo GObjectNotifySignalInfo where+  type HaskellCallbackType GObjectNotifySignalInfo = GObjectNotifyCallback+  connectSignal = connectGObjectNotify  -- | Type for a `GObject` "notify" callback. type GObjectNotifyCallback = GParamSpec -> IO ()@@ -153,7 +199,7 @@     GObjectNotifyCallback -> Ptr () -> Ptr GParamSpec -> Ptr () -> IO () gobjectNotifyCallbackWrapper _cb _ pspec _ = do     pspec' <- newGParamSpecFromPtr pspec-    _cb  pspec'+    _cb pspec'  type GObjectNotifyCallbackC = Ptr () -> Ptr GParamSpec -> Ptr () -> IO () @@ -161,12 +207,20 @@     mkGObjectNotifyCallback :: GObjectNotifyCallbackC -> IO (FunPtr GObjectNotifyCallbackC)  -- | Connect the given notify callback for a GObject.-connectGObjectNotify :: forall o i. GObject o =>-                        String ->-                        SignalProxy o (i :: *) ->+connectGObjectNotify :: GObject o =>                         o -> GObjectNotifyCallback ->-                        SignalConnectMode -> IO SignalHandlerId-connectGObjectNotify propName _ obj cb mode = do+                        SignalConnectMode ->+                        Maybe Text ->+                        IO SignalHandlerId+connectGObjectNotify obj cb mode detail = do   cb' <- mkGObjectNotifyCallback (gobjectNotifyCallbackWrapper cb)-  let signalName = "notify::" ++ propName-  connectSignalFunPtr obj signalName cb' mode+  connectSignalFunPtr obj "notify" cb' mode detail++-- | Generate an informative type error whenever one tries to use a+-- signal for which code generation has failed.+type family SignalCodeGenError (signalName :: Symbol) :: * where+  SignalCodeGenError signalName = TypeError+    ('Text "The signal ‘"+     ':<>: 'Text signalName+     ':<>: 'Text "’ is not supported, because haskell-gi failed to generate appropriate bindings."+    ':$$: 'Text "Please file an issue at https://github.com/haskell-gi/haskell-gi/issues.")

@@ -29,18 +29,19 @@  #include <glib-object.h> -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative (Applicative, pure, (<$>), (<*>))-#endif import Control.Exception (throwIO) import Control.Monad (void)  import qualified Data.Text as T import qualified Data.Text.Foreign as TF+#if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))+#endif import Data.Word +#if !MIN_VERSION_base(4,13,0) import Foreign (peek)+#endif import Foreign.C.Types (CSize(..), CChar) import Foreign.Ptr (Ptr, nullPtr, FunPtr, nullFunPtr, freeHaskellFunPtr) import Foreign.Storable (Storable(..))@@ -188,7 +189,8 @@         throwIO (UnexpectedNullPointerReturn {                    nullPtrErrorMsg = "Received unexpected nullPtr in \""                                      <> fnName <> "\".\n" <>-                                     "This is a bug in the introspection data, please report it at\nhttps://github.com/haskell-gi/haskell-gi/issues\n" <>+                                     "This might be a bug in the introspection data, or perhaps a use-after-free bug.\n" <>+                                     "If in doubt, please report it at\n\thttps://github.com/haskell-gi/haskell-gi/issues\n" <>                                      T.pack (prettyCallStack callStack)                  })     | otherwise = return ()@@ -201,9 +203,10 @@   case result of     Just r -> return r     Nothing -> throwIO (UnexpectedNullPointerReturn {-                 nullPtrErrorMsg = "Received unexpected nullPtr in \""+                 nullPtrErrorMsg = "Received unexpected Nothing in \""                                      <> fnName <> "\".\n" <>-                                     "This is a bug in the introspection data, please report it at\nhttps://github.com/haskell-gi/haskell-gi/issues\n" <>+                                     "This might be a bug in the introspection data, or perhaps a use-after-free bug.\n" <>+                                     "If in doubt, please report it at\n\thttps://github.com/haskell-gi/haskell-gi/issues\n" <>                                      T.pack (prettyCallStack callStack)                  }) 

@@ -70,7 +70,7 @@  /* Print the given printf-style message to the log. The message is    only printed if the HASKELL_GI_DEBUG_MEM variable is set. */-__attribute__ ((format (gnu_printf, 1, 2)))+__attribute__ ((format (printf, 1, 2))) static void dbg_log (const char *msg, ...) {   va_list args;@@ -319,37 +319,26 @@   return result; } -static pthread_mutex_t stablePtr_mutex = PTHREAD_MUTEX_INITIALIZER;--static GType stablePtr_gtype = 0;--GType haskell_gi_Boxed_StablePtr_GType (void)+static HsStablePtr duplicateStablePtr(HsStablePtr stable_ptr) {-  return stablePtr_gtype;+  return getStablePtr(deRefStablePtr(stable_ptr)); } -/* Register the Haskell StablePtr type as a boxed type. */-GType haskell_gi_register_Boxed_HsStablePtr-        (const char *typeName, HsStablePtr (*duplicator)(HsStablePtr))+GType haskell_gi_StablePtr_get_type (void) {-  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);+  static volatile gsize g_define_type_id__volatile = 0; -  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;-  }+  if (g_once_init_enter (&g_define_type_id__volatile))+    {+      GType g_define_type_id =+        g_boxed_type_register_static (g_intern_static_string ("HaskellGIStablePtr"),+                                      duplicateStablePtr,+                                      hs_free_stable_ptr); -  pthread_mutex_unlock(&stablePtr_mutex);+      g_once_init_leave (&g_define_type_id__volatile, g_define_type_id);+    } -  return result;+  return g_define_type_id__volatile; }  /* Release the FunPtr allocated for a Haskell signal handler */

@@ -1,5 +1,5 @@ name:                haskell-gi-base-version:             0.22.2+version:             0.23.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@@ -13,7 +13,7 @@ stability:           Experimental category:            Development build-type:          Simple-cabal-version:       >=1.8+cabal-version:       2.0  extra-source-files: ChangeLog.md @@ -44,7 +44,7 @@                        Data.GI.Base.Signals,                        Data.GI.Base.Utils -  pkgconfig-depends:   gobject-2.0 >= 2.32, glib-2.0+  pkgconfig-depends:   gobject-2.0 >= 2.42, glib-2.0   build-depends:       base >= 4.9 && < 5,                        bytestring,                        containers,@@ -54,6 +54,7 @@    build-tools:         hsc2hs   cc-options:          -fPIC-  extensions:          CPP, ForeignFunctionInterface, DoAndIfThenElse, MonoLocalBinds+  default-language:    Haskell2010+  default-extensions:  CPP, ForeignFunctionInterface, DoAndIfThenElse, MonoLocalBinds   other-extensions:    TypeApplications, ScopedTypeVariables   c-sources:           c/hsgclosure.c