diff --git a/haskell-gi-base.cabal b/haskell-gi-base.cabal --- a/haskell-gi-base.cabal +++ b/haskell-gi-base.cabal @@ -1,5 +1,5 @@ name: haskell-gi-base -version: 0.17 +version: 0.18 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 @@ -30,6 +30,7 @@ Data.GI.Base.GError, Data.GI.Base.GHashTable, Data.GI.Base.GObject, + Data.GI.Base.GType, Data.GI.Base.GValue, Data.GI.Base.GVariant, Data.GI.Base.ManagedPtr, diff --git a/src/Data/GI/Base.hs b/src/Data/GI/Base.hs --- a/src/Data/GI/Base.hs +++ b/src/Data/GI/Base.hs @@ -12,6 +12,7 @@ , module Data.GI.Base.Constructible , module Data.GI.Base.GError , module Data.GI.Base.GHashTable + , module Data.GI.Base.GObject , module Data.GI.Base.GValue , module Data.GI.Base.GVariant , module Data.GI.Base.ManagedPtr @@ -25,6 +26,7 @@ import Data.GI.Base.Constructible (new) import Data.GI.Base.GError import Data.GI.Base.GHashTable +import Data.GI.Base.GObject (new') import Data.GI.Base.GValue (GValue(..), IsGValue(..)) import Data.GI.Base.GVariant import Data.GI.Base.ManagedPtr diff --git a/src/Data/GI/Base/Attributes.hs b/src/Data/GI/Base/Attributes.hs --- a/src/Data/GI/Base/Attributes.hs +++ b/src/Data/GI/Base/Attributes.hs @@ -125,6 +125,11 @@ AttrOp(..), + AttrGetC, + AttrSetC, + AttrConstructC, + AttrClearC, + get, set, clear, @@ -136,8 +141,9 @@ import Data.Proxy (Proxy(..)) -import Data.GI.Base.GValue (GValue(..)) -import Data.GI.Base.Overloading (ResolveAttribute, IsLabelProxy(..)) +import Data.GI.Base.GValue (GValueConstruct) +import Data.GI.Base.Overloading (HasAttributeList, + ResolveAttribute, IsLabelProxy(..)) import GHC.TypeLits import GHC.Exts (Constraint) @@ -186,8 +192,9 @@ attrClear :: AttrBaseTypeConstraint info o => Proxy info -> o -> IO () -- | Build a `GValue` representing the attribute. - attrConstruct :: AttrSetTypeConstraint info b => - Proxy info -> b -> IO (String, GValue) + attrConstruct :: (AttrBaseTypeConstraint info o, + AttrSetTypeConstraint info b) => + Proxy info -> b -> IO (GValueConstruct o) -- | Result of checking whether an op is allowed on an attribute. data OpAllowed tag attrName = @@ -229,24 +236,45 @@ AttrOpText 'AttrClear = "nullable" #endif +-- | Constraint on a @obj@\/@attr@ pair so that `set` works on values +-- of type @value@. +type AttrSetC info obj attr value = (HasAttributeList obj, + info ~ ResolveAttribute attr obj, + AttrInfo info, + AttrBaseTypeConstraint info obj, + AttrOpAllowed 'AttrSet info, + (AttrSetTypeConstraint info) value) + +-- | Constraint on a @obj@\/@value@ pair so that `new` works on values +-- of type @@value@. +type AttrConstructC info obj attr value = (HasAttributeList obj, + info ~ ResolveAttribute attr obj, + AttrInfo info, + AttrBaseTypeConstraint info obj, + AttrOpAllowed 'AttrConstruct info, + (AttrSetTypeConstraint info) value) + -- | Constructors for the different operations allowed on an attribute. data AttrOp obj (tag :: AttrOpTag) where -- Assign a value to an attribute - (:=) :: (info ~ ResolveAttribute attr obj, + (:=) :: (HasAttributeList obj, + info ~ ResolveAttribute attr obj, AttrInfo info, AttrBaseTypeConstraint info obj, AttrOpAllowed tag info, (AttrSetTypeConstraint info) b) => AttrLabelProxy (attr :: Symbol) -> b -> AttrOp obj tag -- Assign the result of an IO action to an attribute - (:=>) :: (info ~ ResolveAttribute attr obj, + (:=>) :: (HasAttributeList obj, + info ~ ResolveAttribute attr obj, AttrInfo info, AttrBaseTypeConstraint info obj, AttrOpAllowed tag info, (AttrSetTypeConstraint info) b) => AttrLabelProxy (attr :: Symbol) -> IO b -> AttrOp obj tag -- Apply an update function to an attribute - (:~) :: (info ~ ResolveAttribute attr obj, + (:~) :: (HasAttributeList obj, + info ~ ResolveAttribute attr obj, AttrInfo info, AttrBaseTypeConstraint info obj, tag ~ 'AttrSet, @@ -256,7 +284,8 @@ a ~ (AttrGetType info)) => AttrLabelProxy (attr :: Symbol) -> (a -> b) -> AttrOp obj tag -- Apply an IO update function to an attribute - (:~>) :: (info ~ ResolveAttribute attr obj, + (:~>) :: (HasAttributeList obj, + info ~ ResolveAttribute attr obj, AttrInfo info, AttrBaseTypeConstraint info obj, tag ~ 'AttrSet, @@ -266,7 +295,8 @@ a ~ (AttrGetType info)) => AttrLabelProxy (attr :: Symbol) -> (a -> IO b) -> AttrOp obj tag -- Assign a value to an attribute with the object as an argument - (::=) :: (info ~ ResolveAttribute attr obj, + (::=) :: (HasAttributeList obj, + info ~ ResolveAttribute attr obj, AttrInfo info, AttrBaseTypeConstraint info obj, tag ~ 'AttrSet, @@ -275,7 +305,8 @@ AttrLabelProxy (attr :: Symbol) -> (obj -> b) -> AttrOp obj tag -- Apply an update function to an attribute with the object as an -- argument - (::~) :: (info ~ ResolveAttribute attr obj, + (::~) :: (HasAttributeList obj, + info ~ ResolveAttribute attr obj, AttrInfo info, AttrBaseTypeConstraint info obj, tag ~ 'AttrSet, @@ -303,18 +334,30 @@ app (attr ::~ f) = attrGet (resolve attr) obj >>= \v -> attrSet (resolve attr) obj (f obj v) +-- | Constraints on a @obj@\/@attr@ pair so `get` is possible, +-- producing a value of type @result@. +type AttrGetC info obj attr result = (HasAttributeList obj, + info ~ ResolveAttribute attr obj, + AttrInfo info, + (AttrBaseTypeConstraint info) obj, + AttrOpAllowed 'AttrGet info, + result ~ AttrGetType info) + -- | Get the value of an attribute for an object. -get :: forall info attr obj m. - (info ~ ResolveAttribute attr obj, AttrInfo info, - (AttrBaseTypeConstraint info) obj, - AttrOpAllowed 'AttrGet info, MonadIO m) => - obj -> AttrLabelProxy (attr :: Symbol) -> m (AttrGetType info) +get :: forall info attr obj result m. + (AttrGetC info obj attr result, MonadIO m) => + obj -> AttrLabelProxy (attr :: Symbol) -> m result get o _ = liftIO $ attrGet (Proxy :: Proxy info) o +-- | Constraint on a @obj@\/@attr@ pair so that `clear` is allowed. +type AttrClearC info obj attr = (HasAttributeList obj, + info ~ ResolveAttribute attr obj, + AttrInfo info, + (AttrBaseTypeConstraint info) obj, + AttrOpAllowed 'AttrClear info) + -- | 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) => + (AttrClearC info obj attr, MonadIO m) => obj -> AttrLabelProxy (attr :: Symbol) -> m () clear o _ = liftIO $ attrClear (Proxy :: Proxy info) o diff --git a/src/Data/GI/Base/BasicTypes.hs b/src/Data/GI/Base/BasicTypes.hs new file mode 100644 --- /dev/null +++ b/src/Data/GI/Base/BasicTypes.hs @@ -0,0 +1,206 @@ +{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances, + DeriveDataTypeable, TypeFamilies, ScopedTypeVariables #-} +#if !MIN_VERSION_base(4,8,0) +{-# LANGUAGE OverlappingInstances #-} +#endif +#if MIN_VERSION_base(4,9,0) +{-# LANGUAGE DataKinds, TypeOperators, UndecidableInstances #-} +#endif +-- | Basic types used in the bindings. +module Data.GI.Base.BasicTypes + ( + -- * GType related + module Data.GI.Base.GType -- reexported for convenience + + -- * Memory management + + , ForeignPtrNewtype + , BoxedObject(..) + , BoxedEnum(..) + , BoxedFlags(..) + , GObject(..) + , WrappedPtr(..) + , UnexpectedNullPointerReturn(..) + , NullToNothing(..) + + -- * Basic GLib \/ GObject types + , GVariant(..) + , GParamSpec(..) + + , GArray(..) + , GPtrArray(..) + , GByteArray(..) + , GHashTable(..) + , GList(..) + , g_list_free + , GSList(..) + , g_slist_free + + , IsGFlag + + , PtrWrapped(..) + , GDestroyNotify + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>)) +#endif +import Control.Exception (Exception, catch) +import Control.Monad.IO.Class (MonadIO(..)) +import Data.Coerce (Coercible) +import Data.Proxy (Proxy) +import qualified Data.Text as T +import Data.Typeable (Typeable) +import Foreign.Ptr (Ptr, FunPtr) +import Foreign.ForeignPtr (ForeignPtr) + +#if MIN_VERSION_base(4,9,0) +import GHC.TypeLits +#endif + +import Data.GI.Base.GType + +-- | A constraint ensuring that the given type is coercible to a +-- ForeignPtr. It will hold for newtypes of the form +-- +-- > newtype Foo = Foo (ForeignPtr Foo) +-- +-- which is the typical shape of wrapped 'GObject's. +type ForeignPtrNewtype a = Coercible a (ForeignPtr ()) +-- Notice that the Coercible here is to ForeignPtr (), instead of +-- "ForeignPtr a", which would be the most natural thing. Both are +-- representationally equivalent, so this is not a big deal. This is +-- to work around a problem in ghc 7.10: +-- https://ghc.haskell.org/trac/ghc/ticket/10715 + +-- | Wrapped boxed structures, identified by their `GType`. +class ForeignPtrNewtype a => BoxedObject a where + boxedType :: a -> IO GType -- This should not use the value of its + -- argument. + +-- | Enums with an associated `GType`. +class BoxedEnum a where + boxedEnumType :: a -> IO GType + +-- | Flags with an associated `GType`. +class BoxedFlags a where + boxedFlagsType :: Proxy a -> IO GType + +-- | Pointers to structs/unions without an associated `GType`. +class ForeignPtrNewtype a => WrappedPtr a where + -- | Allocate a zero-initialized block of memory for the given type. + wrappedPtrCalloc :: IO (Ptr a) + -- | Make a copy of the given pointer. + wrappedPtrCopy :: Ptr a -> IO (Ptr a) + -- | A pointer to a function for freeing the given pointer, or + -- `Nothing` is the memory associated to the pointer does not need + -- to be freed. + wrappedPtrFree :: Maybe (FunPtr (Ptr a -> IO ())) + +-- | A wrapped `GObject`. +class ForeignPtrNewtype a => GObject a where + -- | Whether the `GObject` is a descendent of . + gobjectIsInitiallyUnowned :: a -> Bool + -- | The `GType` for this object. + gobjectType :: a -> IO GType + +-- Raise a more understandable type error whenever the `GObject a` +-- constraint is imposed on a type which has no such instance. This +-- helps in the common case where one passes a wrong type (such as +-- `Maybe Widget`) into a function with a `WidgetK a` +-- constraint. Without this type error, the resulting type error is +-- much less understandable, since GHC complains (at length) about a +-- missing type family instance for `ParentTypes`. +#if MIN_VERSION_base(4,9,0) +instance {-# OVERLAPPABLE #-} + (TypeError ('Text "Type ‘" ':<>: 'ShowType a ':<>: + 'Text "’ does not descend from GObject."), ForeignPtrNewtype a) + => GObject a where + gobjectIsInitiallyUnowned = undefined + gobjectType = undefined +#endif + +-- | A common omission in the introspection data is missing (nullable) +-- annotations for return types, when they clearly are nullable. (A +-- common idiom is "Returns: valid value, or %NULL if something went +-- wrong.") +-- +-- Haskell wrappers will raise this exception if the return value is +-- an unexpected `Foreign.Ptr.nullPtr`. +data UnexpectedNullPointerReturn = + UnexpectedNullPointerReturn { nullPtrErrorMsg :: T.Text } + deriving (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 . See "Data.GI.Base.GVariant" for further methods. +newtype GVariant = GVariant (ForeignPtr GVariant) + +-- | A . See "Data.GI.Base.GParamSpec" for further methods. +newtype GParamSpec = GParamSpec (ForeignPtr GParamSpec) + +-- | An enum usable as a flag for a function. +class Enum a => IsGFlag a + +-- | A . Marshalling for this type is done in "Data.GI.Base.BasicConversions", it is mapped to a list on the Haskell side. +data GArray a = GArray (Ptr (GArray a)) + +-- | A . Marshalling for this type is done in "Data.GI.Base.BasicConversions", it is mapped to a list on the Haskell side. +data GPtrArray a = GPtrArray (Ptr (GPtrArray a)) + +-- | A . Marshalling for this type is done in "Data.GI.Base.BasicConversions", it is packed to a 'Data.ByteString.ByteString' on the Haskell side. +data GByteArray = GByteArray (Ptr GByteArray) + +-- | A . It is mapped to a 'Data.Map.Map' on the Haskell side. +data GHashTable a b = GHashTable (Ptr (GHashTable a b)) + +-- | A , mapped to a list on the Haskell side. Marshalling is done in "Data.GI.Base.BasicConversions". +data GList a = GList (Ptr (GList a)) + +-- | A , mapped to a list on the Haskell side. Marshalling is done in "Data.GI.Base.BasicConversions". +data GSList a = GSList (Ptr (GSList a)) + +-- | Some APIs, such as `GHashTable`, pass around scalar types +-- wrapped into a pointer. We encode such a type as follows. +newtype PtrWrapped a = PtrWrapped {unwrapPtr :: Ptr a} + +-- | Destroy the memory associated with a given pointer. +type GDestroyNotify a = FunPtr (Ptr a -> IO ()) + +-- | Free the given 'GList'. +foreign import ccall "g_list_free" g_list_free :: + Ptr (GList a) -> IO () + +-- | Free the given 'GSList'. +foreign import ccall "g_slist_free" g_slist_free :: + Ptr (GSList a) -> IO () diff --git a/src/Data/GI/Base/BasicTypes.hsc b/src/Data/GI/Base/BasicTypes.hsc deleted file mode 100644 --- a/src/Data/GI/Base/BasicTypes.hsc +++ /dev/null @@ -1,318 +0,0 @@ -{-# LANGUAGE ConstraintKinds, FlexibleContexts, FlexibleInstances, - DeriveDataTypeable, TypeFamilies, ScopedTypeVariables #-} -#if !MIN_VERSION_base(4,8,0) -{-# LANGUAGE OverlappingInstances #-} -#endif --- | Basic types used in the bindings. -module Data.GI.Base.BasicTypes - ( - -- * GType related - GType(..) - , CGType - - , gtypeName - - , gtypeString - , gtypePointer - , gtypeInt - , gtypeUInt - , gtypeLong - , gtypeULong - , gtypeInt64 - , gtypeUInt64 - , gtypeFloat - , gtypeDouble - , gtypeBoolean - , gtypeGType - , gtypeStrv - , gtypeBoxed - , gtypeObject - , gtypeVariant - , gtypeByteArray - , gtypeInvalid - - -- * Memory management - - , ForeignPtrNewtype - , BoxedObject(..) - , BoxedEnum(..) - , BoxedFlags(..) - , GObject(..) - , WrappedPtr(..) - , UnexpectedNullPointerReturn(..) - , NullToNothing(..) - - -- * Basic GLib \/ GObject types - , GVariant(..) - , GParamSpec(..) - - , GArray(..) - , GPtrArray(..) - , GByteArray(..) - , GHashTable(..) - , GList(..) - , g_list_free - , GSList(..) - , g_slist_free - - , IsGFlag - - , PtrWrapped(..) - , GDestroyNotify - ) where - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -#endif -import Control.Exception (Exception, catch) -import Control.Monad.IO.Class (MonadIO(..)) -import Data.Coerce (Coercible) -import Data.Proxy (Proxy) -import qualified Data.Text as T -import Data.Typeable (Typeable) -import Data.Word -import Foreign.Ptr (Ptr, FunPtr) -import Foreign.ForeignPtr (ForeignPtr) -import Foreign.C.String (CString, peekCString) - -#include - --- | A type identifier in the GLib type system. This is the low-level --- type associated with the representation in memory, when using this --- on the Haskell side use `GType` below. -type CGType = #type GType - --- | A newtype for use on the haskell side. -newtype GType = GType {gtypeToCGType :: CGType} - -foreign import ccall "g_type_name" g_type_name :: GType -> IO CString - --- | Get the name assigned to the given `GType`. -gtypeName :: GType -> IO String -gtypeName gtype = g_type_name gtype >>= peekCString - -{-| [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 - --- | `GType` of pointers. -gtypePointer :: GType -gtypePointer = GType #const G_TYPE_POINTER - --- | `GType` for signed integers (`gint` or `gint32`). -gtypeInt :: GType -gtypeInt = GType #const G_TYPE_INT - --- | `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 - --- | `GType` for unsigned 64 bit integers. -gtypeUInt64 :: GType -gtypeUInt64 = GType #const G_TYPE_UINT64 - --- | `GType` for floating point values. -gtypeFloat :: GType -gtypeFloat = GType #const G_TYPE_FLOAT - --- | `GType` for gdouble. -gtypeDouble :: GType -gtypeDouble = GType #const G_TYPE_DOUBLE - --- | `GType` corresponding to gboolean. -gtypeBoolean :: GType -gtypeBoolean = GType #const G_TYPE_BOOLEAN - --- | `GType` corresponding to a `BoxedObject`. -gtypeBoxed :: GType -gtypeBoxed = GType #const G_TYPE_BOXED - --- | `GType` corresponding to a `GObject`. -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 --- --- > newtype Foo = Foo (ForeignPtr Foo) --- --- which is the typical shape of wrapped 'GObject's. -type ForeignPtrNewtype a = Coercible a (ForeignPtr ()) --- Notice that the Coercible here is to ForeignPtr (), instead of --- "ForeignPtr a", which would be the most natural thing. Both are --- representationally equivalent, so this is not a big deal. This is --- to work around a problem in ghc 7.10: --- https://ghc.haskell.org/trac/ghc/ticket/10715 - --- | Wrapped boxed structures, identified by their `GType`. -class ForeignPtrNewtype a => BoxedObject a where - boxedType :: a -> IO GType -- This should not use the value of its - -- argument. - --- | Enums with an associated `GType`. -class BoxedEnum a where - boxedEnumType :: a -> IO GType - --- | Flags with an associated `GType`. -class BoxedFlags a where - boxedFlagsType :: Proxy a -> IO GType - --- | Pointers to structs/unions without an associated `GType`. -class ForeignPtrNewtype a => WrappedPtr a where - -- | Allocate a zero-initialized block of memory for the given type. - wrappedPtrCalloc :: IO (Ptr a) - -- | Make a copy of the given pointer. - wrappedPtrCopy :: Ptr a -> IO (Ptr a) - -- | A pointer to a function for freeing the given pointer, or - -- `Nothing` is the memory associated to the pointer does not need - -- to be freed. - wrappedPtrFree :: Maybe (FunPtr (Ptr a -> IO ())) - --- | A wrapped `GObject`. -class ForeignPtrNewtype a => GObject a where - -- | Whether the `GObject` is a descendent of . - gobjectIsInitiallyUnowned :: a -> Bool - -- | The `GType` for this object. - gobjectType :: a -> IO GType - --- | A common omission in the introspection data is missing (nullable) --- annotations for return types, when they clearly are nullable. (A --- common idiom is "Returns: valid value, or %NULL if something went --- wrong.") --- --- Haskell wrappers will raise this exception if the return value is --- an unexpected `Foreign.Ptr.nullPtr`. -data UnexpectedNullPointerReturn = - UnexpectedNullPointerReturn { nullPtrErrorMsg :: T.Text } - deriving (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 . See "Data.GI.Base.GVariant" for further methods. -newtype GVariant = GVariant (ForeignPtr GVariant) - --- | A . See "Data.GI.Base.GParamSpec" for further methods. -newtype GParamSpec = GParamSpec (ForeignPtr GParamSpec) - --- | An enum usable as a flag for a function. -class Enum a => IsGFlag a - --- | A . Marshalling for this type is done in "Data.GI.Base.BasicConversions", it is mapped to a list on the Haskell side. -data GArray a = GArray (Ptr (GArray a)) - --- | A . Marshalling for this type is done in "Data.GI.Base.BasicConversions", it is mapped to a list on the Haskell side. -data GPtrArray a = GPtrArray (Ptr (GPtrArray a)) - --- | A . Marshalling for this type is done in "Data.GI.Base.BasicConversions", it is packed to a 'Data.ByteString.ByteString' on the Haskell side. -data GByteArray = GByteArray (Ptr GByteArray) - --- | A . It is mapped to a 'Data.Map.Map' on the Haskell side. -data GHashTable a b = GHashTable (Ptr (GHashTable a b)) - --- | A , mapped to a list on the Haskell side. Marshalling is done in "Data.GI.Base.BasicConversions". -data GList a = GList (Ptr (GList a)) - --- | A , mapped to a list on the Haskell side. Marshalling is done in "Data.GI.Base.BasicConversions". -data GSList a = GSList (Ptr (GSList a)) - --- | Some APIs, such as `GHashTable`, pass around scalar types --- wrapped into a pointer. We encode such a type as follows. -newtype PtrWrapped a = PtrWrapped {unwrapPtr :: Ptr a} - --- | Destroy the memory associated with a given pointer. -type GDestroyNotify a = FunPtr (Ptr a -> IO ()) - --- | Free the given 'GList'. -foreign import ccall "g_list_free" g_list_free :: - Ptr (GList a) -> IO () - --- | Free the given 'GSList'. -foreign import ccall "g_slist_free" g_slist_free :: - Ptr (GSList a) -> IO () diff --git a/src/Data/GI/Base/GObject.hsc b/src/Data/GI/Base/GObject.hsc --- a/src/Data/GI/Base/GObject.hsc +++ b/src/Data/GI/Base/GObject.hsc @@ -2,17 +2,19 @@ module Data.GI.Base.GObject ( constructGObject + , new' ) 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.GValue (GValue(..), GValueConstruct(..)) import Data.GI.Base.ManagedPtr (withManagedPtr, touchManagedPtr, wrapObject) import Data.GI.Base.Overloading (ResolveAttribute) @@ -29,6 +31,20 @@ -> m o constructGObject constructor attrs = liftIO $ do props <- mapM construct attrs + doConstructGObject constructor props + where + resolve :: AttrLabelProxy attr -> Proxy (ResolveAttribute attr o) + resolve _ = Proxy + + construct :: AttrOp o 'AttrConstruct -> + IO (GValueConstruct o) + construct (attr := x) = attrConstruct (resolve attr) x + construct (attr :=> x) = x >>= attrConstruct (resolve attr) + +-- | Construct the `GObject` given the list of `GValueConstruct`s. +doConstructGObject :: forall o m. (GObject o, MonadIO m) + => (ForeignPtr o -> o) -> [GValueConstruct o] -> m o +doConstructGObject constructor props = liftIO $ do let nprops = length props params <- mallocBytes (nprops*gparameterSize) fill params props @@ -39,29 +55,25 @@ -- 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 + -- may free the GValues before g_object_newv is 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 + mapM_ (touchManagedPtr . deconstructGValue) 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) + where + deconstructGValue :: GValueConstruct o -> GValue + deconstructGValue (GValueConstruct _ v) = v 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 :: Ptr () -> [GValueConstruct o] -> IO () fill _ [] = return () - fill dataPtr ((str, gvalue):xs) = + fill dataPtr ((GValueConstruct str gvalue):xs) = do cstr <- newCString str poke (castPtr dataPtr) cstr withManagedPtr gvalue $ \gvalueptr -> @@ -76,3 +88,11 @@ do cstr <- peek (castPtr dataPtr) :: IO CString free cstr freeStrings (n-1) (dataPtr `plusPtr` gparameterSize) + +-- | Construct the given `GObject`, given a set of actions +-- constructing desired `GValue`s to set at construction time. +new' :: (MonadIO m, GObject o) => + (ForeignPtr o -> o) -> [IO (GValueConstruct o)] -> m o +new' constructor actions = do + props <- liftIO $ sequence (actions) + doConstructGObject constructor props diff --git a/src/Data/GI/Base/GType.hsc b/src/Data/GI/Base/GType.hsc new file mode 100644 --- /dev/null +++ b/src/Data/GI/Base/GType.hsc @@ -0,0 +1,142 @@ +-- | Basic `GType`s. +module Data.GI.Base.GType + ( GType(..) + , CGType + + , gtypeName + + , gtypeString + , gtypePointer + , gtypeInt + , gtypeUInt + , gtypeLong + , gtypeULong + , gtypeInt64 + , gtypeUInt64 + , gtypeFloat + , gtypeDouble + , gtypeBoolean + , gtypeGType + , gtypeStrv + , gtypeBoxed + , gtypeObject + , gtypeVariant + , gtypeByteArray + , gtypeInvalid + ) where + +import Data.Word (Word64) +import Foreign.C.String (CString, peekCString) + +#include + +-- | A type identifier in the GLib type system. This is the low-level +-- type associated with the representation in memory, when using this +-- on the Haskell side use `GType` below. +type CGType = #type GType + +-- | A newtype for use on the haskell side. +newtype GType = GType {gtypeToCGType :: CGType} + +foreign import ccall "g_type_name" g_type_name :: GType -> IO CString + +-- | Get the name assigned to the given `GType`. +gtypeName :: GType -> IO String +gtypeName gtype = g_type_name gtype >>= peekCString + +{-| [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 + +-- | `GType` of pointers. +gtypePointer :: GType +gtypePointer = GType #const G_TYPE_POINTER + +-- | `GType` for signed integers (`gint` or `gint32`). +gtypeInt :: GType +gtypeInt = GType #const G_TYPE_INT + +-- | `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 + +-- | `GType` for unsigned 64 bit integers. +gtypeUInt64 :: GType +gtypeUInt64 = GType #const G_TYPE_UINT64 + +-- | `GType` for floating point values. +gtypeFloat :: GType +gtypeFloat = GType #const G_TYPE_FLOAT + +-- | `GType` for gdouble. +gtypeDouble :: GType +gtypeDouble = GType #const G_TYPE_DOUBLE + +-- | `GType` corresponding to gboolean. +gtypeBoolean :: GType +gtypeBoolean = GType #const G_TYPE_BOOLEAN + +-- | `GType` corresponding to a `BoxedObject`. +gtypeBoxed :: GType +gtypeBoxed = GType #const G_TYPE_BOXED + +-- | `GType` corresponding to a `GObject`. +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 diff --git a/src/Data/GI/Base/GValue.hsc b/src/Data/GI/Base/GValue.hsc --- a/src/Data/GI/Base/GValue.hsc +++ b/src/Data/GI/Base/GValue.hsc @@ -1,13 +1,14 @@ {-# LANGUAGE FlexibleInstances #-} module Data.GI.Base.GValue ( GValue(..) - , IsGValue(..) , newGValue -- Build a new, empty, GValue of the given type , buildGValue -- Build a new GValue and initialize to the given value , noGValue + , GValueConstruct(..) + , set_string , get_string , set_pointer @@ -83,6 +84,11 @@ foreign import ccall "g_value_init" g_value_init :: Ptr GValue -> CGType -> IO (Ptr GValue) + +-- | A type holding a `GValue` with an associated label. It is +-- parameterized by a phantom type encoding the target type for the +-- `GValue` (useful when constructing properties). +data GValueConstruct o = GValueConstruct String GValue newGValue :: GType -> IO GValue newGValue (GType gtype) = do diff --git a/src/Data/GI/Base/Overloading.hs b/src/Data/GI/Base/Overloading.hs --- a/src/Data/GI/Base/Overloading.hs +++ b/src/Data/GI/Base/Overloading.hs @@ -8,9 +8,13 @@ ( -- * Type level inheritance ParentTypes , IsDescendantOf +#if MIN_VERSION_base(4,9,0) + , UnknownAncestorError +#endif -- * Looking up attributes in parent types , AttributeList + , HasAttributeList , ResolveAttribute , HasAttribute , HasAttr @@ -27,12 +31,20 @@ -- * Overloaded labels , IsLabelProxy(..) + +#if MIN_VERSION_base(4,9,0) + , module GHC.OverloadedLabels -- Reexported for convenience +#endif ) where import GHC.Exts (Constraint) import GHC.TypeLits import Data.Proxy (Proxy) +#if MIN_VERSION_base(4,9,0) +import GHC.OverloadedLabels (IsLabel(..)) +#endif + -- | Support for overloaded labels in ghc < 8.0. This is like the -- `IsLabel` class introduced in ghc 8.0 (for use with the -- OverloadedLabels extension) with the difference that the `Proxy` @@ -72,6 +84,15 @@ | DoesNotHaveRequiredAncestor Symbol t Symbol a #endif +#if MIN_VERSION_base(4,9,0) +-- | Type error to be generated when an ancestor check fails. +type family UnknownAncestorError (a :: *) (t :: *) where + UnknownAncestorError a t = + TypeError ('Text "Required ancestor ‘" ':<>: 'ShowType a + ':<>: 'Text "’ not found for type ‘" + ':<>: 'ShowType t ':<>: 'Text "’.") +#endif + -- | Check whether a type appears in a list. We specialize the -- names/types a bit so the error messages are more informative. type family CheckForAncestorType t (a :: *) (as :: [*]) :: AncestorCheck * * where @@ -79,9 +100,7 @@ #if !MIN_VERSION_base(4,9,0) 'DoesNotHaveRequiredAncestor "Error: Required ancestor" a "not found for type" t #else - TypeError ('Text "Required ancestor ‘" ':<>: 'ShowType a - ':<>: 'Text "’ not found for type ‘" ':<>: 'ShowType t - ':<>: 'Text "’.") + UnknownAncestorError a t #endif CheckForAncestorType t a (a ': as) = 'HasAncestor a t CheckForAncestorType t a (b ': as) = CheckForAncestorType t a as @@ -103,6 +122,20 @@ -- of the attribute, and the second the type encoding the information -- of the attribute. This type will be an instance of `AttrInfo`. type family AttributeList a :: [(Symbol, *)] + +-- | A constraint on a type, to be fulfilled whenever it has a type +-- instance for `AttributeList`. This is here for nicer error +-- reporting. +class HasAttributeList a + +#if MIN_VERSION_base(4,9,0) +-- Default instance, which will give rise to an error for types +-- without an associated `AttributeList`. +instance {-# OVERLAPPABLE #-} + TypeError ('Text "Type ‘" ':<>: 'ShowType a ':<>: + 'Text "’ does not have any known attributes.") + => HasAttributeList a +#endif #if !MIN_VERSION_base(4,9,0) -- | Datatype returned when the attribute is not found, hopefully making diff --git a/src/Data/GI/Base/Properties.hsc b/src/Data/GI/Base/Properties.hsc --- a/src/Data/GI/Base/Properties.hsc +++ b/src/Data/GI/Base/Properties.hsc @@ -122,10 +122,10 @@ getter gvalue constructObjectProperty :: String -> b -> (GValue -> b -> IO ()) -> - GType -> IO (String, GValue) + GType -> IO (GValueConstruct o) constructObjectProperty propName propValue setter gtype = do gvalue <- buildGValue gtype setter propValue - return (propName, gvalue) + return (GValueConstruct propName gvalue) setObjectPropertyString :: GObject a => a -> String -> Maybe Text -> IO () @@ -133,7 +133,7 @@ setObjectProperty obj propName str set_string gtypeString constructObjectPropertyString :: String -> Maybe Text -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyString propName str = constructObjectProperty propName str set_string gtypeString @@ -148,7 +148,7 @@ setObjectProperty obj propName ptr set_pointer gtypePointer constructObjectPropertyPtr :: String -> Ptr b -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyPtr propName ptr = constructObjectProperty propName ptr set_pointer gtypePointer @@ -163,7 +163,7 @@ setObjectProperty obj propName int set_int gtypeInt constructObjectPropertyInt :: String -> CInt -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyInt propName int = constructObjectProperty propName int set_int gtypeInt @@ -177,7 +177,7 @@ setObjectProperty obj propName uint set_uint gtypeUInt constructObjectPropertyUInt :: String -> CUInt -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyUInt propName uint = constructObjectProperty propName uint set_uint gtypeUInt @@ -191,7 +191,7 @@ setObjectProperty obj propName int set_long gtypeLong constructObjectPropertyLong :: String -> CLong -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyLong propName int = constructObjectProperty propName int set_long gtypeLong @@ -205,7 +205,7 @@ setObjectProperty obj propName uint set_ulong gtypeULong constructObjectPropertyULong :: String -> CULong -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyULong propName uint = constructObjectProperty propName uint set_ulong gtypeULong @@ -219,7 +219,7 @@ setObjectProperty obj propName int32 set_int32 gtypeInt constructObjectPropertyInt32 :: String -> Int32 -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyInt32 propName int32 = constructObjectProperty propName int32 set_int32 gtypeInt @@ -233,7 +233,7 @@ setObjectProperty obj propName uint32 set_uint32 gtypeUInt constructObjectPropertyUInt32 :: String -> Word32 -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyUInt32 propName uint32 = constructObjectProperty propName uint32 set_uint32 gtypeUInt @@ -247,7 +247,7 @@ setObjectProperty obj propName int64 set_int64 gtypeInt64 constructObjectPropertyInt64 :: String -> Int64 -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyInt64 propName int64 = constructObjectProperty propName int64 set_int64 gtypeInt64 @@ -261,7 +261,7 @@ setObjectProperty obj propName uint64 set_uint64 gtypeUInt64 constructObjectPropertyUInt64 :: String -> Word64 -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyUInt64 propName uint64 = constructObjectProperty propName uint64 set_uint64 gtypeUInt64 @@ -275,7 +275,7 @@ setObjectProperty obj propName float set_float gtypeFloat constructObjectPropertyFloat :: String -> Float -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyFloat propName float = constructObjectProperty propName float set_float gtypeFloat @@ -290,7 +290,7 @@ setObjectProperty obj propName double set_double gtypeDouble constructObjectPropertyDouble :: String -> Double -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyDouble propName double = constructObjectProperty propName double set_double gtypeDouble @@ -304,7 +304,7 @@ setObjectPropertyBool obj propName bool = setObjectProperty obj propName bool set_boolean gtypeBoolean -constructObjectPropertyBool :: String -> Bool -> IO (String, GValue) +constructObjectPropertyBool :: String -> Bool -> IO (GValueConstruct o) constructObjectPropertyBool propName bool = constructObjectProperty propName bool set_boolean gtypeBoolean @@ -317,7 +317,7 @@ setObjectPropertyGType obj propName gtype = setObjectProperty obj propName gtype set_gtype gtypeGType -constructObjectPropertyGType :: String -> GType -> IO (String, GValue) +constructObjectPropertyGType :: String -> GType -> IO (GValueConstruct o) constructObjectPropertyGType propName bool = constructObjectProperty propName bool set_gtype gtypeGType @@ -332,8 +332,8 @@ maybeWithManagedPtr maybeObject $ \objectPtr -> setObjectProperty obj propName objectPtr set_object gtype -constructObjectPropertyObject :: forall a. GObject a => - String -> Maybe a -> IO (String, GValue) +constructObjectPropertyObject :: forall a o. GObject a => + String -> Maybe a -> IO (GValueConstruct o) constructObjectPropertyObject propName maybeObject = do gtype <- gobjectType (undefined :: a) maybeWithManagedPtr maybeObject $ \objectPtr -> @@ -355,8 +355,8 @@ maybeWithManagedPtr maybeBoxed $ \boxedPtr -> setObjectProperty obj propName boxedPtr set_boxed gtype -constructObjectPropertyBoxed :: forall a. (BoxedObject a) => - String -> Maybe a -> IO (String, GValue) +constructObjectPropertyBoxed :: forall a o. (BoxedObject a) => + String -> Maybe a -> IO (GValueConstruct o) constructObjectPropertyBoxed propName maybeBoxed = do gtype <- boxedType (undefined :: a) maybeWithManagedPtr maybeBoxed $ \boxedPtr -> @@ -381,7 +381,7 @@ freeMem cStrv constructObjectPropertyStringArray :: String -> Maybe [Text] -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyStringArray propName Nothing = constructObjectProperty propName nullPtr set_boxed gtypeStrv constructObjectPropertyStringArray propName (Just strv) = do @@ -406,7 +406,7 @@ setObjectProperty obj propName cEnum set_enum gtype constructObjectPropertyEnum :: (Enum a, BoxedEnum a) => - String -> a -> IO (String, GValue) + String -> a -> IO (GValueConstruct o) constructObjectPropertyEnum propName enum = do gtype <- boxedEnumType enum let cEnum = (fromIntegral . fromEnum) enum @@ -428,8 +428,8 @@ gtype <- boxedFlagsType (Proxy :: Proxy b) setObjectProperty obj propName cFlags set_flags gtype -constructObjectPropertyFlags :: forall a. (IsGFlag a, BoxedFlags a) - => String -> [a] -> IO (String, GValue) +constructObjectPropertyFlags :: forall a o. (IsGFlag a, BoxedFlags a) + => String -> [a] -> IO (GValueConstruct o) constructObjectPropertyFlags propName flags = do let cFlags = gflagsToWord flags gtype <- boxedFlagsType (Proxy :: Proxy a) @@ -450,7 +450,7 @@ setObjectProperty obj propName variantPtr set_variant gtypeVariant constructObjectPropertyVariant :: String -> Maybe GVariant - -> IO (String, GValue) + -> IO (GValueConstruct o) constructObjectPropertyVariant propName maybeVariant = maybeWithManagedPtr maybeVariant $ \objPtr -> constructObjectProperty propName objPtr set_variant gtypeVariant @@ -472,7 +472,7 @@ unrefGByteArray packed constructObjectPropertyByteArray :: String -> Maybe B.ByteString -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyByteArray propName Nothing = constructObjectProperty propName nullPtr set_boxed gtypeByteArray constructObjectPropertyByteArray propName (Just bytes) = do @@ -496,7 +496,7 @@ g_list_free packed constructObjectPropertyPtrGList :: String -> [Ptr a] -> - IO (String, GValue) + IO (GValueConstruct o) constructObjectPropertyPtrGList propName ptrs = do packed <- packGList ptrs result <- constructObjectProperty propName packed set_boxed gtypePointer @@ -512,7 +512,7 @@ setObjectPropertyHash = error $ "Setting GHashTable properties not supported yet." -constructObjectPropertyHash :: String -> b -> IO (String, GValue) +constructObjectPropertyHash :: String -> b -> IO (GValueConstruct o) constructObjectPropertyHash = error $ "Constructing GHashTable properties not supported yet." diff --git a/src/Data/GI/Base/ShortPrelude.hs b/src/Data/GI/Base/ShortPrelude.hs --- a/src/Data/GI/Base/ShortPrelude.hs +++ b/src/Data/GI/Base/ShortPrelude.hs @@ -29,17 +29,12 @@ , module Data.GI.Base.GVariant , module Data.GI.Base.GValue , module Data.GI.Base.ManagedPtr - , module Data.GI.Base.Overloading , module Data.GI.Base.Properties , module Data.GI.Base.Signals , module Data.GI.Base.Utils , module GHC.TypeLits -#if MIN_VERSION_base(4,9,0) - , module GHC.OverloadedLabels -#endif - , Enum(fromEnum, toEnum) , Show(..) , Eq(..) @@ -91,12 +86,8 @@ 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 import Data.GI.Base.Signals (SignalConnectMode(..), connectSignalFunPtr, SignalHandlerId, SignalInfo(..), GObjectNotifySignalInfo) import Data.GI.Base.Utils import GHC.TypeLits (Symbol) -#if MIN_VERSION_base(4,9,0) -import GHC.OverloadedLabels (IsLabel(..)) -#endif