haskell-gi-base 0.25.0 → 0.26.0
raw patch · 13 files changed
+580/−510 lines, 13 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Data.GI.Base.GObject: type family GObjectPrivateData a;
- Data.GI.Base.Overloading: MethodInfo :: Text -> Text -> MethodInfo
- Data.GI.Base.Overloading: [overloadedMethodName] :: MethodInfo -> Text
- Data.GI.Base.Overloading: [overloadedMethodURL] :: MethodInfo -> Text
- Data.GI.Base.Overloading: data MethodInfo
- Data.GI.Base.Overloading: instance GHC.Show.Show Data.GI.Base.Overloading.MethodInfo
+ Data.GI.Base: [After] :: (GObject obj, SignalInfo info) => SignalProxy obj info -> ((?self :: obj) => HaskellCallbackType info) -> AttrOp obj tag
+ Data.GI.Base.Attributes: [After] :: (GObject obj, SignalInfo info) => SignalProxy obj info -> ((?self :: obj) => HaskellCallbackType info) -> AttrOp obj tag
+ Data.GI.Base.Attributes: dbgAttrInfo :: AttrInfo info => Maybe ResolvedSymbolInfo
+ Data.GI.Base.Attributes: resolveAttr :: forall info attr obj. (HasAttributeList obj, info ~ ResolveAttribute attr obj, AttrInfo info) => obj -> AttrLabelProxy (attr :: Symbol) -> Maybe ResolvedSymbolInfo
+ Data.GI.Base.Attributes: type AttrAllowedOps info :: [AttrOpTag];
+ Data.GI.Base.Attributes: type AttrBaseTypeConstraint info :: Type -> Constraint;
+ Data.GI.Base.Attributes: type AttrGetType info;
+ Data.GI.Base.Attributes: type AttrLabel info :: Symbol;
+ Data.GI.Base.Attributes: type AttrOrigin info;
+ Data.GI.Base.GObject: type GObjectParentType a;
+ Data.GI.Base.GObject: type GObjectPrivateData a;
+ Data.GI.Base.Overloading: ResolvedSymbolInfo :: Text -> Text -> ResolvedSymbolInfo
+ Data.GI.Base.Overloading: [resolvedSymbolName] :: ResolvedSymbolInfo -> Text
+ Data.GI.Base.Overloading: [resolvedSymbolURL] :: ResolvedSymbolInfo -> Text
+ Data.GI.Base.Overloading: data ResolvedSymbolInfo
+ Data.GI.Base.Overloading: instance GHC.Show.Show Data.GI.Base.Overloading.ResolvedSymbolInfo
+ Data.GI.Base.ShortPrelude: [After] :: (GObject obj, SignalInfo info) => SignalProxy obj info -> ((?self :: obj) => HaskellCallbackType info) -> AttrOp obj tag
+ Data.GI.Base.ShortPrelude: dbgAttrInfo :: AttrInfo info => Maybe ResolvedSymbolInfo
+ Data.GI.Base.ShortPrelude: dbgSignalInfo :: SignalInfo info => Maybe ResolvedSymbolInfo
+ Data.GI.Base.ShortPrelude: resolveAttr :: forall info attr obj. (HasAttributeList obj, info ~ ResolveAttribute attr obj, AttrInfo info) => obj -> AttrLabelProxy (attr :: Symbol) -> Maybe ResolvedSymbolInfo
+ Data.GI.Base.ShortPrelude: type AttrAllowedOps info :: [AttrOpTag];
+ Data.GI.Base.ShortPrelude: type AttrBaseTypeConstraint info :: Type -> Constraint;
+ Data.GI.Base.ShortPrelude: type AttrGetType info;
+ Data.GI.Base.ShortPrelude: type AttrLabel info :: Symbol;
+ Data.GI.Base.ShortPrelude: type AttrOrigin info;
+ Data.GI.Base.ShortPrelude: type HaskellCallbackType info :: Type;
+ Data.GI.Base.Signals: dbgSignalInfo :: SignalInfo info => Maybe ResolvedSymbolInfo
+ Data.GI.Base.Signals: resolveSignal :: forall object info. (GObject object, SignalInfo info) => object -> SignalProxy object info -> Maybe ResolvedSymbolInfo
+ Data.GI.Base.Signals: type HaskellCallbackType info :: Type;
- Data.GI.Base: [On] :: (GObject obj, SignalInfo info) => SignalProxy obj info -> HaskellCallbackType info -> AttrOp obj tag
+ Data.GI.Base: [On] :: (GObject obj, SignalInfo info) => SignalProxy obj info -> ((?self :: obj) => HaskellCallbackType info) -> AttrOp obj tag
- Data.GI.Base: after :: forall object info m. (GObject object, MonadIO m, SignalInfo info) => object -> SignalProxy object info -> HaskellCallbackType info -> m SignalHandlerId
+ Data.GI.Base: after :: forall object info m. (GObject object, MonadIO m, SignalInfo info) => object -> SignalProxy object info -> ((?self :: object) => HaskellCallbackType info) -> m SignalHandlerId
- Data.GI.Base: fromGValue :: IsGValue a => GValue -> IO a
+ Data.GI.Base: fromGValue :: (IsGValue a, MonadIO m) => GValue -> m a
- Data.GI.Base: on :: forall object info m. (GObject object, MonadIO m, SignalInfo info) => object -> SignalProxy object info -> HaskellCallbackType info -> m SignalHandlerId
+ Data.GI.Base: on :: forall object info m. (GObject object, MonadIO m, SignalInfo info) => object -> SignalProxy object info -> ((?self :: object) => HaskellCallbackType info) -> m SignalHandlerId
- Data.GI.Base: toGValue :: forall a. IsGValue a => a -> IO GValue
+ Data.GI.Base: toGValue :: forall a m. (IsGValue a, MonadIO m) => a -> m GValue
- Data.GI.Base.Attributes: [On] :: (GObject obj, SignalInfo info) => SignalProxy obj info -> HaskellCallbackType info -> AttrOp obj tag
+ Data.GI.Base.Attributes: [On] :: (GObject obj, SignalInfo info) => SignalProxy obj info -> ((?self :: obj) => HaskellCallbackType info) -> AttrOp obj tag
- Data.GI.Base.GValue: fromGValue :: IsGValue a => GValue -> IO a
+ Data.GI.Base.GValue: fromGValue :: (IsGValue a, MonadIO m) => GValue -> m a
- Data.GI.Base.GValue: toGValue :: forall a. IsGValue a => a -> IO GValue
+ Data.GI.Base.GValue: toGValue :: forall a m. (IsGValue a, MonadIO m) => a -> m GValue
- Data.GI.Base.ManagedPtr: withTransient :: (HasCallStack, ManagedPtrNewtype a) => (ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
+ Data.GI.Base.ManagedPtr: withTransient :: (HasCallStack, ManagedPtrNewtype a) => Ptr a -> (a -> IO b) -> IO b
- Data.GI.Base.Overloading: overloadedMethodInfo :: OverloadedMethodInfo i o => MethodInfo
+ Data.GI.Base.Overloading: overloadedMethodInfo :: OverloadedMethodInfo i o => Maybe ResolvedSymbolInfo
- Data.GI.Base.Overloading: resolveMethod :: forall info obj. OverloadedMethodInfo info obj => MethodProxy info obj -> obj -> MethodInfo
+ Data.GI.Base.Overloading: resolveMethod :: forall info obj. OverloadedMethodInfo info obj => obj -> MethodProxy info obj -> Maybe ResolvedSymbolInfo
- Data.GI.Base.ShortPrelude: [On] :: (GObject obj, SignalInfo info) => SignalProxy obj info -> HaskellCallbackType info -> AttrOp obj tag
+ Data.GI.Base.ShortPrelude: [On] :: (GObject obj, SignalInfo info) => SignalProxy obj info -> ((?self :: obj) => HaskellCallbackType info) -> AttrOp obj tag
- Data.GI.Base.ShortPrelude: connectSignal :: (SignalInfo info, GObject o) => o -> HaskellCallbackType info -> SignalConnectMode -> Maybe Text -> IO SignalHandlerId
+ Data.GI.Base.ShortPrelude: connectSignal :: (SignalInfo info, GObject o) => o -> (o -> HaskellCallbackType info) -> SignalConnectMode -> Maybe Text -> IO SignalHandlerId
- Data.GI.Base.ShortPrelude: type family HaskellCallbackType info :: Type;
+ Data.GI.Base.ShortPrelude: type family AttrOpAllowed (tag :: AttrOpTag) (info :: Type) (useType :: Type) :: Constraint
- Data.GI.Base.Signals: after :: forall object info m. (GObject object, MonadIO m, SignalInfo info) => object -> SignalProxy object info -> HaskellCallbackType info -> m SignalHandlerId
+ Data.GI.Base.Signals: after :: forall object info m. (GObject object, MonadIO m, SignalInfo info) => object -> SignalProxy object info -> ((?self :: object) => HaskellCallbackType info) -> m SignalHandlerId
- Data.GI.Base.Signals: connectSignal :: (SignalInfo info, GObject o) => o -> HaskellCallbackType info -> SignalConnectMode -> Maybe Text -> IO SignalHandlerId
+ Data.GI.Base.Signals: connectSignal :: (SignalInfo info, GObject o) => o -> (o -> HaskellCallbackType info) -> SignalConnectMode -> Maybe Text -> IO SignalHandlerId
- Data.GI.Base.Signals: on :: forall object info m. (GObject object, MonadIO m, SignalInfo info) => object -> SignalProxy object info -> HaskellCallbackType info -> m SignalHandlerId
+ Data.GI.Base.Signals: on :: forall object info m. (GObject object, MonadIO m, SignalInfo info) => object -> SignalProxy object info -> ((?self :: object) => HaskellCallbackType info) -> m SignalHandlerId
Files
- Data/GI/Base/Attributes.hs +34/−5
- Data/GI/Base/BasicConversions.hsc +1/−1
- Data/GI/Base/GObject.hsc +3/−1
- Data/GI/Base/GParamSpec.hsc +2/−2
- Data/GI/Base/GValue.hs +6/−4
- Data/GI/Base/GVariant.hsc +43/−43
- Data/GI/Base/ManagedPtr.hs +3/−3
- Data/GI/Base/Overloading.hs +14/−12
- Data/GI/Base/Signals.hs +47/−22
- Data/GI/Base/Signals.hs-boot +13/−3
- c/hsgclosure.c +0/−410
- csrc/hsgclosure.c +410/−0
- haskell-gi-base.cabal +4/−4
Data/GI/Base/Attributes.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE GADTs, ScopedTypeVariables, DataKinds, KindSignatures, TypeFamilies, TypeOperators, MultiParamTypeClasses, ConstraintKinds, UndecidableInstances, FlexibleInstances, TypeApplications,- DefaultSignatures, PolyKinds, AllowAmbiguousTypes #-}+ DefaultSignatures, PolyKinds, AllowAmbiguousTypes,+ ImplicitParams, RankNTypes #-} -- | --@@ -143,7 +144,9 @@ set, clear, - AttrLabelProxy(..)+ AttrLabelProxy(..),++ resolveAttr ) where import Control.Monad (void)@@ -151,9 +154,11 @@ import Data.GI.Base.BasicTypes (GObject) import Data.GI.Base.GValue (GValueConstruct)-import Data.GI.Base.Overloading (HasAttributeList, ResolveAttribute)+import Data.GI.Base.Overloading (HasAttributeList, ResolveAttribute,+ ResolvedSymbolInfo) -import {-# SOURCE #-} Data.GI.Base.Signals (SignalInfo(..), SignalProxy, on)+import {-# SOURCE #-} Data.GI.Base.Signals (SignalInfo(..), SignalProxy,+ on, after) import Data.Proxy (Proxy(..)) import Data.Kind (Type)@@ -269,6 +274,12 @@ Proxy o -> b -> IO (AttrTransferType info) attrTransfer _ = return + -- | Return some information about the overloaded attribute,+ -- useful for debugging. See `resolveAttr` for how to access this+ -- conveniently.+ dbgAttrInfo :: Maybe ResolvedSymbolInfo+ dbgAttrInfo = Nothing+ -- | Pretty print a type, indicating the parent type that introduced -- the attribute, if different. type family TypeOriginInfo definingType useType :: ErrorMessage where@@ -441,7 +452,14 @@ AttrLabelProxy (attr :: Symbol) -> b -> AttrOp obj tag -- | Connect the given signal to a signal handler. On :: (GObject obj, SignalInfo info) =>- SignalProxy obj info -> HaskellCallbackType info -> AttrOp obj tag+ SignalProxy obj info+ -> ((?self :: obj) => HaskellCallbackType info)+ -> AttrOp obj tag+ -- | Like 'On', but connect after the default signal.+ After :: (GObject obj, SignalInfo info) =>+ SignalProxy obj info+ -> ((?self :: obj) => HaskellCallbackType info)+ -> AttrOp obj tag -- | Set a number of properties for some object. set :: forall o m. MonadIO m => o -> [AttrOp o 'AttrSet] -> m ()@@ -467,6 +485,7 @@ attrSet @(ResolveAttribute label o) obj app (On signal callback) = void $ on obj signal callback+ app (After signal callback) = void $ after obj signal callback -- | Constraints on a @obj@\/@attr@ pair so `get` is possible, -- producing a value of type @result@.@@ -495,3 +514,13 @@ (AttrClearC info obj attr, MonadIO m) => obj -> AttrLabelProxy (attr :: Symbol) -> m () clear o _ = liftIO $ attrClear @info o++-- | Return the fully qualified attribute name that a given overloaded+-- attribute resolves to (mostly useful for debugging).+--+-- > resolveAttr #sensitive button+resolveAttr :: forall info attr obj.+ (HasAttributeList obj, info ~ ResolveAttribute attr obj,+ AttrInfo info) =>+ obj -> AttrLabelProxy (attr :: Symbol) -> Maybe ResolvedSymbolInfo+resolveAttr _o _p = dbgAttrInfo @info
Data/GI/Base/BasicConversions.hsc view
@@ -169,7 +169,7 @@ dataPtr <- peek (castPtr array :: Ptr (Ptr a)) nitems <- peek (array `plusPtr` sizeOf dataPtr) go dataPtr nitems- where go :: Ptr a -> Int -> IO [a]+ where go :: Ptr a -> CUInt -> IO [a] go _ 0 = return [] go ptr n = do x <- peek ptr
Data/GI/Base/GObject.hsc view
@@ -77,7 +77,7 @@ import Data.GI.Base.ManagedPtr (withManagedPtr, touchManagedPtr, wrapObject, newObject) import Data.GI.Base.Overloading (ResolveAttribute)-import Data.GI.Base.Signals (on)+import Data.GI.Base.Signals (on, after) import Data.GI.Base.Utils (dbgLog) #include <glib-object.h>@@ -111,9 +111,11 @@ attrConstruct @(ResolveAttribute label o)) construct (On _ _) = return Nothing+ construct (After _ _) = return Nothing setSignal :: GObject o => o -> AttrOp o 'AttrConstruct -> IO () setSignal obj (On signal callback) = void $ on obj signal callback+ setSignal obj (After signal callback) = void $ after obj signal callback setSignal _ _ = return () -- | Construct the given `GObject`, given a set of actions
Data/GI/Base/GParamSpec.hsc view
@@ -154,7 +154,7 @@ value <- objectFromPtr objPtr >>= getter gvalueSetter destPtr value , propSetter = \objPtr newGValuePtr ->- withTransient GValue newGValuePtr $ \newGValue -> do+ withTransient newGValuePtr $ \newGValue -> do obj <- objectFromPtr objPtr value <- GV.fromGValue newGValue setter obj value@@ -215,7 +215,7 @@ take_stablePtr destPtr stablePtr setter' :: Ptr o -> (Ptr GValue) -> IO ()- setter' objPtr gvPtr = withTransient GValue gvPtr $ \gv -> do+ setter' objPtr gvPtr = withTransient gvPtr $ \gv -> do obj <- objectFromPtr objPtr val <- GV.fromGValue gv >>= deRefStablePtr setter obj val
Data/GI/Base/GValue.hs view
@@ -45,6 +45,8 @@ ) where +import Control.Monad.IO.Class (MonadIO, liftIO)+ import Data.Coerce (coerce) import Data.Word import Data.Int@@ -152,8 +154,8 @@ -- the `GValue`. -- | Create a `GValue` from the given Haskell value.-toGValue :: forall a. IsGValue a => a -> IO GValue-toGValue val = do+toGValue :: forall a m. (IsGValue a, MonadIO m) => a -> m GValue+toGValue val = liftIO $ do gvptr <- callocBytes cgvalueSize GType gtype <- gvalueGType_ @a _ <- g_value_init gvptr gtype@@ -162,8 +164,8 @@ return $! gv -- | Create a Haskell object out of the given `GValue`.-fromGValue :: IsGValue a => GValue -> IO a-fromGValue gv = withManagedPtr gv gvalueGet_+fromGValue :: (IsGValue a, MonadIO m) => GValue -> m a+fromGValue gv = liftIO $ withManagedPtr gv gvalueGet_ instance IsGValue (Maybe String) where gvalueGType_ = return gtypeString
Data/GI/Base/GVariant.hsc view
@@ -854,14 +854,14 @@ gvariantToTwoTuple variant = do let expectedType = toGVariantFormatString (undefined :: (a,b)) maybeChildren <- withExplicitType expectedType gvariant_get_children variant- if isJust maybeChildren- then do- let (Just [a1,a2]) = maybeChildren- (ma1, ma2) <- (,) <$> fromGVariant a1 <*> fromGVariant a2- return $ if isJust ma1 && isJust ma2- then Just (fromJust ma1, fromJust ma2)- else Nothing- else return Nothing+ case maybeChildren of+ Just [a1,a2] -> do+ (ma1, ma2) <- (,) <$> fromGVariant a1 <*> fromGVariant a2+ return $ if isJust ma1 && isJust ma2+ then Just (fromJust ma1, fromJust ma2)+ else Nothing+ Just _ -> error "gvariantToTwoTuple :: the impossible happened, this is a bug."+ Nothing -> return Nothing instance (IsGVariant a, IsGVariant b, IsGVariant c) => IsGVariant (a,b,c) where toGVariant = gvariantFromThreeTuple@@ -886,16 +886,16 @@ gvariantToThreeTuple variant = do let expectedType = toGVariantFormatString (undefined :: (a,b,c)) maybeChildren <- withExplicitType expectedType gvariant_get_children variant- if isJust maybeChildren- then do- let (Just [a1,a2,a3]) = maybeChildren- (ma1, ma2, ma3) <- (,,) <$> fromGVariant a1- <*> fromGVariant a2- <*> fromGVariant a3- return $ if isJust ma1 && isJust ma2 && isJust ma3- then Just (fromJust ma1, fromJust ma2, fromJust ma3)- else Nothing- else return Nothing+ case maybeChildren of+ Just [a1,a2,a3] -> do+ (ma1, ma2, ma3) <- (,,) <$> fromGVariant a1+ <*> fromGVariant a2+ <*> fromGVariant a3+ return $ if isJust ma1 && isJust ma2 && isJust ma3+ then Just (fromJust ma1, fromJust ma2, fromJust ma3)+ else Nothing+ Just _ -> error "gvariantToThreeTuple :: the impossible happened, this is a bug."+ Nothing -> return Nothing instance (IsGVariant a, IsGVariant b, IsGVariant c, IsGVariant d) => IsGVariant (a,b,c,d) where@@ -923,17 +923,17 @@ gvariantToFourTuple variant = do let expectedType = toGVariantFormatString (undefined :: (a,b,c,d)) maybeChildren <- withExplicitType expectedType gvariant_get_children variant- if isJust maybeChildren- then do- let (Just [a1,a2,a3,a4]) = maybeChildren- (ma1, ma2, ma3,ma4) <- (,,,) <$> fromGVariant a1- <*> fromGVariant a2- <*> fromGVariant a3- <*> fromGVariant a4- return $ if isJust ma1 && isJust ma2 && isJust ma3 && isJust ma4- then Just (fromJust ma1, fromJust ma2, fromJust ma3, fromJust ma4)- else Nothing- else return Nothing+ case maybeChildren of+ Just [a1,a2,a3,a4] -> do+ (ma1, ma2, ma3,ma4) <- (,,,) <$> fromGVariant a1+ <*> fromGVariant a2+ <*> fromGVariant a3+ <*> fromGVariant a4+ return $ if isJust ma1 && isJust ma2 && isJust ma3 && isJust ma4+ then Just (fromJust ma1, fromJust ma2, fromJust ma3, fromJust ma4)+ else Nothing+ Just _ -> error "gvariantToFourTuple :: the impossible happened, this is a bug."+ Nothing -> return Nothing instance (IsGVariant a, IsGVariant b, IsGVariant c, IsGVariant d, IsGVariant e) => IsGVariant (a,b,c,d,e) where@@ -965,17 +965,17 @@ gvariantToFiveTuple variant = do let expectedType = toGVariantFormatString (undefined :: (a,b,c,d,e)) maybeChildren <- withExplicitType expectedType gvariant_get_children variant- if isJust maybeChildren- then do- let (Just [a1,a2,a3,a4,a5]) = maybeChildren- (ma1, ma2, ma3, ma4, ma5) <- (,,,,) <$> fromGVariant a1- <*> fromGVariant a2- <*> fromGVariant a3- <*> fromGVariant a4- <*> fromGVariant a5- return $ if isJust ma1 && isJust ma2 && isJust ma3 &&- isJust ma4 && isJust ma5- then Just (fromJust ma1, fromJust ma2, fromJust ma3,- fromJust ma4, fromJust ma5)- else Nothing- else return Nothing+ case maybeChildren of+ Just [a1,a2,a3,a4,a5] -> do+ (ma1, ma2, ma3, ma4, ma5) <- (,,,,) <$> fromGVariant a1+ <*> fromGVariant a2+ <*> fromGVariant a3+ <*> fromGVariant a4+ <*> fromGVariant a5+ return $ if isJust ma1 && isJust ma2 && isJust ma3 &&+ isJust ma4 && isJust ma5+ then Just (fromJust ma1, fromJust ma2, fromJust ma3,+ fromJust ma4, fromJust ma5)+ else Nothing+ Just _ -> error "gvariantToFiveTuple :: the impossible happened, this is a bug."+ Nothing -> return Nothing
Data/GI/Base/ManagedPtr.hs view
@@ -168,9 +168,9 @@ -- managed pointer will be valid while calling the action, but will be -- disowned as soon as the action finished. withTransient :: (HasCallStack, ManagedPtrNewtype a)- => (ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b-withTransient constructor ptr action = do- managed <- constructor <$> newManagedPtr_ ptr+ => Ptr a -> (a -> IO b) -> IO b+withTransient ptr action = do+ managed <- coerce <$> newManagedPtr_ ptr r <- action managed _ <- disownManagedPtr managed return r
Data/GI/Base/Overloading.hs view
@@ -33,7 +33,8 @@ , OverloadedMethodInfo(..) , OverloadedMethod(..) , MethodProxy(..)- , MethodInfo(..)++ , ResolvedSymbolInfo(..) , resolveMethod ) where @@ -191,22 +192,23 @@ class OverloadedMethod i o s where overloadedMethod :: o -> s -- ^ The actual method being invoked. --- | Information about the method that will be invoked, for debugging+-- | Information about a fully resolved symbol, for debugging -- purposes.-data MethodInfo = MethodInfo { overloadedMethodName :: Text- , overloadedMethodURL :: Text- }+data ResolvedSymbolInfo = ResolvedSymbolInfo {+ resolvedSymbolName :: Text+ , resolvedSymbolURL :: Text+ } -instance Show MethodInfo where+instance Show ResolvedSymbolInfo where -- Format as a hyperlink on modern terminals (older -- terminals should ignore the hyperlink part).- show info = T.unpack ("\ESC]8;;" <> overloadedMethodURL info- <> "\ESC\\" <> overloadedMethodName info+ show info = T.unpack ("\ESC]8;;" <> resolvedSymbolURL info+ <> "\ESC\\" <> resolvedSymbolName info <> "\ESC]8;;\ESC\\") -- | This is for debugging purposes, see `resolveMethod` below. class OverloadedMethodInfo i o where- overloadedMethodInfo :: MethodInfo+ overloadedMethodInfo :: Maybe ResolvedSymbolInfo -- | A proxy for carrying the types `MethodInfoName` needs (this is used -- for `resolveMethod`, see below).@@ -215,7 +217,7 @@ -- | Return the fully qualified method name that a given overloaded -- method call resolves to (mostly useful for debugging). ----- > resolveMethod #show widget+-- > resolveMethod widget #show resolveMethod :: forall info obj. (OverloadedMethodInfo info obj) =>- MethodProxy info obj -> obj -> MethodInfo-resolveMethod _p _o = overloadedMethodInfo @info @obj+ obj -> MethodProxy info obj -> Maybe ResolvedSymbolInfo+resolveMethod _o _p = overloadedMethodInfo @info @obj
Data/GI/Base/Signals.hs view
@@ -13,6 +13,8 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE RankNTypes #-} -- | Routines for connecting `GObject`s to signals. There are two -- basic variants, 'on' and 'after', which correspond to@@ -51,6 +53,7 @@ , SignalInfo(..) , GObjectNotifySignalInfo , SignalCodeGenError+ , resolveSignal ) where import Control.Monad.IO.Class (MonadIO, liftIO)@@ -75,8 +78,9 @@ 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)+import Data.GI.Base.ManagedPtr (withManagedPtr, withTransient)+import Data.GI.Base.Overloading (ResolveSignal, ResolveAttribute,+ ResolvedSymbolInfo) import GHC.OverloadedLabels (IsLabel(..)) @@ -107,18 +111,25 @@ -- | Information about an overloaded signal. class SignalInfo (info :: Type) where- -- | The type for the signal handler.- type HaskellCallbackType info :: Type- -- | 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 =>- o ->- HaskellCallbackType info ->- SignalConnectMode ->- Maybe Text ->- IO SignalHandlerId+ -- | The type for the signal handler.+ type HaskellCallbackType info :: Type+ -- | Connect a Haskell function to a signal of the given `GObject`,+ -- specifying whether the handler will be called before or after the+ -- default handler. Note that the callback being passed here admits+ -- an extra initial parameter with respect to the usual Haskell+ -- callback type. This will be passed as an /implicit/ @?self@+ -- argument to the Haskell callback.+ connectSignal :: GObject o =>+ o ->+ (o -> HaskellCallbackType info) ->+ SignalConnectMode ->+ Maybe Text ->+ IO SignalHandlerId + -- | Optional extra debug information, for `resolveSignal` below.+ dbgSignalInfo :: Maybe ResolvedSymbolInfo+ dbgSignalInfo = Nothing+ -- | Whether to connect a handler to a signal with `connectSignal` so -- that it runs before/after the default handler for the given signal. data SignalConnectMode = SignalConnectBefore -- ^ Run before the default handler.@@ -128,17 +139,23 @@ on :: forall object info m. (GObject object, MonadIO m, SignalInfo info) => object -> SignalProxy object info- -> HaskellCallbackType info -> m SignalHandlerId+ -> ((?self :: object) => HaskellCallbackType info)+ -> m SignalHandlerId on o p c =- liftIO $ connectSignal @info o c SignalConnectBefore (proxyDetail p)+ liftIO $ connectSignal @info o w SignalConnectBefore (proxyDetail p)+ where w :: object -> HaskellCallbackType info+ w parent = let ?self = parent in c -- | Connect a signal to a handler, running the handler after the default one. after :: forall object info m. (GObject object, MonadIO m, SignalInfo info) => object -> SignalProxy object info- -> HaskellCallbackType info -> m SignalHandlerId+ -> ((?self :: object) => HaskellCallbackType info)+ -> m SignalHandlerId after o p c =- liftIO $ connectSignal @info o c SignalConnectAfter (proxyDetail p)+ liftIO $ connectSignal @info o w SignalConnectAfter (proxyDetail p)+ where w :: object -> HaskellCallbackType info+ w parent = let ?self = parent in c -- | Given a signal proxy, determine the corresponding detail. proxyDetail :: forall object info. SignalProxy object info -> Maybe Text@@ -196,11 +213,11 @@ -- | Type for a `GObject` "notify" callback. type GObjectNotifyCallback = GParamSpec -> IO () -gobjectNotifyCallbackWrapper ::- GObjectNotifyCallback -> Ptr () -> Ptr GParamSpec -> Ptr () -> IO ()-gobjectNotifyCallbackWrapper _cb _ pspec _ = do+gobjectNotifyCallbackWrapper :: GObject o =>+ (o -> GObjectNotifyCallback) -> Ptr () -> Ptr GParamSpec -> Ptr () -> IO ()+gobjectNotifyCallbackWrapper cb selfPtr pspec _ = do pspec' <- newGParamSpecFromPtr pspec- _cb pspec'+ withTransient (castPtr selfPtr) $ \self -> cb self pspec' type GObjectNotifyCallbackC = Ptr () -> Ptr GParamSpec -> Ptr () -> IO () @@ -209,7 +226,7 @@ -- | Connect the given notify callback for a GObject. connectGObjectNotify :: GObject o =>- o -> GObjectNotifyCallback ->+ o -> (o -> GObjectNotifyCallback) -> SignalConnectMode -> Maybe Text -> IO SignalHandlerId@@ -225,3 +242,11 @@ ':<>: '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.")++-- | Return the fully qualified signal name that a given overloaded+-- signal resolves to (mostly useful for debugging).+--+-- > resolveSignal #childNotify button+resolveSignal :: forall object info. (GObject object, SignalInfo info) =>+ object -> SignalProxy object info -> Maybe ResolvedSymbolInfo+resolveSignal _o _p = dbgSignalInfo @info
Data/GI/Base/Signals.hs-boot view
@@ -3,9 +3,12 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE RankNTypes #-} -module Data.GI.Base.Signals (SignalInfo(..), SignalProxy, on) where+module Data.GI.Base.Signals (SignalInfo(..), SignalProxy, on, after) where +import Data.GI.Base.Overloading (ResolvedSymbolInfo) import Data.GI.Base.BasicTypes (GObject) import Control.Monad.IO.Class (MonadIO) import Foreign.C (CULong)@@ -18,10 +21,12 @@ type HaskellCallbackType info connectSignal :: GObject o => o ->- HaskellCallbackType info ->+ (o -> HaskellCallbackType info) -> SignalConnectMode -> Maybe Text -> IO SignalHandlerId+ dbgSignalInfo :: Maybe ResolvedSymbolInfo+ dbgSignalInfo = Nothing type role SignalProxy nominal nominal data SignalProxy object info where@@ -31,4 +36,9 @@ on :: forall object info m. (GObject object, MonadIO m, SignalInfo info) => object -> SignalProxy object info- -> HaskellCallbackType info -> m SignalHandlerId+ -> ((?self :: object) => HaskellCallbackType info) -> m SignalHandlerId++after :: forall object info m.+ (GObject object, MonadIO m, SignalInfo info) =>+ object -> SignalProxy object info+ -> ((?self :: object) => HaskellCallbackType info) -> m SignalHandlerId
− c/hsgclosure.c
@@ -1,410 +0,0 @@-#define _GNU_SOURCE--/* GHC's semi-public Rts API */-#include <Rts.h>--#include <stdarg.h>-#include <stdlib.h>-#include <string.h>-#include <pthread.h>--#include <glib-object.h>-#include <glib.h>--static int print_debug_info ()-{- static int __print_debug_info = -1;-- if (__print_debug_info == -1) {- __print_debug_info = getenv ("HASKELL_GI_DEBUG_MEM") != NULL;- }-- return __print_debug_info;-}--/*- A mutex protecting the log file handle. We make it recursive,- i.e. refcounted, so it is OK to lock repeatedly in the same thread.-*/-static pthread_mutex_t log_mutex-#if defined(PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP)- = PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP;-#elif defined(PTHREAD_RECURSIVE_MUTEX_INITIALIZER)- = PTHREAD_RECURSIVE_MUTEX_INITIALIZER;-#else- ;-__attribute__ ((constructor)) static void init_log_mutex()-{- pthread_mutexattr_t attr;- pthread_mutexattr_init(&attr);- pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);- pthread_mutex_init(&log_mutex, &attr);- pthread_mutexattr_destroy(&attr);-}-#endif--/* Give the current thread exclusive access to the log */-static void lock_log()-{- pthread_mutex_lock(&log_mutex);-}--/* Decrease the refcount of the mutex protecting access to the log- from other threads */-static void unlock_log()-{- pthread_mutex_unlock(&log_mutex);-}--/* Print the given message to the log. The passed in string does not- need to be zero-terminated. The message is only printed if the- HASKELL_GI_DEBUG_MEM variable is set. */-void dbg_log_with_len (const char *msg, int len)-{- if (print_debug_info()) {- lock_log();- fwrite(msg, len, 1, stderr);- unlock_log();- }-}--/* 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 (printf, 1, 2)))-static void dbg_log (const char *msg, ...)-{- va_list args;-- va_start(args, msg);-- if (print_debug_info()) {- lock_log();- vfprintf(stderr, msg, args);- unlock_log();- }-- va_end(args);-}--int check_object_type (void *instance, GType type)-{- int result;-- if (instance != NULL) {- result = !!G_TYPE_CHECK_INSTANCE_TYPE(instance, type);- } else {- result = 0;- dbg_log("Check failed: got a null pointer\n");- }-- return result;-}--GType _haskell_gi_g_value_get_type (GValue *gvalue)-{- return G_VALUE_TYPE (gvalue);-}--/* Information about a boxed type to free */-typedef struct {- GType gtype;- gpointer boxed;-} BoxedFreeInfo;--/* Auxiliary function for freeing boxed types in the main loop. See- the annotation in g_object_unref_in_main_loop() below. */-static gboolean main_loop_boxed_free_helper (gpointer _info)-{- BoxedFreeInfo *info = (BoxedFreeInfo*)_info;-- if (print_debug_info()) {- GThread *self = g_thread_self ();- lock_log();- dbg_log("Freeing a boxed object at %p from idle callback [thread: %p]\n",- info->boxed, self);- dbg_log("\tIt is of type %s\n", g_type_name(info->gtype));- }-- g_boxed_free (info->gtype, info->boxed);-- if (print_debug_info()) {- dbg_log("\tdone freeing %p.\n", info->boxed);- unlock_log();- }-- g_free(info);-- return FALSE; /* Do not invoke again */-}--void boxed_free_helper (GType gtype, void *boxed)-{- BoxedFreeInfo *info = g_malloc(sizeof(BoxedFreeInfo));-- info->gtype = gtype;- info->boxed = boxed;-- g_idle_add (main_loop_boxed_free_helper, info);-}--void dbg_g_object_disown (GObject *obj)-{- GType gtype;-- if (print_debug_info()) {- lock_log();- GThread *self = g_thread_self();- dbg_log("Disowning a GObject at %p [thread: %p]\n", obj, self);- gtype = G_TYPE_FROM_INSTANCE (obj);- dbg_log("\tIt is of type %s\n", g_type_name(gtype));- dbg_log("\tIts refcount before disowning is %d\n", (int)obj->ref_count);- unlock_log();- }-}--static void print_object_dbg_info (GObject *obj)-{- GThread *self = g_thread_self();- GType gtype;-- dbg_log("Unref of %p from idle callback [thread: %p]\n", obj, self);- gtype = G_TYPE_FROM_INSTANCE (obj);- dbg_log("\tIt is of type %s\n", g_type_name(gtype));- dbg_log("\tIts refcount before unref is %d\n", (int)obj->ref_count);-}--/*- We schedule all GObject deletions to happen in the main loop. The- reason is that for some types the destructor is not thread safe, and- assumes that it is being run from the same thread as the main loop- that created the object.- */-static gboolean-g_object_unref_in_main_loop (gpointer obj)-{- if (print_debug_info()) {- lock_log();- print_object_dbg_info ((GObject*)obj);- }-- g_object_unref (obj);-- if (print_debug_info()) {- fprintf(stderr, "\tUnref done\n");- unlock_log();- }-- return FALSE; /* Do not invoke again */-}--void dbg_g_object_unref (GObject *obj)-{- g_idle_add(g_object_unref_in_main_loop, obj);-}--/**- * dbg_g_object_new:- * @gtype: #GType for the object to construct.- * @n_props: Number of parameters for g_object_new_with_properties().- * @names: Names of the properties to be set.- * @values: Parameters for g_object_new_with_properties().- *- * Allocate a #GObject of #GType @gtype, with the given @params. The- * returned object is never floating, and we always own a reference to- * it. (It might not be the only existing to the object, but it is in- * any case safe to call g_object_unref() when we are not wrapping the- * object ourselves anymore.)- *- * Returns: A new #GObject.- */-gpointer dbg_g_object_new (GType gtype, guint n_props,- const char *names[], const GValue values[])-{- gpointer result;-- if (print_debug_info()) {- GThread *self = g_thread_self();-- lock_log();- dbg_log("Creating a new GObject of type %s [thread: %p]\n",- g_type_name(gtype), self);- }--#if GLIB_CHECK_VERSION(2,54,0)- result = g_object_new_with_properties (gtype, n_props, names, values);-#else- { GParameter params[n_props];- int i;-- for (i=0; i<n_props; i++) {- memcpy (¶ms[i].value, &values[i], sizeof(GValue));- params[i].name = names[i];- }-- result = g_object_newv (gtype, n_props, params);- }-#endif-- /*- Initially unowned GObjects can be either floating or not after- construction. They are generally floating, but GtkWindow for- instance is not floating after construction.-- In either case we want to call g_object_ref_sink(): if the object- is floating to take ownership of the reference, and otherwise to- add a reference that we own.-- If the object is not initially unowned we simply take control of- the initial reference (implicitly).- */- if (G_IS_INITIALLY_UNOWNED (result)) {- g_object_ref_sink (result);- }-- if (print_debug_info()) {- dbg_log("\tdone, got a pointer at %p\n", result);- unlock_log();- }-- return result;-}--/* Same as freeHaskellFunctionPtr, but it does nothing when given a- null pointer, instead of crashing */-void safeFreeFunPtr(void *ptr)-{- if (ptr != NULL)- freeHaskellFunctionPtr(ptr);-}--/* Same as safeFreeFunPtr, but it accepts (but ignores) an extra argument */-void safeFreeFunPtr2(void *ptr, void *unused)-{- safeFreeFunPtr(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(>ypes_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(>ypes_mutex);-- return result;-}--static HsStablePtr duplicateStablePtr(HsStablePtr stable_ptr)-{- return getStablePtr(deRefStablePtr(stable_ptr));-}--GType haskell_gi_StablePtr_get_type (void)-{- static volatile gsize g_define_type_id__volatile = 0;-- 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);-- g_once_init_leave (&g_define_type_id__volatile, g_define_type_id);- }-- return g_define_type_id__volatile;-}--/* 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();-}--/* Check whether the given closure is floating */-gboolean-haskell_gi_g_closure_is_floating (GClosure *closure)-{- return !!(closure->floating);-}--/* GParamSpec* types are registered as GObjects, but they do not have- an exported type_init function. They only export CPP macros, so- we have to provide our own. */-#define PARAM_TYPE(CamelCase, UPPERCASE) \- GType haskell_gi_pspec_type_init_##CamelCase (void) { \- return G_TYPE_##UPPERCASE; \- }--PARAM_TYPE(ParamSpec, PARAM);-PARAM_TYPE(ParamSpecBoolean, PARAM_BOOLEAN);-PARAM_TYPE(ParamSpecBoxed, PARAM_BOXED);-PARAM_TYPE(ParamSpecChar, PARAM_CHAR);-PARAM_TYPE(ParamSpecDouble, PARAM_DOUBLE);-PARAM_TYPE(ParamSpecEnum, PARAM_ENUM);-PARAM_TYPE(ParamSpecFlags, PARAM_FLAGS);-PARAM_TYPE(ParamSpecFloat, PARAM_FLOAT);-PARAM_TYPE(ParamSpecGType, PARAM_GTYPE);-PARAM_TYPE(ParamSpecInt, PARAM_INT);-PARAM_TYPE(ParamSpecInt64, PARAM_INT64);-PARAM_TYPE(ParamSpecLong, PARAM_LONG);-PARAM_TYPE(ParamSpecObject, PARAM_OBJECT);-PARAM_TYPE(ParamSpecOverride, PARAM_OVERRIDE);-PARAM_TYPE(ParamSpecParam, PARAM_PARAM);-PARAM_TYPE(ParamSpecPointer, PARAM_POINTER);-PARAM_TYPE(ParamSpecString, PARAM_STRING);-PARAM_TYPE(ParamSpecUChar, PARAM_UCHAR);-PARAM_TYPE(ParamSpecUInt, PARAM_UINT);-PARAM_TYPE(ParamSpecUInt64, PARAM_UINT64);-PARAM_TYPE(ParamSpecULong, PARAM_ULONG);-PARAM_TYPE(ParamSpecUnichar, PARAM_UNICHAR);-PARAM_TYPE(ParamSpecVariant, PARAM_VARIANT);-/* The following is deprecated, ignore the warning that GLib raises. */-#undef GLIB_DEPRECATED_MACRO-#define GLIB_DEPRECATED_MACRO-PARAM_TYPE(ParamSpecValueArray, PARAM_VALUE_ARRAY);
+ csrc/hsgclosure.c view
@@ -0,0 +1,410 @@+#define _GNU_SOURCE++/* GHC's semi-public Rts API */+#include <Rts.h>++#include <stdarg.h>+#include <stdlib.h>+#include <string.h>+#include <pthread.h>++#include <glib-object.h>+#include <glib.h>++static int print_debug_info ()+{+ static int __print_debug_info = -1;++ if (__print_debug_info == -1) {+ __print_debug_info = getenv ("HASKELL_GI_DEBUG_MEM") != NULL;+ }++ return __print_debug_info;+}++/*+ A mutex protecting the log file handle. We make it recursive,+ i.e. refcounted, so it is OK to lock repeatedly in the same thread.+*/+static pthread_mutex_t log_mutex+#if defined(PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP)+ = PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP;+#elif defined(PTHREAD_RECURSIVE_MUTEX_INITIALIZER)+ = PTHREAD_RECURSIVE_MUTEX_INITIALIZER;+#else+ ;+__attribute__ ((constructor)) static void init_log_mutex()+{+ pthread_mutexattr_t attr;+ pthread_mutexattr_init(&attr);+ pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);+ pthread_mutex_init(&log_mutex, &attr);+ pthread_mutexattr_destroy(&attr);+}+#endif++/* Give the current thread exclusive access to the log */+static void lock_log()+{+ pthread_mutex_lock(&log_mutex);+}++/* Decrease the refcount of the mutex protecting access to the log+ from other threads */+static void unlock_log()+{+ pthread_mutex_unlock(&log_mutex);+}++/* Print the given message to the log. The passed in string does not+ need to be zero-terminated. The message is only printed if the+ HASKELL_GI_DEBUG_MEM variable is set. */+void dbg_log_with_len (const char *msg, int len)+{+ if (print_debug_info()) {+ lock_log();+ fwrite(msg, len, 1, stderr);+ unlock_log();+ }+}++/* 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 (printf, 1, 2)))+static void dbg_log (const char *msg, ...)+{+ va_list args;++ va_start(args, msg);++ if (print_debug_info()) {+ lock_log();+ vfprintf(stderr, msg, args);+ unlock_log();+ }++ va_end(args);+}++int check_object_type (void *instance, GType type)+{+ int result;++ if (instance != NULL) {+ result = !!G_TYPE_CHECK_INSTANCE_TYPE(instance, type);+ } else {+ result = 0;+ dbg_log("Check failed: got a null pointer\n");+ }++ return result;+}++GType _haskell_gi_g_value_get_type (GValue *gvalue)+{+ return G_VALUE_TYPE (gvalue);+}++/* Information about a boxed type to free */+typedef struct {+ GType gtype;+ gpointer boxed;+} BoxedFreeInfo;++/* Auxiliary function for freeing boxed types in the main loop. See+ the annotation in g_object_unref_in_main_loop() below. */+static gboolean main_loop_boxed_free_helper (gpointer _info)+{+ BoxedFreeInfo *info = (BoxedFreeInfo*)_info;++ if (print_debug_info()) {+ GThread *self = g_thread_self ();+ lock_log();+ dbg_log("Freeing a boxed object at %p from idle callback [thread: %p]\n",+ info->boxed, self);+ dbg_log("\tIt is of type %s\n", g_type_name(info->gtype));+ }++ g_boxed_free (info->gtype, info->boxed);++ if (print_debug_info()) {+ dbg_log("\tdone freeing %p.\n", info->boxed);+ unlock_log();+ }++ g_free(info);++ return FALSE; /* Do not invoke again */+}++void boxed_free_helper (GType gtype, void *boxed)+{+ BoxedFreeInfo *info = g_malloc(sizeof(BoxedFreeInfo));++ info->gtype = gtype;+ info->boxed = boxed;++ g_idle_add (main_loop_boxed_free_helper, info);+}++void dbg_g_object_disown (GObject *obj)+{+ GType gtype;++ if (print_debug_info()) {+ lock_log();+ GThread *self = g_thread_self();+ dbg_log("Disowning a GObject at %p [thread: %p]\n", obj, self);+ gtype = G_TYPE_FROM_INSTANCE (obj);+ dbg_log("\tIt is of type %s\n", g_type_name(gtype));+ dbg_log("\tIts refcount before disowning is %d\n", (int)obj->ref_count);+ unlock_log();+ }+}++static void print_object_dbg_info (GObject *obj)+{+ GThread *self = g_thread_self();+ GType gtype;++ dbg_log("Unref of %p from idle callback [thread: %p]\n", obj, self);+ gtype = G_TYPE_FROM_INSTANCE (obj);+ dbg_log("\tIt is of type %s\n", g_type_name(gtype));+ dbg_log("\tIts refcount before unref is %d\n", (int)obj->ref_count);+}++/*+ We schedule all GObject deletions to happen in the main loop. The+ reason is that for some types the destructor is not thread safe, and+ assumes that it is being run from the same thread as the main loop+ that created the object.+ */+static gboolean+g_object_unref_in_main_loop (gpointer obj)+{+ if (print_debug_info()) {+ lock_log();+ print_object_dbg_info ((GObject*)obj);+ }++ g_object_unref (obj);++ if (print_debug_info()) {+ fprintf(stderr, "\tUnref done\n");+ unlock_log();+ }++ return FALSE; /* Do not invoke again */+}++void dbg_g_object_unref (GObject *obj)+{+ g_idle_add(g_object_unref_in_main_loop, obj);+}++/**+ * dbg_g_object_new:+ * @gtype: #GType for the object to construct.+ * @n_props: Number of parameters for g_object_new_with_properties().+ * @names: Names of the properties to be set.+ * @values: Parameters for g_object_new_with_properties().+ *+ * Allocate a #GObject of #GType @gtype, with the given @params. The+ * returned object is never floating, and we always own a reference to+ * it. (It might not be the only existing to the object, but it is in+ * any case safe to call g_object_unref() when we are not wrapping the+ * object ourselves anymore.)+ *+ * Returns: A new #GObject.+ */+gpointer dbg_g_object_new (GType gtype, guint n_props,+ const char *names[], const GValue values[])+{+ gpointer result;++ if (print_debug_info()) {+ GThread *self = g_thread_self();++ lock_log();+ dbg_log("Creating a new GObject of type %s [thread: %p]\n",+ g_type_name(gtype), self);+ }++#if GLIB_CHECK_VERSION(2,54,0)+ result = g_object_new_with_properties (gtype, n_props, names, values);+#else+ { GParameter params[n_props];+ int i;++ for (i=0; i<n_props; i++) {+ memcpy (¶ms[i].value, &values[i], sizeof(GValue));+ params[i].name = names[i];+ }++ result = g_object_newv (gtype, n_props, params);+ }+#endif++ /*+ Initially unowned GObjects can be either floating or not after+ construction. They are generally floating, but GtkWindow for+ instance is not floating after construction.++ In either case we want to call g_object_ref_sink(): if the object+ is floating to take ownership of the reference, and otherwise to+ add a reference that we own.++ If the object is not initially unowned we simply take control of+ the initial reference (implicitly).+ */+ if (G_IS_INITIALLY_UNOWNED (result)) {+ g_object_ref_sink (result);+ }++ if (print_debug_info()) {+ dbg_log("\tdone, got a pointer at %p\n", result);+ unlock_log();+ }++ return result;+}++/* Same as freeHaskellFunctionPtr, but it does nothing when given a+ null pointer, instead of crashing */+void safeFreeFunPtr(void *ptr)+{+ if (ptr != NULL)+ freeHaskellFunctionPtr(ptr);+}++/* Same as safeFreeFunPtr, but it accepts (but ignores) an extra argument */+void safeFreeFunPtr2(void *ptr, void *unused)+{+ safeFreeFunPtr(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(>ypes_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(>ypes_mutex);++ return result;+}++static HsStablePtr duplicateStablePtr(HsStablePtr stable_ptr)+{+ return getStablePtr(deRefStablePtr(stable_ptr));+}++GType haskell_gi_StablePtr_get_type (void)+{+ static gsize g_define_type_id = 0;++ if (g_once_init_enter (&g_define_type_id))+ {+ GType type_id =+ g_boxed_type_register_static (g_intern_static_string ("HaskellGIStablePtr"),+ duplicateStablePtr,+ hs_free_stable_ptr);++ g_once_init_leave (&g_define_type_id, type_id);+ }++ return g_define_type_id;+}++/* 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();+}++/* Check whether the given closure is floating */+gboolean+haskell_gi_g_closure_is_floating (GClosure *closure)+{+ return !!(closure->floating);+}++/* GParamSpec* types are registered as GObjects, but they do not have+ an exported type_init function. They only export CPP macros, so+ we have to provide our own. */+#define PARAM_TYPE(CamelCase, UPPERCASE) \+ GType haskell_gi_pspec_type_init_##CamelCase (void) { \+ return G_TYPE_##UPPERCASE; \+ }++PARAM_TYPE(ParamSpec, PARAM);+PARAM_TYPE(ParamSpecBoolean, PARAM_BOOLEAN);+PARAM_TYPE(ParamSpecBoxed, PARAM_BOXED);+PARAM_TYPE(ParamSpecChar, PARAM_CHAR);+PARAM_TYPE(ParamSpecDouble, PARAM_DOUBLE);+PARAM_TYPE(ParamSpecEnum, PARAM_ENUM);+PARAM_TYPE(ParamSpecFlags, PARAM_FLAGS);+PARAM_TYPE(ParamSpecFloat, PARAM_FLOAT);+PARAM_TYPE(ParamSpecGType, PARAM_GTYPE);+PARAM_TYPE(ParamSpecInt, PARAM_INT);+PARAM_TYPE(ParamSpecInt64, PARAM_INT64);+PARAM_TYPE(ParamSpecLong, PARAM_LONG);+PARAM_TYPE(ParamSpecObject, PARAM_OBJECT);+PARAM_TYPE(ParamSpecOverride, PARAM_OVERRIDE);+PARAM_TYPE(ParamSpecParam, PARAM_PARAM);+PARAM_TYPE(ParamSpecPointer, PARAM_POINTER);+PARAM_TYPE(ParamSpecString, PARAM_STRING);+PARAM_TYPE(ParamSpecUChar, PARAM_UCHAR);+PARAM_TYPE(ParamSpecUInt, PARAM_UINT);+PARAM_TYPE(ParamSpecUInt64, PARAM_UINT64);+PARAM_TYPE(ParamSpecULong, PARAM_ULONG);+PARAM_TYPE(ParamSpecUnichar, PARAM_UNICHAR);+PARAM_TYPE(ParamSpecVariant, PARAM_VARIANT);+/* The following is deprecated, ignore the warning that GLib raises. */+#undef GLIB_DEPRECATED_MACRO+#define GLIB_DEPRECATED_MACRO+PARAM_TYPE(ParamSpecValueArray, PARAM_VALUE_ARRAY);
haskell-gi-base.cabal view
@@ -1,5 +1,5 @@ name: haskell-gi-base-version: 0.25.0+version: 0.26.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@@ -47,16 +47,16 @@ Data.GI.Base.Internal.CTypes pkgconfig-depends: gobject-2.0 >= 2.42, glib-2.0- build-depends: base >= 4.9 && < 5,+ build-depends: base >= 4.11 && < 5, bytestring, containers, text >= 1.0 - ghc-options: -Wall -Wno-redundant-constraints -fwarn-incomplete-patterns+ ghc-options: -Wall -Wno-redundant-constraints -fwarn-incomplete-patterns -Wcompat build-tool-depends: hsc2hs:hsc2hs cc-options: -fPIC default-language: Haskell2010 default-extensions: CPP, ForeignFunctionInterface, DoAndIfThenElse, MonoLocalBinds other-extensions: TypeApplications, ScopedTypeVariables- c-sources: c/hsgclosure.c+ c-sources: csrc/hsgclosure.c