haskell-gi-base 0.13 → 0.14

raw patch · 14 files changed

+627/−282 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• haskell-gi-base.cabal +5/−3
• src/Data/GI/Base.hs +5/−9
• src/Data/GI/Base/Attributes.hs +40/−6
• src/Data/GI/Base/BasicConversions.hsc +1/−0
• src/Data/GI/Base/BasicTypes.hsc +112/−18
• src/Data/GI/Base/Constructible.hs +32/−0
• src/Data/GI/Base/GObject.hsc +78/−0
• src/Data/GI/Base/GValue.hsc +94/−28
• src/Data/GI/Base/ManagedPtr.hs +15/−2
• src/Data/GI/Base/Properties.hsc +218/−205
• src/Data/GI/Base/ShortPrelude.hs +9/−4
• src/Data/GI/Base/Signals.hsc +3/−5
• src/Data/GI/Base/Utils.hsc +14/−1
• src/c/hsgclosure.c +1/−1

@@ -1,5 +1,5 @@ name:                haskell-gi-base-version:             0.13+version:             0.14 synopsis:            Foundation for libraries generated by haskell-gi description:         Foundation for libraries generated by haskell-gi homepage:            https://github.com/haskell-gi/haskell-gi-base@@ -26,8 +26,10 @@                        Data.GI.Base.BasicConversions,                        Data.GI.Base.BasicTypes,                        Data.GI.Base.Closure,+                       Data.GI.Base.Constructible,                        Data.GI.Base.GError,                        Data.GI.Base.GHashTable,+                       Data.GI.Base.GObject,                        Data.GI.Base.GValue,                        Data.GI.Base.GVariant,                        Data.GI.Base.ManagedPtr,@@ -38,7 +40,7 @@                        Data.GI.Base.Signals,                        Data.GI.Base.Utils -  pkgconfig-depends:   gobject-2.0 >= 2.36+  pkgconfig-depends:   gobject-2.0 >= 2.32   build-depends:       base >= 4.7 && < 5,                        bytestring,                        containers,@@ -49,5 +51,5 @@    build-tools:         hsc2hs   extensions:          CPP, ForeignFunctionInterface, DoAndIfThenElse-  ghc-options:         -Wall -fno-warn-missing-signatures -fwarn-incomplete-patterns -fno-warn-name-shadowing+  ghc-options:         -Wall -fwarn-incomplete-patterns   c-sources:           src/c/hsgclosure.c

@@ -9,27 +9,23 @@     , module Data.GI.Base.BasicConversions     , module Data.GI.Base.BasicTypes     , module Data.GI.Base.Closure+    , module Data.GI.Base.Constructible     , module Data.GI.Base.GError     , module Data.GI.Base.GHashTable     , module Data.GI.Base.GValue     , module Data.GI.Base.GVariant-    , module Data.GI.Base.GParamSpec     , module Data.GI.Base.ManagedPtr-    , module Data.GI.Base.Properties     , module Data.GI.Base.Signals-    , module Data.GI.Base.Utils     ) where -import Data.GI.Base.Attributes+import Data.GI.Base.Attributes (get, set, AttrOp(..)) import Data.GI.Base.BasicConversions import Data.GI.Base.BasicTypes import Data.GI.Base.Closure+import Data.GI.Base.Constructible (new) import Data.GI.Base.GError import Data.GI.Base.GHashTable-import Data.GI.Base.GValue+import Data.GI.Base.GValue (GValue(..), IsGValue(..)) import Data.GI.Base.GVariant-import Data.GI.Base.GParamSpec import Data.GI.Base.ManagedPtr-import Data.GI.Base.Properties-import Data.GI.Base.Signals-import Data.GI.Base.Utils+import Data.GI.Base.Signals (on, after, SignalProxy(PropertyNotify))

@@ -51,7 +51,7 @@ -- > _label = fromLabelProxy (Proxy :: Proxy "label") -- -- These proxies can be automatically generated by invoking the code--- generator with the @-a@ option. The leading underscore is simply so+-- generator with the @-l@ option. The leading underscore is simply so -- the autogenerated identifiers do not pollute the namespace, but if -- this is not a concern the autogenerated names (in the autogenerated -- @GI/Properties.hs@) can be edited as one wishes.@@ -82,10 +82,10 @@ -- -- > set spinButton [ _value :~ (+1) ] ----- There are other variants of these operators, (see 'AttrOp'). ':=>' and--- ':~>' and like ':=' and ':~' but operate in the 'IO' monad rather--- than being pure. There is also '::=' and '::~' which take the object--- as an extra parameter.+-- There are other variants of these operators, see 'AttrOp'+-- below. ':=>' and ':~>' are like ':=' and ':~' but operate in the+-- 'IO' monad rather than being pure. There is also '::=' and '::~'+-- which take the object as an extra parameter. -- -- Attributes can also be set during construction of a -- `Data.GI.Base.BasicTypes.GObject` using `Data.GI.Base.Properties.new`@@ -98,6 +98,26 @@ -- `set` afterwards. That these invariants hold is also checked during -- compile time. --+-- == Nullable atributes+--+-- Whenever the attribute is represented as a pointer in the C side,+-- it is often the case that the underlying C representation admits or+-- returns @NULL@ as a valid value for the property. In these cases+-- the `get` operation may return a `Maybe` value, with `Nothing`+-- representing the @NULL@ pointer value (notable exceptions are+-- `Data.GI.Base.BasicTypes.GList` and+-- `Data.GI.Base.BasicTypes.GSList`, for which @NULL@ is represented+-- simply as he empty list). This can be overriden in the+-- introspection data, since sometimes attributes are non-nullable,+-- even if the type would allow for @NULL@.+--+-- For convenience, in nullable cases the `set` operation will by+-- default /not/ take a `Maybe` value, but rather assume that the+-- caller wants to set a non-@NULL@ value. If setting a @NULL@ value+-- is desired, use `clear` as follows+--+-- > clear object _propName+-- module Data.GI.Base.Attributes (   AttrInfo(..), @@ -107,6 +127,7 @@    get,   set,+  clear,    AttrLabelProxy(..)   ) where@@ -160,6 +181,10 @@     attrSet :: (AttrBaseTypeConstraint info o,                 AttrSetTypeConstraint info b) =>                Proxy info -> o -> b -> IO ()+    -- | Set the value of the given attribute to @NULL@ (for nullable+    -- attributes).+    attrClear :: AttrBaseTypeConstraint info o =>+                 Proxy info -> o -> IO ()     -- | Build a `GValue` representing the attribute.     attrConstruct :: AttrSetTypeConstraint info b =>                      Proxy info -> b -> IO (String, GValue)@@ -192,7 +217,7 @@         AttrOpIsAllowed tag (AttrAllowedOps info) (AttrLabel info) ~ 'OpIsAllowed  -- | Possible operations on an attribute.-data AttrOpTag = AttrGet | AttrSet | AttrConstruct+data AttrOpTag = AttrGet | AttrSet | AttrConstruct | AttrClear  #if MIN_VERSION_base(4,9,0) -- | A user friendly description of the `AttrOpTag`, useful when@@ -201,6 +226,7 @@     AttrOpText 'AttrGet = "gettable"     AttrOpText 'AttrSet = "settable"     AttrOpText 'AttrConstruct = "constructible"+    AttrOpText 'AttrClear = "nullable" #endif  -- | Constructors for the different operations allowed on an attribute.@@ -284,3 +310,11 @@         AttrOpAllowed 'AttrGet info, MonadIO m) =>         obj -> AttrLabelProxy (attr :: Symbol) -> m (AttrGetType info) get o _ = liftIO $ attrGet (Proxy :: Proxy info) o++-- | Set a nullable attribute to @NULL@.+clear :: forall info attr obj m.+         (info ~ ResolveAttribute attr obj, AttrInfo info,+          (AttrBaseTypeConstraint info) obj,+         AttrOpAllowed 'AttrClear info, MonadIO m) =>+         obj -> AttrLabelProxy (attr :: Symbol) -> m ()+clear o _ = liftIO $ attrClear (Proxy :: Proxy info) o

@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-} module Data.GI.Base.BasicConversions     ( gflagsToWord     , wordToGFlags

@@ -1,5 +1,8 @@ {-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances,-  DeriveDataTypeable #-}+  DeriveDataTypeable, TypeFamilies, ScopedTypeVariables #-}+#if !MIN_VERSION_base(4,8,0)+{-# LANGUAGE OverlappingInstances #-}+#endif -- | Basic types used in the bindings. module Data.GI.Base.BasicTypes     (@@ -11,8 +14,10 @@      , gtypeString     , gtypePointer-    , gtypeInt32-    , gtypeUInt32+    , gtypeInt+    , gtypeUInt+    , gtypeLong+    , gtypeULong     , gtypeInt64     , gtypeUInt64     , gtypeFloat@@ -22,14 +27,19 @@     , gtypeStrv     , gtypeBoxed     , gtypeObject+    , gtypeVariant+    , gtypeByteArray+    , gtypeInvalid       -- * Memory management      , ForeignPtrNewtype     , BoxedObject(..)     , BoxedEnum(..)+    , BoxedFlags(..)     , GObject(..)     , UnexpectedNullPointerReturn(..)+    , NullToNothing(..)      -- * Basic GLib \/ GObject types     , GVariant(..)@@ -50,8 +60,13 @@     , GDestroyNotify     ) where -import Control.Exception (Exception)+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif+import Control.Exception (Exception, catch)+import Control.Monad.IO.Class (MonadIO(..)) import Data.Coerce (Coercible)+import Data.Proxy (Proxy) import qualified Data.Text as T import Data.Typeable (Typeable) import Data.Word@@ -75,6 +90,22 @@ gtypeName :: GType -> IO String gtypeName gtype = g_type_name gtype >>= peekCString +{-| [Note: compile-time vs run-time GTypes]++Notice that there are two types of GType's: the fundamental ones,+which are created with G_TYPE_MAKE_FUNDAMENTAL(n) and always have the+same runtime representation, and the ones that are registered in the+GObject type system at runtime, and whose `CGType` may change for each+program run (and generally does).++For the first type it is safe to use hsc to read the numerical values+of the CGType at compile type, but for the second type it is essential+to call the corresponding _get_type() function at runtime, and not use+the value of the corresponding "constant" at compile time via hsc.+-}++{- Fundamental types -}+ -- | `GType` of strings. gtypeString :: GType gtypeString = GType #const G_TYPE_STRING@@ -83,14 +114,22 @@ gtypePointer :: GType gtypePointer = GType #const G_TYPE_POINTER --- | `GType` for signed integers.-gtypeInt32 :: GType-gtypeInt32 = GType #const G_TYPE_INT+-- | `GType` for signed integers (`gint` or `gint32`).+gtypeInt :: GType+gtypeInt = GType #const G_TYPE_INT --- | `GType` for unsigned integers.-gtypeUInt32 :: GType-gtypeUInt32 = GType #const G_TYPE_UINT+-- | `GType` for unsigned integers (`guint` or `guint32`).+gtypeUInt :: GType+gtypeUInt = GType #const G_TYPE_UINT +-- | `GType` for `glong`.+gtypeLong :: GType+gtypeLong = GType #const G_TYPE_LONG++-- | `GType` for `gulong`.+gtypeULong :: GType+gtypeULong = GType #const G_TYPE_ULONG+ -- | `GType` for signed 64 bit integers. gtypeInt64 :: GType gtypeInt64 = GType #const G_TYPE_INT64@@ -111,14 +150,6 @@ gtypeBoolean :: GType gtypeBoolean = GType #const G_TYPE_BOOLEAN --- | `GType` corresponding to a `GType` itself.-gtypeGType :: GType-gtypeGType = GType #const G_TYPE_GTYPE---- | `GType` for a NULL terminated array of strings.-gtypeStrv :: GType-gtypeStrv = GType #const G_TYPE_STRV- -- | `GType` corresponding to a `BoxedObject`. gtypeBoxed :: GType gtypeBoxed = GType #const G_TYPE_BOXED@@ -127,6 +158,35 @@ gtypeObject :: GType gtypeObject = GType #const G_TYPE_OBJECT +-- | An invalid `GType` used as error return value in some functions+-- which return a `GType`.+gtypeInvalid :: GType+gtypeInvalid = GType #const G_TYPE_INVALID++-- | The `GType` corresponding to a `GVariant`.+gtypeVariant :: GType+gtypeVariant = GType #const G_TYPE_VARIANT++{- Run-time types -}++foreign import ccall "g_gtype_get_type" g_gtype_get_type :: CGType++-- | `GType` corresponding to a `GType` itself.+gtypeGType :: GType+gtypeGType = GType g_gtype_get_type++foreign import ccall "g_strv_get_type" g_strv_get_type :: CGType++-- | `GType` for a NULL terminated array of strings.+gtypeStrv :: GType+gtypeStrv = GType g_strv_get_type++foreign import ccall "g_byte_array_get_type" g_byte_array_get_type :: CGType++-- | `GType` for a boxed type holding a `GByteArray`.+gtypeByteArray :: GType+gtypeByteArray = GType g_byte_array_get_type+ -- | A constraint ensuring that the given type is coercible to a -- ForeignPtr. It will hold for newtypes of the form --@@ -149,6 +209,10 @@ class BoxedEnum a where     boxedEnumType :: a -> IO GType +-- | Flags with an associated `GType`.+class BoxedFlags a where+    boxedFlagsType :: Proxy a -> IO GType+ -- | A wrapped `GObject`. class ForeignPtrNewtype a => GObject a where     -- | Whether the `GObject` is a descendent of <https://developer.gnome.org/gobject/stable/gobject-The-Base-Object-Type.html#GInitiallyUnowned GInitiallyUnowned>.@@ -168,6 +232,36 @@                                 deriving (Show, Typeable)  instance Exception UnexpectedNullPointerReturn++type family UnMaybe a :: * where+    UnMaybe (Maybe a) = a+    UnMaybe a         = a++class NullToNothing a where+    -- | Some functions are not marked as having a nullable return type+    -- in the introspection data.  The result is that they currently do+    -- not return a Maybe type.  This functions lets you work around this+    -- in a way that will not break when the introspection data is fixed.+    --+    -- When you want to call a `someHaskellGIFunction` that may return null+    -- wrap the call like this.+    --+    -- > nullToNothing (someHaskellGIFunction x y)+    --+    -- The result will be a Maybe type even if the introspection data has+    -- not been fixed for `someHaskellGIFunction` yet.+    nullToNothing :: MonadIO m => IO a -> m (Maybe (UnMaybe a))++instance+#if MIN_VERSION_base(4,8,0)+    {-# OVERLAPPABLE #-}+#endif+    a ~ UnMaybe a => NullToNothing a where+        nullToNothing f = liftIO $+            (Just <$> f) `catch` (\(_::UnexpectedNullPointerReturn) -> return Nothing)++instance NullToNothing (Maybe a) where+    nullToNothing = liftIO  -- | A <https://developer.gnome.org/glib/stable/glib-GVariant.html GVariant>. See "Data.GI.Base.GVariant" for further methods. newtype GVariant = GVariant (ForeignPtr GVariant)

@@ -0,0 +1,32 @@+{-# LANGUAGE DataKinds, FlexibleInstances, MultiParamTypeClasses,+  UndecidableInstances, KindSignatures, TypeFamilies #-}+#if !MIN_VERSION_base(4,8,0)+{-# LANGUAGE OverlappingInstances #-}+#endif++-- | `Constructible` types are those for which `new` is+-- defined. Often these are `GObject`s, but it is possible to+-- construct new (zero-initialized) structures and unions too.++module Data.GI.Base.Constructible+    ( Constructible(..)+    ) where++import Foreign (ForeignPtr)+import Control.Monad.IO.Class (MonadIO)++import Data.GI.Base.Attributes (AttrOp, AttrOpTag(..))+import Data.GI.Base.BasicTypes (GObject)+import Data.GI.Base.GObject (constructGObject)++-- | Constructible types, i.e. those which can be allocated by `new`.+class Constructible a (tag :: AttrOpTag) where+    new :: MonadIO m => (ForeignPtr a -> a) -> [AttrOp a tag] -> m a++-- | Default instance, assuming we have a `GObject`.+instance+#if MIN_VERSION_base(4,8,0)+    {-# OVERLAPPABLE #-}+#endif+    (GObject a, tag ~ 'AttrConstruct) => Constructible a tag where+        new = constructGObject

@@ -0,0 +1,78 @@+{-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies #-}++module Data.GI.Base.GObject+    ( constructGObject+    ) where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Proxy (Proxy(..))+import Foreign.C (CUInt(..), CString, newCString)+import Foreign++import Data.GI.Base.Attributes (AttrOp(..), AttrOpTag(..), AttrLabelProxy,+                                attrConstruct)+import Data.GI.Base.BasicTypes (GType(..), GObject(..))+import Data.GI.Base.GValue (GValue(..))+import Data.GI.Base.ManagedPtr (withManagedPtr, touchManagedPtr, wrapObject)+import Data.GI.Base.Overloading (ResolveAttribute)++#include <glib-object.h>++foreign import ccall "dbg_g_object_newv" g_object_newv ::+    GType -> CUInt -> Ptr a -> IO (Ptr b)++-- | Construct a GObject given the constructor and a list of settable+-- attributes.+constructGObject :: forall o m. (GObject o, MonadIO m)+    => (ForeignPtr o -> o)+    -> [AttrOp o 'AttrConstruct]+    -> m o+constructGObject constructor attrs = liftIO $ do+  props <- mapM construct attrs+  let nprops = length props+  params <- mallocBytes (nprops*gparameterSize)+  fill params props+  gtype <- gobjectType (undefined :: o)+  result <- g_object_newv gtype (fromIntegral nprops) params+  freeStrings nprops params+  free params+  -- Make sure that the GValues defining the GProperties are still+  -- alive at this point (so, in particular, they are still alive when+  -- g_object_newv is called). Without this the GHC garbage collector+  -- may free the GValues before g_object_newv us called, which will+  -- unref the referred to objects, which may drop the last reference+  -- to the contained objects. g_object_newv then tries to access the+  -- (now invalid) contents of the GValue, and mayhem ensues.+  mapM_ (touchManagedPtr . snd) props+  wrapObject constructor (result :: Ptr o)+  where+    resolve :: AttrLabelProxy attr -> Proxy (ResolveAttribute attr o)+    resolve _ = Proxy++    construct :: AttrOp o 'AttrConstruct ->+                 IO (String, GValue)+    construct (attr := x) = attrConstruct (resolve attr) x+    construct (attr :=> x) = x >>= attrConstruct (resolve attr)++    gvalueSize = #size GValue+    gparameterSize = #size GParameter++    -- Fill the given memory address with the contents of the array of+    -- GParameters.+    fill :: Ptr () -> [(String, GValue)] -> IO ()+    fill _ [] = return ()+    fill dataPtr ((str, gvalue):xs) =+        do cstr <- newCString str+           poke (castPtr dataPtr) cstr+           withManagedPtr gvalue $ \gvalueptr ->+               copyBytes (dataPtr `plusPtr` sizeOf nullPtr) gvalueptr gvalueSize+           fill (dataPtr `plusPtr` gparameterSize) xs++    -- Free the strings in the GParameter array (the GValues will be+    -- freed separately).+    freeStrings :: Int -> Ptr () -> IO ()+    freeStrings 0 _ = return ()+    freeStrings n dataPtr =+        do cstr <- peek (castPtr dataPtr) :: IO CString+           free cstr+           freeStrings (n-1) (dataPtr `plusPtr` gparameterSize)

@@ -12,6 +12,14 @@     , get_string     , set_pointer     , get_pointer+    , set_int+    , get_int+    , set_uint+    , get_uint+    , set_long+    , get_long+    , set_ulong+    , get_ulong     , set_int32     , get_int32     , set_uint32@@ -45,15 +53,16 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif-import Control.Monad ((>=>)) +import Data.Coerce (coerce) import Data.Word import Data.Int import Data.Text (Text, pack, unpack) -import Foreign.C.Types (CInt(..), CUInt(..), CFloat(..), CDouble(..))+import Foreign.C.Types (CInt(..), CUInt(..), CFloat(..), CDouble(..),+                        CLong(..), CULong(..)) import Foreign.C.String (CString)-import Foreign.Ptr (Ptr)+import Foreign.Ptr (Ptr, nullPtr) import Foreign.ForeignPtr (ForeignPtr)  import Data.GI.Base.BasicTypes@@ -93,11 +102,11 @@     toGValue :: a -> IO GValue     fromGValue :: GValue -> IO a -instance IsGValue String where-    toGValue = buildGValue gtypeString set_string . pack-    fromGValue v = unpack <$> get_string v+instance IsGValue (Maybe String) where+    toGValue = buildGValue gtypeString set_string . fmap pack+    fromGValue v = (fmap unpack) <$> get_string v -instance IsGValue Text where+instance IsGValue (Maybe Text) where     toGValue = buildGValue gtypeString set_string     fromGValue = get_string @@ -106,13 +115,29 @@     fromGValue = get_pointer  instance IsGValue Int32 where-    toGValue = buildGValue gtypeInt32 set_int32+    toGValue = buildGValue gtypeInt set_int32     fromGValue = get_int32  instance IsGValue Word32 where-    toGValue = buildGValue gtypeUInt32 set_uint32+    toGValue = buildGValue gtypeUInt set_uint32     fromGValue = get_uint32 +instance IsGValue CInt where+    toGValue = buildGValue gtypeInt set_int+    fromGValue = get_int++instance IsGValue CUInt where+    toGValue = buildGValue gtypeUInt set_uint+    fromGValue = get_uint++instance IsGValue CLong where+    toGValue = buildGValue gtypeLong set_long+    fromGValue = get_long++instance IsGValue CULong where+    toGValue = buildGValue gtypeULong set_ulong+    fromGValue = get_ulong+ instance IsGValue Int64 where     toGValue = buildGValue gtypeInt64 set_int64     fromGValue = get_int64@@ -142,14 +167,21 @@ foreign import ccall "g_value_get_string" _get_string ::     Ptr GValue -> IO CString -set_string :: GValue -> Text -> IO ()-set_string gv str = withManagedPtr gv $ \ptr -> do-                      cstr <- textToCString str-                      _set_string ptr cstr-                      freeMem cstr+set_string :: GValue -> Maybe Text -> IO ()+set_string gv maybeStr =+    withManagedPtr gv $ \ptr -> do+      cstr <- case maybeStr of+                Just str -> textToCString str+                Nothing -> return nullPtr+      _set_string ptr cstr+      freeMem cstr -get_string :: GValue -> IO Text-get_string gv = withManagedPtr gv $ _get_string >=> cstringToText+get_string :: GValue -> IO (Maybe Text)+get_string gv = withManagedPtr gv $ \gvptr -> do+                  cstr <- _get_string gvptr+                  if cstr /= nullPtr+                  then Just <$> cstringToText cstr+                  else return Nothing  foreign import ccall unsafe "g_value_set_pointer" _set_pointer ::     Ptr GValue -> Ptr a -> IO ()@@ -162,27 +194,61 @@ get_pointer :: GValue -> IO (Ptr b) get_pointer gv = withManagedPtr gv _get_pointer -foreign import ccall unsafe "g_value_set_int" _set_int32 ::-    Ptr GValue -> Int32 -> IO ()-foreign import ccall unsafe "g_value_get_int" _get_int32 ::-    Ptr GValue -> IO Int32+foreign import ccall unsafe "g_value_set_int" _set_int ::+    Ptr GValue -> CInt -> IO ()+foreign import ccall unsafe "g_value_get_int" _get_int ::+    Ptr GValue -> IO CInt  set_int32 :: GValue -> Int32 -> IO ()-set_int32 gv n = withManagedPtr gv $ flip _set_int32 n+set_int32 gv n = withManagedPtr gv $ flip _set_int (coerce n)  get_int32 :: GValue -> IO Int32-get_int32 gv = withManagedPtr gv _get_int32+get_int32 gv = coerce <$> withManagedPtr gv _get_int -foreign import ccall unsafe "g_value_set_uint" _set_uint32 ::-    Ptr GValue -> Word32 -> IO ()-foreign import ccall unsafe "g_value_get_uint" _get_uint32 ::-    Ptr GValue -> IO Word32+set_int :: GValue -> CInt -> IO ()+set_int gv n = withManagedPtr gv $ flip _set_int n +get_int :: GValue -> IO CInt+get_int gv = withManagedPtr gv _get_int++foreign import ccall unsafe "g_value_set_uint" _set_uint ::+    Ptr GValue -> CUInt -> IO ()+foreign import ccall unsafe "g_value_get_uint" _get_uint ::+    Ptr GValue -> IO CUInt+ set_uint32 :: GValue -> Word32 -> IO ()-set_uint32 gv n = withManagedPtr gv $ flip _set_uint32 n+set_uint32 gv n = withManagedPtr gv $ flip _set_uint (coerce n)  get_uint32 :: GValue -> IO Word32-get_uint32 gv = withManagedPtr gv _get_uint32+get_uint32 gv = coerce <$> withManagedPtr gv _get_uint++set_uint :: GValue -> CUInt -> IO ()+set_uint gv n = withManagedPtr gv $ flip _set_uint n++get_uint :: GValue -> IO CUInt+get_uint gv = withManagedPtr gv _get_uint++foreign import ccall unsafe "g_value_set_long" _set_long ::+    Ptr GValue -> CLong -> IO ()+foreign import ccall unsafe "g_value_get_long" _get_long ::+    Ptr GValue -> IO CLong++set_long :: GValue -> CLong -> IO ()+set_long gv n = withManagedPtr gv $ flip _set_long n++get_long :: GValue -> IO CLong+get_long gv = withManagedPtr gv _get_long++foreign import ccall unsafe "g_value_set_ulong" _set_ulong ::+    Ptr GValue -> CULong -> IO ()+foreign import ccall unsafe "g_value_get_ulong" _get_ulong ::+    Ptr GValue -> IO CULong++set_ulong :: GValue -> CULong -> IO ()+set_ulong gv n = withManagedPtr gv $ flip _set_ulong n++get_ulong :: GValue -> IO CULong+get_ulong gv = withManagedPtr gv _get_ulong  foreign import ccall unsafe "g_value_set_int64" _set_int64 ::     Ptr GValue -> Int64 -> IO ()

@@ -10,8 +10,10 @@ -- module deal with the memory management of such managed pointers.  module Data.GI.Base.ManagedPtr-    ( -- * Managed pointers+    (+    -- * Managed pointers       withManagedPtr+    , maybeWithManagedPtr     , withManagedPtrList     , unsafeManagedPtrGetPtr     , unsafeManagedPtrCastPtr@@ -44,7 +46,7 @@  import Foreign (poke) import Foreign.C (CInt(..))-import Foreign.Ptr (Ptr, FunPtr, castPtr)+import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr) import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, newForeignPtrEnv, touchForeignPtr) import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) @@ -54,6 +56,17 @@ -- | Perform an IO action on the 'Ptr' inside a managed pointer. withManagedPtr :: ForeignPtrNewtype a => a -> (Ptr a -> IO c) -> IO c withManagedPtr managed action = do+  let ptr = unsafeManagedPtrGetPtr managed+  result <- action ptr+  touchManagedPtr managed+  return result++-- | Like `withManagedPtr`, but accepts a `Maybe` type. If the passed+-- value is `Nothing` the inner action will be executed with a+-- `nullPtr` argument.+maybeWithManagedPtr :: ForeignPtrNewtype a => Maybe a -> (Ptr a -> IO c) -> IO c+maybeWithManagedPtr Nothing action = action nullPtr+maybeWithManagedPtr (Just managed) action = do   let ptr = unsafeManagedPtrGetPtr managed   result <- action ptr   touchManagedPtr managed

@@ -1,16 +1,15 @@-{-# LANGUAGE ScopedTypeVariables, GADTs, DataKinds, KindSignatures,-FlexibleInstances, MultiParamTypeClasses, TypeFamilies, PolyKinds,-EmptyDataDecls, ConstraintKinds #-}-{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Data.GI.Base.Properties-    ( new--    , setObjectPropertyString+    ( setObjectPropertyString     , setObjectPropertyStringArray     , setObjectPropertyPtr-    , setObjectPropertyCInt-    , setObjectPropertyCUInt+    , setObjectPropertyInt+    , setObjectPropertyUInt+    , setObjectPropertyLong+    , setObjectPropertyULong+    , setObjectPropertyInt32+    , setObjectPropertyUInt32     , setObjectPropertyInt64     , setObjectPropertyUInt64     , setObjectPropertyFloat@@ -29,8 +28,12 @@     , getObjectPropertyString     , getObjectPropertyStringArray     , getObjectPropertyPtr-    , getObjectPropertyCInt-    , getObjectPropertyCUInt+    , getObjectPropertyInt+    , getObjectPropertyUInt+    , getObjectPropertyLong+    , getObjectPropertyULong+    , getObjectPropertyInt32+    , getObjectPropertyUInt32     , getObjectPropertyInt64     , getObjectPropertyUInt64     , getObjectPropertyFloat@@ -49,8 +52,12 @@     , constructObjectPropertyString     , constructObjectPropertyStringArray     , constructObjectPropertyPtr-    , constructObjectPropertyCInt-    , constructObjectPropertyCUInt+    , constructObjectPropertyInt+    , constructObjectPropertyUInt+    , constructObjectPropertyLong+    , constructObjectPropertyULong+    , constructObjectPropertyInt32+    , constructObjectPropertyUInt32     , constructObjectPropertyInt64     , constructObjectPropertyUInt64     , constructObjectPropertyFloat@@ -71,7 +78,6 @@ import Control.Applicative ((<$>)) #endif import Control.Monad ((>=>))-import Control.Monad.IO.Class (MonadIO, liftIO)  import qualified Data.ByteString.Char8 as B import Data.Text (Text)@@ -80,76 +86,16 @@ import Data.GI.Base.BasicTypes import Data.GI.Base.BasicConversions import Data.GI.Base.ManagedPtr-import Data.GI.Base.Attributes import Data.GI.Base.GValue import Data.GI.Base.GVariant (newGVariantFromPtr)-import Data.GI.Base.Overloading (ResolveAttribute)+import Data.GI.Base.Utils (freeMem, convertIfNonNull) -import Foreign hiding (new)-import Foreign.C+import Foreign (Ptr, ForeignPtr, Int32, Word32, Int64, Word64, nullPtr)+import Foreign.C (CString, withCString)+import Foreign.C.Types (CInt, CUInt, CLong, CULong)  #include <glib-object.h> -foreign import ccall "dbg_g_object_newv" g_object_newv ::-    GType -> CUInt -> Ptr a -> IO (Ptr b)---- | Construct a GObject given the constructor and a list of settable--- attributes. AttrOps are always constructible, so we don't need to--- enforce constraints here.-new :: forall o m. (GObject o, MonadIO m)-    => (ForeignPtr o -> o)-    -> [AttrOp o 'AttrConstruct]-    -> m o-new constructor attrs = liftIO $ do-  props <- mapM construct attrs-  let nprops = length props-  params <- mallocBytes (nprops*gparameterSize)-  fill params props-  gtype <- gobjectType (undefined :: o)-  result <- g_object_newv gtype (fromIntegral nprops) params-  freeStrings nprops params-  free params-  -- Make sure that the GValues defining the GProperties are still-  -- alive at this point (so, in particular, they are still alive when-  -- g_object_newv is called). Without this the GHC garbage collector-  -- may free the GValues before g_object_newv us called, which will-  -- unref the referred to objects, which may drop the last reference-  -- to the contained objects. g_object_newv then tries to access the-  -- (now invalid) contents of the GValue, and mayhem ensues.-  mapM_ (touchManagedPtr . snd) props-  wrapObject constructor (result :: Ptr o)-  where-    resolve :: AttrLabelProxy attr -> Proxy (ResolveAttribute attr o)-    resolve _ = Proxy--    construct :: AttrOp o 'AttrConstruct ->-                 IO (String, GValue)-    construct (attr := x) = attrConstruct (resolve attr) x-    construct (attr :=> x) = x >>= attrConstruct (resolve attr)--    gvalueSize = #size GValue-    gparameterSize = #size GParameter--    -- Fill the given memory address with the contents of the array of-    -- GParameters.-    fill :: Ptr () -> [(String, GValue)] -> IO ()-    fill _ [] = return ()-    fill dataPtr ((str, gvalue):xs) =-        do cstr <- newCString str-           poke (castPtr dataPtr) cstr-           withManagedPtr gvalue $ \gvalueptr ->-               copyBytes (dataPtr `plusPtr` sizeOf nullPtr) gvalueptr gvalueSize-           fill (dataPtr `plusPtr` gparameterSize) xs--    -- Free the strings in the GParameter array (the GValues will be-    -- freed separately).-    freeStrings :: Int -> Ptr () -> IO ()-    freeStrings 0 _ = return ()-    freeStrings n dataPtr =-        do cstr <- peek (castPtr dataPtr) :: IO CString-           free cstr-           freeStrings (n-1) (dataPtr `plusPtr` gparameterSize)- foreign import ccall "g_object_set_property" g_object_set_property ::     Ptr a -> CString -> Ptr GValue -> IO () @@ -182,213 +128,275 @@   return (propName, gvalue)  setObjectPropertyString :: GObject a =>-                           a -> String -> Text -> IO ()+                           a -> String -> Maybe Text -> IO () setObjectPropertyString obj propName str =-    setObjectProperty obj propName str set_string (GType #const G_TYPE_STRING)+    setObjectProperty obj propName str set_string gtypeString -constructObjectPropertyString :: String -> Text ->+constructObjectPropertyString :: String -> Maybe Text ->                                  IO (String, GValue) constructObjectPropertyString propName str =-    constructObjectProperty propName str set_string (GType #const G_TYPE_STRING)+    constructObjectProperty propName str set_string gtypeString  getObjectPropertyString :: GObject a =>-                           a -> String -> IO Text+                           a -> String -> IO (Maybe Text) getObjectPropertyString obj propName =-    getObjectProperty obj propName get_string (GType #const G_TYPE_STRING)+    getObjectProperty obj propName get_string gtypeString  setObjectPropertyPtr :: GObject a =>                         a -> String -> Ptr b -> IO () setObjectPropertyPtr obj propName ptr =-    setObjectProperty obj propName ptr set_pointer (GType #const G_TYPE_POINTER)+    setObjectProperty obj propName ptr set_pointer gtypePointer  constructObjectPropertyPtr :: String -> Ptr b ->                               IO (String, GValue) constructObjectPropertyPtr propName ptr =-    constructObjectProperty propName ptr set_pointer (GType #const G_TYPE_POINTER)+    constructObjectProperty propName ptr set_pointer gtypePointer  getObjectPropertyPtr :: GObject a =>                         a -> String -> IO (Ptr b) getObjectPropertyPtr obj propName =-    getObjectProperty obj propName get_pointer (GType #const G_TYPE_POINTER)+    getObjectProperty obj propName get_pointer gtypePointer -setObjectPropertyCInt :: GObject a =>-                         a -> String -> Int32 -> IO ()-setObjectPropertyCInt obj propName int =-    setObjectProperty obj propName int set_int32 (GType #const G_TYPE_INT)+setObjectPropertyInt :: GObject a =>+                         a -> String -> CInt -> IO ()+setObjectPropertyInt obj propName int =+    setObjectProperty obj propName int set_int gtypeInt -constructObjectPropertyCInt :: String -> Int32 ->+constructObjectPropertyInt :: String -> CInt ->+                              IO (String, GValue)+constructObjectPropertyInt propName int =+    constructObjectProperty propName int set_int gtypeInt++getObjectPropertyInt :: GObject a => a -> String -> IO CInt+getObjectPropertyInt obj propName =+    getObjectProperty obj propName get_int gtypeInt++setObjectPropertyUInt :: GObject a =>+                          a -> String -> CUInt -> IO ()+setObjectPropertyUInt obj propName uint =+    setObjectProperty obj propName uint set_uint gtypeUInt++constructObjectPropertyUInt :: String -> CUInt ->                                 IO (String, GValue)-constructObjectPropertyCInt propName int =-    constructObjectProperty propName int set_int32 (GType #const G_TYPE_INT)+constructObjectPropertyUInt propName uint =+    constructObjectProperty propName uint set_uint gtypeUInt -getObjectPropertyCInt :: GObject a => a -> String -> IO Int32-getObjectPropertyCInt obj propName =-    getObjectProperty obj propName get_int32 (GType #const G_TYPE_INT)+getObjectPropertyUInt :: GObject a => a -> String -> IO CUInt+getObjectPropertyUInt obj propName =+    getObjectProperty obj propName get_uint gtypeUInt -setObjectPropertyCUInt :: GObject a =>-                          a -> String -> Word32 -> IO ()-setObjectPropertyCUInt obj propName uint =-    setObjectProperty obj propName uint set_uint32 (GType #const G_TYPE_UINT)+setObjectPropertyLong :: GObject a =>+                         a -> String -> CLong -> IO ()+setObjectPropertyLong obj propName int =+    setObjectProperty obj propName int set_long gtypeLong -constructObjectPropertyCUInt :: String -> Word32 ->+constructObjectPropertyLong :: String -> CLong ->+                               IO (String, GValue)+constructObjectPropertyLong propName int =+    constructObjectProperty propName int set_long gtypeLong++getObjectPropertyLong :: GObject a => a -> String -> IO CLong+getObjectPropertyLong obj propName =+    getObjectProperty obj propName get_long gtypeLong++setObjectPropertyULong :: GObject a =>+                          a -> String -> CULong -> IO ()+setObjectPropertyULong obj propName uint =+    setObjectProperty obj propName uint set_ulong gtypeULong++constructObjectPropertyULong :: String -> CULong ->                                 IO (String, GValue)-constructObjectPropertyCUInt propName uint =-    constructObjectProperty propName uint set_uint32 (GType #const G_TYPE_UINT)+constructObjectPropertyULong propName uint =+    constructObjectProperty propName uint set_ulong gtypeULong -getObjectPropertyCUInt :: GObject a => a -> String -> IO Word32-getObjectPropertyCUInt obj propName =-    getObjectProperty obj propName get_uint32 (GType #const G_TYPE_UINT)+getObjectPropertyULong :: GObject a => a -> String -> IO CULong+getObjectPropertyULong obj propName =+    getObjectProperty obj propName get_ulong gtypeULong +setObjectPropertyInt32 :: GObject a =>+                          a -> String -> Int32 -> IO ()+setObjectPropertyInt32 obj propName int32 =+    setObjectProperty obj propName int32 set_int32 gtypeInt++constructObjectPropertyInt32 :: String -> Int32 ->+                                IO (String, GValue)+constructObjectPropertyInt32 propName int32 =+    constructObjectProperty propName int32 set_int32 gtypeInt++getObjectPropertyInt32 :: GObject a => a -> String -> IO Int32+getObjectPropertyInt32 obj propName =+    getObjectProperty obj propName get_int32 gtypeInt++setObjectPropertyUInt32 :: GObject a =>+                          a -> String -> Word32 -> IO ()+setObjectPropertyUInt32 obj propName uint32 =+    setObjectProperty obj propName uint32 set_uint32 gtypeUInt++constructObjectPropertyUInt32 :: String -> Word32 ->+                                 IO (String, GValue)+constructObjectPropertyUInt32 propName uint32 =+    constructObjectProperty propName uint32 set_uint32 gtypeUInt++getObjectPropertyUInt32 :: GObject a => a -> String -> IO Word32+getObjectPropertyUInt32 obj propName =+    getObjectProperty obj propName get_uint32 gtypeUInt+ setObjectPropertyInt64 :: GObject a =>                           a -> String -> Int64 -> IO () setObjectPropertyInt64 obj propName int64 =-    setObjectProperty obj propName int64 set_int64 (GType #const G_TYPE_INT64)+    setObjectProperty obj propName int64 set_int64 gtypeInt64  constructObjectPropertyInt64 :: String -> Int64 ->                                 IO (String, GValue) constructObjectPropertyInt64 propName int64 =-    constructObjectProperty propName int64 set_int64 (GType #const G_TYPE_INT64)+    constructObjectProperty propName int64 set_int64 gtypeInt64  getObjectPropertyInt64 :: GObject a => a -> String -> IO Int64 getObjectPropertyInt64 obj propName =-    getObjectProperty obj propName get_int64 (GType #const G_TYPE_INT64)+    getObjectProperty obj propName get_int64 gtypeInt64  setObjectPropertyUInt64 :: GObject a =>                           a -> String -> Word64 -> IO () setObjectPropertyUInt64 obj propName uint64 =-    setObjectProperty obj propName uint64 set_uint64 (GType #const G_TYPE_UINT64)+    setObjectProperty obj propName uint64 set_uint64 gtypeUInt64  constructObjectPropertyUInt64 :: String -> Word64 ->                                  IO (String, GValue) constructObjectPropertyUInt64 propName uint64 =-    constructObjectProperty propName uint64 set_uint64 (GType #const G_TYPE_UINT64)+    constructObjectProperty propName uint64 set_uint64 gtypeUInt64  getObjectPropertyUInt64 :: GObject a => a -> String -> IO Word64 getObjectPropertyUInt64 obj propName =-    getObjectProperty obj propName get_uint64 (GType #const G_TYPE_UINT64)+    getObjectProperty obj propName get_uint64 gtypeUInt64  setObjectPropertyFloat :: GObject a =>                            a -> String -> Float -> IO () setObjectPropertyFloat obj propName float =-    setObjectProperty obj propName float set_float (GType #const G_TYPE_FLOAT)+    setObjectProperty obj propName float set_float gtypeFloat  constructObjectPropertyFloat :: String -> Float ->                                  IO (String, GValue) constructObjectPropertyFloat propName float =-    constructObjectProperty propName float set_float (GType #const G_TYPE_FLOAT)+    constructObjectProperty propName float set_float gtypeFloat  getObjectPropertyFloat :: GObject a =>                            a -> String -> IO Float getObjectPropertyFloat obj propName =-    getObjectProperty obj propName get_float (GType #const G_TYPE_FLOAT)+    getObjectProperty obj propName get_float gtypeFloat  setObjectPropertyDouble :: GObject a =>                             a -> String -> Double -> IO () setObjectPropertyDouble obj propName double =-    setObjectProperty obj propName double set_double (GType #const G_TYPE_DOUBLE)+    setObjectProperty obj propName double set_double gtypeDouble  constructObjectPropertyDouble :: String -> Double ->                                   IO (String, GValue) constructObjectPropertyDouble propName double =-    constructObjectProperty propName double set_double (GType #const G_TYPE_DOUBLE)+    constructObjectProperty propName double set_double gtypeDouble  getObjectPropertyDouble :: GObject a =>                             a -> String -> IO Double getObjectPropertyDouble obj propName =-    getObjectProperty obj propName get_double (GType #const G_TYPE_DOUBLE)+    getObjectProperty obj propName get_double gtypeDouble  setObjectPropertyBool :: GObject a =>                          a -> String -> Bool -> IO () setObjectPropertyBool obj propName bool =-    setObjectProperty obj propName bool set_boolean (GType #const G_TYPE_BOOLEAN)+    setObjectProperty obj propName bool set_boolean gtypeBoolean  constructObjectPropertyBool :: String -> Bool -> IO (String, GValue) constructObjectPropertyBool propName bool =-    constructObjectProperty propName bool set_boolean (GType #const G_TYPE_BOOLEAN)+    constructObjectProperty propName bool set_boolean gtypeBoolean  getObjectPropertyBool :: GObject a => a -> String -> IO Bool getObjectPropertyBool obj propName =-    getObjectProperty obj propName get_boolean (GType #const G_TYPE_BOOLEAN)+    getObjectProperty obj propName get_boolean gtypeBoolean  setObjectPropertyGType :: GObject a =>                          a -> String -> GType -> IO () setObjectPropertyGType obj propName gtype =-    setObjectProperty obj propName gtype set_gtype (GType #const G_TYPE_GTYPE)+    setObjectProperty obj propName gtype set_gtype gtypeGType  constructObjectPropertyGType :: String -> GType -> IO (String, GValue) constructObjectPropertyGType propName bool =-    constructObjectProperty propName bool set_gtype (GType #const G_TYPE_GTYPE)+    constructObjectProperty propName bool set_gtype gtypeGType  getObjectPropertyGType :: GObject a => a -> String -> IO GType getObjectPropertyGType obj propName =-    getObjectProperty obj propName get_gtype (GType #const G_TYPE_GTYPE)+    getObjectProperty obj propName get_gtype gtypeGType -setObjectPropertyObject :: (GObject a, GObject b) =>-                           a -> String -> b -> IO ()-setObjectPropertyObject obj propName object = do-  gtype <- gobjectType object-  withManagedPtr object $ \objectPtr ->+setObjectPropertyObject :: forall a b. (GObject a, GObject b) =>+                           a -> String -> Maybe b -> IO ()+setObjectPropertyObject obj propName maybeObject = do+  gtype <- gobjectType (undefined :: b)+  maybeWithManagedPtr maybeObject $ \objectPtr ->       setObjectProperty obj propName objectPtr set_object gtype -constructObjectPropertyObject :: GObject a =>-                                 String -> a -> IO (String, GValue)-constructObjectPropertyObject propName object = do-  gtype <- gobjectType object-  withManagedPtr object $ \objectPtr ->+constructObjectPropertyObject :: forall a. GObject a =>+                                 String -> Maybe a -> IO (String, GValue)+constructObjectPropertyObject propName maybeObject = do+  gtype <- gobjectType (undefined :: a)+  maybeWithManagedPtr maybeObject $ \objectPtr ->       constructObjectProperty propName objectPtr set_object gtype  getObjectPropertyObject :: forall a b. (GObject a, GObject b) =>-                           a -> String -> (ForeignPtr b -> b) -> IO b+                           a -> String -> (ForeignPtr b -> b) -> IO (Maybe b) getObjectPropertyObject obj propName constructor = do   gtype <- gobjectType (undefined :: b)   getObjectProperty obj propName                         (\val -> (get_object val :: IO (Ptr b))-                                 >>= newObject constructor)+                            >>= flip convertIfNonNull (newObject constructor))                       gtype -setObjectPropertyBoxed :: (GObject a, BoxedObject b) =>-                          a -> String -> b -> IO ()-setObjectPropertyBoxed obj propName boxed = do-  gtype <- boxedType boxed-  withManagedPtr boxed $ \boxedPtr ->+setObjectPropertyBoxed :: forall a b. (GObject a, BoxedObject b) =>+                          a -> String -> Maybe b -> IO ()+setObjectPropertyBoxed obj propName maybeBoxed = do+  gtype <- boxedType (undefined :: b)+  maybeWithManagedPtr maybeBoxed $ \boxedPtr ->         setObjectProperty obj propName boxedPtr set_boxed gtype -constructObjectPropertyBoxed :: (BoxedObject a) => String -> a ->-                                IO (String, GValue)-constructObjectPropertyBoxed propName boxed = do-  gtype <- boxedType boxed-  withManagedPtr boxed $ \boxedPtr ->+constructObjectPropertyBoxed :: forall a. (BoxedObject a) =>+                                String -> Maybe a -> IO (String, GValue)+constructObjectPropertyBoxed propName maybeBoxed = do+  gtype <- boxedType (undefined :: a)+  maybeWithManagedPtr maybeBoxed $ \boxedPtr ->       constructObjectProperty propName boxedPtr set_boxed gtype  getObjectPropertyBoxed :: forall a b. (GObject a, BoxedObject b) =>-                          a -> String -> (ForeignPtr b -> b) -> IO b+                          a -> String -> (ForeignPtr b -> b) -> IO (Maybe b) getObjectPropertyBoxed obj propName constructor = do   gtype <- boxedType (undefined :: b)-  getObjectProperty obj propName (get_boxed >=> newBoxed constructor) gtype+  getObjectProperty obj propName (get_boxed >=>+                                  flip convertIfNonNull (newBoxed constructor))+                    gtype  setObjectPropertyStringArray :: GObject a =>-                                a -> String -> [Text] -> IO ()-setObjectPropertyStringArray obj propName strv = do+                                a -> String -> Maybe [Text] -> IO ()+setObjectPropertyStringArray obj propName Nothing =+  setObjectProperty obj propName nullPtr set_boxed gtypeStrv+setObjectPropertyStringArray obj propName (Just strv) = do   cStrv <- packZeroTerminatedUTF8CArray strv-  setObjectProperty obj propName cStrv set_boxed (GType #const G_TYPE_STRV)-  mapZeroTerminatedCArray free cStrv-  free cStrv+  setObjectProperty obj propName cStrv set_boxed gtypeStrv+  mapZeroTerminatedCArray freeMem cStrv+  freeMem cStrv -constructObjectPropertyStringArray :: String -> [Text] ->+constructObjectPropertyStringArray :: String -> Maybe [Text] ->                                       IO (String, GValue)-constructObjectPropertyStringArray propName strv = do+constructObjectPropertyStringArray propName Nothing =+  constructObjectProperty propName nullPtr set_boxed gtypeStrv+constructObjectPropertyStringArray propName (Just strv) = do   cStrv <- packZeroTerminatedUTF8CArray strv-  result <- constructObjectProperty propName cStrv set_boxed (GType #const G_TYPE_STRV)-  mapZeroTerminatedCArray free cStrv-  free cStrv+  result <- constructObjectProperty propName cStrv set_boxed gtypeStrv+  mapZeroTerminatedCArray freeMem cStrv+  freeMem cStrv   return result -getObjectPropertyStringArray :: GObject a =>-                                a -> String -> IO [Text]+getObjectPropertyStringArray :: GObject a => a -> String -> IO (Maybe [Text]) getObjectPropertyStringArray obj propName =     getObjectProperty obj propName-                      (get_boxed >=> unpackZeroTerminatedUTF8CArray . castPtr)-                      (GType #const G_TYPE_STRV)+                      (get_boxed >=>+                       flip convertIfNonNull unpackZeroTerminatedUTF8CArray)+                      gtypeStrv  setObjectPropertyEnum :: (GObject a, Enum b, BoxedEnum b) =>                          a -> String -> b -> IO ()@@ -413,87 +421,92 @@                     (\val -> toEnum . fromIntegral <$> get_enum val)                     gtype -setObjectPropertyFlags :: (IsGFlag b, GObject a) =>+setObjectPropertyFlags :: forall a b. (IsGFlag b, BoxedFlags b, GObject a) =>                           a -> String -> [b] -> IO ()-setObjectPropertyFlags obj propName flags =-    let cFlags = gflagsToWord flags-    in setObjectProperty obj propName cFlags set_flags (GType #const G_TYPE_FLAGS)+setObjectPropertyFlags obj propName flags = do+  let cFlags = gflagsToWord flags+  gtype <- boxedFlagsType (Proxy :: Proxy b)+  setObjectProperty obj propName cFlags set_flags gtype -constructObjectPropertyFlags :: IsGFlag a => String -> [a] ->-                                IO (String, GValue)-constructObjectPropertyFlags propName flags =-    let cFlags = gflagsToWord flags-    in constructObjectProperty propName cFlags set_flags (GType #const G_TYPE_FLAGS)+constructObjectPropertyFlags :: forall a. (IsGFlag a, BoxedFlags a)+                                => String -> [a] -> IO (String, GValue)+constructObjectPropertyFlags propName flags = do+  let cFlags = gflagsToWord flags+  gtype <- boxedFlagsType (Proxy :: Proxy a)+  constructObjectProperty propName cFlags set_flags gtype -getObjectPropertyFlags :: (GObject a, IsGFlag b) =>+getObjectPropertyFlags :: forall a b. (GObject a, IsGFlag b, BoxedFlags b) =>                           a -> String -> IO [b]-getObjectPropertyFlags obj propName =-    getObjectProperty obj propName-                          (\val -> wordToGFlags <$> get_flags val)-                          (GType #const G_TYPE_FLAGS)+getObjectPropertyFlags obj propName = do+  gtype <- boxedFlagsType (Proxy :: Proxy b)+  getObjectProperty obj propName+                        (\val -> wordToGFlags <$> get_flags val)+                        gtype  setObjectPropertyVariant :: GObject a =>-                            a -> String -> GVariant -> IO ()-setObjectPropertyVariant obj propName variant =-    withManagedPtr variant $ \variantPtr ->-        setObjectProperty obj propName variantPtr set_variant-                              (GType #const G_TYPE_VARIANT)+                            a -> String -> Maybe GVariant -> IO ()+setObjectPropertyVariant obj propName maybeVariant =+    maybeWithManagedPtr maybeVariant $ \variantPtr ->+        setObjectProperty obj propName variantPtr set_variant gtypeVariant -constructObjectPropertyVariant :: String -> GVariant -> IO (String, GValue)-constructObjectPropertyVariant propName obj =-    withManagedPtr obj $ \objPtr ->-        constructObjectProperty propName objPtr set_variant-                                    (GType #const G_TYPE_VARIANT)+constructObjectPropertyVariant :: String -> Maybe GVariant+                               -> IO (String, GValue)+constructObjectPropertyVariant propName maybeVariant =+    maybeWithManagedPtr maybeVariant $ \objPtr ->+        constructObjectProperty propName objPtr set_variant gtypeVariant  getObjectPropertyVariant :: GObject a => a -> String ->-                            IO GVariant+                            IO (Maybe GVariant) getObjectPropertyVariant obj propName =-    getObjectProperty obj propName (get_variant >=> newGVariantFromPtr)-                      (GType #const G_TYPE_VARIANT)+    getObjectProperty obj propName (get_variant >=>+                                    flip convertIfNonNull newGVariantFromPtr)+                      gtypeVariant  setObjectPropertyByteArray :: GObject a =>-                              a -> String -> B.ByteString -> IO ()-setObjectPropertyByteArray obj propName bytes = do+                              a -> String -> Maybe B.ByteString -> IO ()+setObjectPropertyByteArray obj propName Nothing =+    setObjectProperty obj propName nullPtr set_boxed gtypeByteArray+setObjectPropertyByteArray obj propName (Just bytes) = do   packed <- packGByteArray bytes-  setObjectProperty obj propName packed set_boxed (GType #const G_TYPE_BYTE_ARRAY)+  setObjectProperty obj propName packed set_boxed gtypeByteArray   unrefGByteArray packed -constructObjectPropertyByteArray :: String -> B.ByteString ->+constructObjectPropertyByteArray :: String -> Maybe B.ByteString ->                                     IO (String, GValue)-constructObjectPropertyByteArray propName bytes = do+constructObjectPropertyByteArray propName Nothing =+    constructObjectProperty propName nullPtr set_boxed gtypeByteArray+constructObjectPropertyByteArray propName (Just bytes) = do   packed <- packGByteArray bytes-  result <- constructObjectProperty propName packed-            set_boxed (GType #const G_TYPE_BYTE_ARRAY)+  result <- constructObjectProperty propName packed set_boxed gtypeByteArray   unrefGByteArray packed   return result  getObjectPropertyByteArray :: GObject a =>-                              a -> String -> IO B.ByteString+                              a -> String -> IO (Maybe B.ByteString) getObjectPropertyByteArray obj propName =-    getObjectProperty obj propName (get_boxed >=> unpackGByteArray)-                      (GType #const G_TYPE_BYTE_ARRAY)+    getObjectProperty obj propName (get_boxed >=>+                                    flip convertIfNonNull unpackGByteArray)+                      gtypeByteArray  setObjectPropertyPtrGList :: GObject a =>                               a -> String -> [Ptr b] -> IO () setObjectPropertyPtrGList obj propName ptrs = do   packed <- packGList ptrs-  setObjectProperty obj propName packed set_boxed (GType #const G_TYPE_POINTER)+  setObjectProperty obj propName packed set_boxed gtypePointer   g_list_free packed  constructObjectPropertyPtrGList :: String -> [Ptr a] ->                                     IO (String, GValue) constructObjectPropertyPtrGList propName ptrs = do   packed <- packGList ptrs-  result <- constructObjectProperty propName packed-            set_boxed (GType #const G_TYPE_POINTER)+  result <- constructObjectProperty propName packed set_boxed gtypePointer   g_list_free packed   return result  getObjectPropertyPtrGList :: GObject a =>                               a -> String -> IO [Ptr b] getObjectPropertyPtrGList obj propName =-    getObjectProperty obj propName (get_pointer >=> unpackGList)-                      (GType #const G_TYPE_POINTER)+    getObjectProperty obj propName (get_pointer >=> unpackGList) gtypePointer  setObjectPropertyHash :: GObject a => a -> String -> b -> IO () setObjectPropertyHash =

@@ -1,7 +1,8 @@ -- | The Haskell Prelude exports a number of symbols that can easily -- collide with functions appearing in bindings. The generated code--- requires just a small subset of the functions in the Prelude, which--- we reexport explicitly here.+-- requires just a small subset of the functions in the Prelude,+-- together with some of the functionality in Data.GI.Base, we+-- reexport this explicitly here. module Data.GI.Base.ShortPrelude     ( module Data.Char     , module Data.Int@@ -20,9 +21,11 @@     , module Data.GI.Base.BasicTypes     , module Data.GI.Base.BasicConversions     , module Data.GI.Base.Closure+    , module Data.GI.Base.Constructible     , module Data.GI.Base.GError     , module Data.GI.Base.GHashTable     , module Data.GI.Base.GParamSpec+    , module Data.GI.Base.GObject     , module Data.GI.Base.GVariant     , module Data.GI.Base.GValue     , module Data.GI.Base.ManagedPtr@@ -66,7 +69,7 @@ import Data.Int (Int, Int8, Int16, Int32, Int64) import Data.Word (Word8, Word16, Word32, Word64) import Data.ByteString.Char8 (ByteString)-import Foreign.C (CInt(..), CUInt(..), CFloat(..), CDouble(..), CString, CIntPtr(..), CUIntPtr(..))+import Foreign.C (CInt(..), CUInt(..), CFloat(..), CDouble(..), CString, CIntPtr(..), CUIntPtr(..), CLong(..), CULong(..)) import Foreign.Ptr (Ptr, plusPtr, FunPtr, nullPtr,                     castFunPtrToPtr, castPtrToFunPtr) import Foreign.ForeignPtr (ForeignPtr, newForeignPtr_)@@ -80,14 +83,16 @@ import Data.GI.Base.BasicTypes import Data.GI.Base.BasicConversions import Data.GI.Base.Closure+import Data.GI.Base.Constructible import Data.GI.Base.GError import Data.GI.Base.GHashTable+import Data.GI.Base.GObject import Data.GI.Base.GParamSpec import Data.GI.Base.GVariant import Data.GI.Base.GValue import Data.GI.Base.ManagedPtr import Data.GI.Base.Overloading-import Data.GI.Base.Properties hiding (new)+import Data.GI.Base.Properties import Data.GI.Base.Signals (SignalConnectMode(..), connectSignalFunPtr, SignalHandlerId, SignalInfo(..), GObjectNotifySignalInfo) import Data.GI.Base.Utils 

@@ -44,10 +44,8 @@ import Data.GI.Base.Overloading (HasSignal) #endif -#include <glib-object.h>- -- | Type of a `GObject` signal handler id.-type SignalHandlerId = #type gulong+type SignalHandlerId = CULong  -- | A class that provides a constraint satisfied by every type. class NoConstraint a@@ -166,7 +164,7 @@                         SignalProxy o (i :: *) ->                         o -> GObjectNotifyCallback ->                         SignalConnectMode -> IO SignalHandlerId-connectGObjectNotify propName _ obj cb after = do+connectGObjectNotify propName _ obj cb mode = do   cb' <- mkGObjectNotifyCallback (gobjectNotifyCallbackWrapper cb)   let signalName = "notify::" ++ propName-  connectSignalFunPtr obj signalName cb' after+  connectSignalFunPtr obj signalName cb' mode

@@ -21,6 +21,7 @@     , safeFreeFunPtrPtr     , maybeReleaseFunPtr     , checkUnexpectedReturnNULL+    , checkUnexpectedNothing     ) where  #include <glib-object.h>@@ -134,7 +135,7 @@ allocMem :: forall a. Storable a => IO (Ptr a) allocMem = g_malloc $ (fromIntegral . sizeOf) (undefined :: a) --- | A wrapped for `g_free`.+-- | A wrapper for `g_free`. foreign import ccall "g_free" freeMem :: Ptr a -> IO ()  -- | Pointer to `g_free`.@@ -177,3 +178,15 @@                                      <> fnName <> "\"."                  })     | otherwise = return ()++-- | An annotated version of `fromJust`, which raises a+-- `UnexpectedNullPointerReturn` in case it encounters a `Nothing`.+checkUnexpectedNothing :: T.Text -> IO (Maybe a) -> IO a+checkUnexpectedNothing fnName action = do+  result <- action+  case result of+    Just r -> return r+    Nothing -> throwIO (UnexpectedNullPointerReturn {+                 nullPtrErrorMsg = "Received unexpected nullPtr in \""+                                     <> fnName <> "\"."+                 })

@@ -26,7 +26,7 @@   static int __print_debug_info = -1;    if (__print_debug_info == -1) {-    __print_debug_info = secure_getenv ("HASKELL_GI_DEBUG_MEM") != NULL;+    __print_debug_info = getenv ("HASKELL_GI_DEBUG_MEM") != NULL;   }    return __print_debug_info;