packages feed

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 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 (&params[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(&gtypes_mutex);-  result = g_type_from_name (name);--  if (result == 0) {-    /* Note that class_init and instance_init are HsFunPtrs, which we-       keep alive for the duration of the program. */-    GTypeQuery query;-    g_type_query (parent, &query);-    result = g_type_register_static_simple (parent, name,-                                            query.class_size, class_init,-                                            query.instance_size, instance_init,-                                            0);-  } else {-    /* Free the memory associated with the HsFunPtrs that we are-       given, to avoid a (small) memory leak. */-    hs_free_fun_ptr ((HsFunPtr)class_init);-    hs_free_fun_ptr ((HsFunPtr)instance_init);-  }-  pthread_mutex_unlock(&gtypes_mutex);--  return result;-}--static 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 (&params[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(&gtypes_mutex);+  result = g_type_from_name (name);++  if (result == 0) {+    /* Note that class_init and instance_init are HsFunPtrs, which we+       keep alive for the duration of the program. */+    GTypeQuery query;+    g_type_query (parent, &query);+    result = g_type_register_static_simple (parent, name,+                                            query.class_size, class_init,+                                            query.instance_size, instance_init,+                                            0);+  } else {+    /* Free the memory associated with the HsFunPtrs that we are+       given, to avoid a (small) memory leak. */+    hs_free_fun_ptr ((HsFunPtr)class_init);+    hs_free_fun_ptr ((HsFunPtr)instance_init);+  }+  pthread_mutex_unlock(&gtypes_mutex);++  return result;+}++static 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