-- Generated code. {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# LANGUAGE ForeignFunctionInterface, ConstraintKinds, TypeFamilies, MultiParamTypeClasses, KindSignatures, FlexibleInstances, UndecidableInstances, DataKinds, OverloadedStrings, NegativeLiterals, FlexibleContexts #-} module GI.GObject where import Prelude () import Data.GI.Base.ShortPrelude import Data.Char import Data.Int import Data.Word import qualified Data.ByteString.Char8 as B import Data.ByteString.Char8 (ByteString) import qualified Data.Map as Map import Foreign.C import Foreign.Ptr import Foreign.ForeignPtr import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) import Foreign.Storable (peek, poke, sizeOf) import Control.Applicative ((<$>)) import Control.Exception (onException) import Control.Monad.IO.Class import qualified Data.Text as T import Data.GI.Base.Attributes hiding (get, set) import Data.GI.Base.BasicTypes import Data.GI.Base.BasicConversions import Data.GI.Base.Closure import Data.GI.Base.GError import Data.GI.Base.GHashTable 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.Signals (SignalConnectMode(..), connectSignalFunPtr, SignalHandlerId) import Data.GI.Base.Utils import qualified GI.GLib as GLib import qualified GI.GLibAttributes as GLibA -- callback BaseFinalizeFunc baseFinalizeFuncClosure :: BaseFinalizeFunc -> IO Closure baseFinalizeFuncClosure cb = newCClosure =<< mkBaseFinalizeFunc wrapped where wrapped = baseFinalizeFuncWrapper Nothing cb type BaseFinalizeFuncC = Ptr () -> IO () foreign import ccall "wrapper" mkBaseFinalizeFunc :: BaseFinalizeFuncC -> IO (FunPtr BaseFinalizeFuncC) type BaseFinalizeFunc = Ptr () -> IO () noBaseFinalizeFunc :: Maybe BaseFinalizeFunc noBaseFinalizeFunc = Nothing baseFinalizeFuncWrapper :: Maybe (Ptr (FunPtr (BaseFinalizeFuncC))) -> BaseFinalizeFunc -> Ptr () -> IO () baseFinalizeFuncWrapper funptrptr _cb g_class = do _cb g_class maybeReleaseFunPtr funptrptr -- callback BaseInitFunc baseInitFuncClosure :: BaseInitFunc -> IO Closure baseInitFuncClosure cb = newCClosure =<< mkBaseInitFunc wrapped where wrapped = baseInitFuncWrapper Nothing cb type BaseInitFuncC = Ptr () -> IO () foreign import ccall "wrapper" mkBaseInitFunc :: BaseInitFuncC -> IO (FunPtr BaseInitFuncC) type BaseInitFunc = Ptr () -> IO () noBaseInitFunc :: Maybe BaseInitFunc noBaseInitFunc = Nothing baseInitFuncWrapper :: Maybe (Ptr (FunPtr (BaseInitFuncC))) -> BaseInitFunc -> Ptr () -> IO () baseInitFuncWrapper funptrptr _cb g_class = do _cb g_class maybeReleaseFunPtr funptrptr -- object Binding newtype Binding = Binding (ForeignPtr Binding) noBinding :: Maybe Binding noBinding = Nothing foreign import ccall "g_binding_get_type" c_g_binding_get_type :: IO GType type instance ParentTypes Binding = '[Object] instance GObject Binding where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_binding_get_type class GObject o => BindingK o instance (GObject o, IsDescendantOf Binding o) => BindingK o toBinding :: BindingK o => o -> IO Binding toBinding = unsafeCastTo Binding -- method Binding::get_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Binding", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Binding", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "BindingFlags" -- throws : False -- Skip return : False foreign import ccall "g_binding_get_flags" g_binding_get_flags :: Ptr Binding -> -- _obj : TInterface "GObject" "Binding" IO CUInt bindingGetFlags :: (MonadIO m, BindingK a) => a -> -- _obj m [BindingFlags] bindingGetFlags _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_binding_get_flags _obj' let result' = wordToGFlags result touchManagedPtr _obj return result' -- method Binding::get_source -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Binding", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Binding", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Object" -- throws : False -- Skip return : False foreign import ccall "g_binding_get_source" g_binding_get_source :: Ptr Binding -> -- _obj : TInterface "GObject" "Binding" IO (Ptr Object) bindingGetSource :: (MonadIO m, BindingK a) => a -> -- _obj m Object bindingGetSource _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_binding_get_source _obj' checkUnexpectedReturnNULL "g_binding_get_source" result result' <- (newObject Object) result touchManagedPtr _obj return result' -- method Binding::get_source_property -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Binding", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Binding", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_binding_get_source_property" g_binding_get_source_property :: Ptr Binding -> -- _obj : TInterface "GObject" "Binding" IO CString bindingGetSourceProperty :: (MonadIO m, BindingK a) => a -> -- _obj m T.Text bindingGetSourceProperty _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_binding_get_source_property _obj' checkUnexpectedReturnNULL "g_binding_get_source_property" result result' <- cstringToText result touchManagedPtr _obj return result' -- method Binding::get_target -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Binding", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Binding", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Object" -- throws : False -- Skip return : False foreign import ccall "g_binding_get_target" g_binding_get_target :: Ptr Binding -> -- _obj : TInterface "GObject" "Binding" IO (Ptr Object) bindingGetTarget :: (MonadIO m, BindingK a) => a -> -- _obj m Object bindingGetTarget _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_binding_get_target _obj' checkUnexpectedReturnNULL "g_binding_get_target" result result' <- (newObject Object) result touchManagedPtr _obj return result' -- method Binding::get_target_property -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Binding", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Binding", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_binding_get_target_property" g_binding_get_target_property :: Ptr Binding -> -- _obj : TInterface "GObject" "Binding" IO CString bindingGetTargetProperty :: (MonadIO m, BindingK a) => a -> -- _obj m T.Text bindingGetTargetProperty _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_binding_get_target_property _obj' checkUnexpectedReturnNULL "g_binding_get_target_property" result result' <- cstringToText result touchManagedPtr _obj return result' -- method Binding::unbind -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Binding", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Binding", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_binding_unbind" g_binding_unbind :: Ptr Binding -> -- _obj : TInterface "GObject" "Binding" IO () bindingUnbind :: (MonadIO m, BindingK a) => a -> -- _obj m () bindingUnbind _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_binding_unbind _obj' touchManagedPtr _obj return () -- Flags BindingFlags data BindingFlags = BindingFlagsDefault | BindingFlagsBidirectional | BindingFlagsSyncCreate | BindingFlagsInvertBoolean | AnotherBindingFlags Int deriving (Show, Eq) instance Enum BindingFlags where fromEnum BindingFlagsDefault = 0 fromEnum BindingFlagsBidirectional = 1 fromEnum BindingFlagsSyncCreate = 2 fromEnum BindingFlagsInvertBoolean = 4 fromEnum (AnotherBindingFlags k) = k toEnum 0 = BindingFlagsDefault toEnum 1 = BindingFlagsBidirectional toEnum 2 = BindingFlagsSyncCreate toEnum 4 = BindingFlagsInvertBoolean toEnum k = AnotherBindingFlags k foreign import ccall "g_binding_flags_get_type" c_g_binding_flags_get_type :: IO GType instance BoxedEnum BindingFlags where boxedEnumType _ = c_g_binding_flags_get_type instance IsGFlag BindingFlags -- callback BindingTransformFunc bindingTransformFuncClosure :: BindingTransformFunc -> IO Closure bindingTransformFuncClosure cb = newCClosure =<< mkBindingTransformFunc wrapped where wrapped = bindingTransformFuncWrapper Nothing cb type BindingTransformFuncC = Ptr Binding -> Ptr GValue -> Ptr GValue -> Ptr () -> IO CInt foreign import ccall "wrapper" mkBindingTransformFunc :: BindingTransformFuncC -> IO (FunPtr BindingTransformFuncC) type BindingTransformFunc = Binding -> GValue -> GValue -> IO Bool noBindingTransformFunc :: Maybe BindingTransformFunc noBindingTransformFunc = Nothing bindingTransformFuncWrapper :: Maybe (Ptr (FunPtr (BindingTransformFuncC))) -> BindingTransformFunc -> Ptr Binding -> Ptr GValue -> Ptr GValue -> Ptr () -> IO CInt bindingTransformFuncWrapper funptrptr _cb binding from_value to_value _ = do binding' <- (newObject Binding) binding from_value' <- (newBoxed GValue) from_value to_value' <- (newBoxed GValue) to_value result <- _cb binding' from_value' to_value' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback BoxedFreeFunc boxedFreeFuncClosure :: BoxedFreeFunc -> IO Closure boxedFreeFuncClosure cb = newCClosure =<< mkBoxedFreeFunc wrapped where wrapped = boxedFreeFuncWrapper Nothing cb type BoxedFreeFuncC = Ptr () -> IO () foreign import ccall "wrapper" mkBoxedFreeFunc :: BoxedFreeFuncC -> IO (FunPtr BoxedFreeFuncC) type BoxedFreeFunc = Ptr () -> IO () noBoxedFreeFunc :: Maybe BoxedFreeFunc noBoxedFreeFunc = Nothing boxedFreeFuncWrapper :: Maybe (Ptr (FunPtr (BoxedFreeFuncC))) -> BoxedFreeFunc -> Ptr () -> IO () boxedFreeFuncWrapper funptrptr _cb boxed = do _cb boxed maybeReleaseFunPtr funptrptr -- struct CClosure newtype CClosure = CClosure (ForeignPtr CClosure) noCClosure :: Maybe CClosure noCClosure = Nothing cClosureReadClosure :: CClosure -> IO Closure cClosureReadClosure s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr Closure) val' <- (newBoxed Closure) val return val' cClosureReadCallback :: CClosure -> IO (Ptr ()) cClosureReadCallback s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 64) :: IO (Ptr ()) return val -- callback Callback callbackClosure :: Callback -> IO Closure callbackClosure cb = newCClosure =<< mkCallback wrapped where wrapped = callbackWrapper Nothing cb type CallbackC = IO () foreign import ccall "wrapper" mkCallback :: CallbackC -> IO (FunPtr CallbackC) type Callback = IO () noCallback :: Maybe Callback noCallback = Nothing callbackWrapper :: Maybe (Ptr (FunPtr (CallbackC))) -> Callback -> IO () callbackWrapper funptrptr _cb = do _cb maybeReleaseFunPtr funptrptr -- callback ClassFinalizeFunc classFinalizeFuncClosure :: ClassFinalizeFunc -> IO Closure classFinalizeFuncClosure cb = newCClosure =<< mkClassFinalizeFunc wrapped where wrapped = classFinalizeFuncWrapper Nothing cb type ClassFinalizeFuncC = Ptr () -> Ptr () -> IO () foreign import ccall "wrapper" mkClassFinalizeFunc :: ClassFinalizeFuncC -> IO (FunPtr ClassFinalizeFuncC) type ClassFinalizeFunc = Ptr () -> Ptr () -> IO () noClassFinalizeFunc :: Maybe ClassFinalizeFunc noClassFinalizeFunc = Nothing classFinalizeFuncWrapper :: Maybe (Ptr (FunPtr (ClassFinalizeFuncC))) -> ClassFinalizeFunc -> Ptr () -> Ptr () -> IO () classFinalizeFuncWrapper funptrptr _cb g_class class_data = do _cb g_class class_data maybeReleaseFunPtr funptrptr -- callback ClassInitFunc classInitFuncClosure :: ClassInitFunc -> IO Closure classInitFuncClosure cb = newCClosure =<< mkClassInitFunc wrapped where wrapped = classInitFuncWrapper Nothing cb type ClassInitFuncC = Ptr () -> Ptr () -> IO () foreign import ccall "wrapper" mkClassInitFunc :: ClassInitFuncC -> IO (FunPtr ClassInitFuncC) type ClassInitFunc = Ptr () -> Ptr () -> IO () noClassInitFunc :: Maybe ClassInitFunc noClassInitFunc = Nothing classInitFuncWrapper :: Maybe (Ptr (FunPtr (ClassInitFuncC))) -> ClassInitFunc -> Ptr () -> Ptr () -> IO () classInitFuncWrapper funptrptr _cb g_class class_data = do _cb g_class class_data maybeReleaseFunPtr funptrptr -- callback ClosureNotify closureNotifyClosure :: ClosureNotify -> IO Closure closureNotifyClosure cb = newCClosure =<< mkClosureNotify wrapped where wrapped = closureNotifyWrapper Nothing cb type ClosureNotifyC = Ptr () -> Ptr Closure -> IO () foreign import ccall "wrapper" mkClosureNotify :: ClosureNotifyC -> IO (FunPtr ClosureNotifyC) type ClosureNotify = Ptr () -> Closure -> IO () noClosureNotify :: Maybe ClosureNotify noClosureNotify = Nothing closureNotifyWrapper :: Maybe (Ptr (FunPtr (ClosureNotifyC))) -> ClosureNotify -> Ptr () -> Ptr Closure -> IO () closureNotifyWrapper funptrptr _cb data_ closure = do closure' <- (newBoxed Closure) closure _cb data_ closure' maybeReleaseFunPtr funptrptr -- struct ClosureNotifyData newtype ClosureNotifyData = ClosureNotifyData (ForeignPtr ClosureNotifyData) noClosureNotifyData :: Maybe ClosureNotifyData noClosureNotifyData = Nothing closureNotifyDataReadData :: ClosureNotifyData -> IO (Ptr ()) closureNotifyDataReadData s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr ()) return val -- XXX Skipped getter for "ClosureNotifyData:notify" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- Flags ConnectFlags data ConnectFlags = ConnectFlagsAfter | ConnectFlagsSwapped | AnotherConnectFlags Int deriving (Show, Eq) instance Enum ConnectFlags where fromEnum ConnectFlagsAfter = 1 fromEnum ConnectFlagsSwapped = 2 fromEnum (AnotherConnectFlags k) = k toEnum 1 = ConnectFlagsAfter toEnum 2 = ConnectFlagsSwapped toEnum k = AnotherConnectFlags k instance IsGFlag ConnectFlags -- struct EnumClass newtype EnumClass = EnumClass (ForeignPtr EnumClass) noEnumClass :: Maybe EnumClass noEnumClass = Nothing enumClassReadGTypeClass :: EnumClass -> IO TypeClass enumClassReadGTypeClass s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr TypeClass) val' <- (newPtr 8 TypeClass) val return val' enumClassReadMinimum :: EnumClass -> IO Int32 enumClassReadMinimum s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Int32 return val enumClassReadMaximum :: EnumClass -> IO Int32 enumClassReadMaximum s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO Int32 return val enumClassReadNValues :: EnumClass -> IO Word32 enumClassReadNValues s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Word32 return val enumClassReadValues :: EnumClass -> IO EnumValue enumClassReadValues s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO (Ptr EnumValue) val' <- (newPtr 24 EnumValue) val return val' -- struct EnumValue newtype EnumValue = EnumValue (ForeignPtr EnumValue) noEnumValue :: Maybe EnumValue noEnumValue = Nothing enumValueReadValue :: EnumValue -> IO Int32 enumValueReadValue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val enumValueReadValueName :: EnumValue -> IO T.Text enumValueReadValueName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' enumValueReadValueNick :: EnumValue -> IO T.Text enumValueReadValueNick s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CString val' <- cstringToText val return val' -- struct FlagsClass newtype FlagsClass = FlagsClass (ForeignPtr FlagsClass) noFlagsClass :: Maybe FlagsClass noFlagsClass = Nothing flagsClassReadGTypeClass :: FlagsClass -> IO TypeClass flagsClassReadGTypeClass s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr TypeClass) val' <- (newPtr 8 TypeClass) val return val' flagsClassReadMask :: FlagsClass -> IO Word32 flagsClassReadMask s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word32 return val flagsClassReadNValues :: FlagsClass -> IO Word32 flagsClassReadNValues s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO Word32 return val flagsClassReadValues :: FlagsClass -> IO FlagsValue flagsClassReadValues s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr FlagsValue) val' <- (newPtr 24 FlagsValue) val return val' -- struct FlagsValue newtype FlagsValue = FlagsValue (ForeignPtr FlagsValue) noFlagsValue :: Maybe FlagsValue noFlagsValue = Nothing flagsValueReadValue :: FlagsValue -> IO Word32 flagsValueReadValue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word32 return val flagsValueReadValueName :: FlagsValue -> IO T.Text flagsValueReadValueName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' flagsValueReadValueNick :: FlagsValue -> IO T.Text flagsValueReadValueNick s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CString val' <- cstringToText val return val' -- object InitiallyUnowned newtype InitiallyUnowned = InitiallyUnowned (ForeignPtr InitiallyUnowned) noInitiallyUnowned :: Maybe InitiallyUnowned noInitiallyUnowned = Nothing foreign import ccall "g_initially_unowned_get_type" c_g_initially_unowned_get_type :: IO GType type instance ParentTypes InitiallyUnowned = '[Object] instance GObject InitiallyUnowned where gobjectIsInitiallyUnowned _ = True gobjectType _ = c_g_initially_unowned_get_type class GObject o => InitiallyUnownedK o instance (GObject o, IsDescendantOf InitiallyUnowned o) => InitiallyUnownedK o toInitiallyUnowned :: InitiallyUnownedK o => o -> IO InitiallyUnowned toInitiallyUnowned = unsafeCastTo InitiallyUnowned -- callback InstanceInitFunc instanceInitFuncClosure :: InstanceInitFunc -> IO Closure instanceInitFuncClosure cb = newCClosure =<< mkInstanceInitFunc wrapped where wrapped = instanceInitFuncWrapper Nothing cb type InstanceInitFuncC = Ptr TypeInstance -> Ptr () -> IO () foreign import ccall "wrapper" mkInstanceInitFunc :: InstanceInitFuncC -> IO (FunPtr InstanceInitFuncC) type InstanceInitFunc = TypeInstance -> Ptr () -> IO () noInstanceInitFunc :: Maybe InstanceInitFunc noInstanceInitFunc = Nothing instanceInitFuncWrapper :: Maybe (Ptr (FunPtr (InstanceInitFuncC))) -> InstanceInitFunc -> Ptr TypeInstance -> Ptr () -> IO () instanceInitFuncWrapper funptrptr _cb instance_ g_class = do instance_' <- (newPtr 8 TypeInstance) instance_ _cb instance_' g_class maybeReleaseFunPtr funptrptr -- callback InterfaceFinalizeFunc interfaceFinalizeFuncClosure :: InterfaceFinalizeFunc -> IO Closure interfaceFinalizeFuncClosure cb = newCClosure =<< mkInterfaceFinalizeFunc wrapped where wrapped = interfaceFinalizeFuncWrapper Nothing cb type InterfaceFinalizeFuncC = Ptr () -> Ptr () -> IO () foreign import ccall "wrapper" mkInterfaceFinalizeFunc :: InterfaceFinalizeFuncC -> IO (FunPtr InterfaceFinalizeFuncC) type InterfaceFinalizeFunc = Ptr () -> Ptr () -> IO () noInterfaceFinalizeFunc :: Maybe InterfaceFinalizeFunc noInterfaceFinalizeFunc = Nothing interfaceFinalizeFuncWrapper :: Maybe (Ptr (FunPtr (InterfaceFinalizeFuncC))) -> InterfaceFinalizeFunc -> Ptr () -> Ptr () -> IO () interfaceFinalizeFuncWrapper funptrptr _cb g_iface iface_data = do _cb g_iface iface_data maybeReleaseFunPtr funptrptr -- struct InterfaceInfo newtype InterfaceInfo = InterfaceInfo (ForeignPtr InterfaceInfo) noInterfaceInfo :: Maybe InterfaceInfo noInterfaceInfo = Nothing -- XXX Skipped getter for "InterfaceInfo:interface_init" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "InterfaceInfo:interface_finalize" :: Not implemented: "Wrapping foreign callbacks is not supported yet" interfaceInfoReadInterfaceData :: InterfaceInfo -> IO (Ptr ()) interfaceInfoReadInterfaceData s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr ()) return val -- callback InterfaceInitFunc interfaceInitFuncClosure :: InterfaceInitFunc -> IO Closure interfaceInitFuncClosure cb = newCClosure =<< mkInterfaceInitFunc wrapped where wrapped = interfaceInitFuncWrapper Nothing cb type InterfaceInitFuncC = Ptr () -> Ptr () -> IO () foreign import ccall "wrapper" mkInterfaceInitFunc :: InterfaceInitFuncC -> IO (FunPtr InterfaceInitFuncC) type InterfaceInitFunc = Ptr () -> Ptr () -> IO () noInterfaceInitFunc :: Maybe InterfaceInitFunc noInterfaceInitFunc = Nothing interfaceInitFuncWrapper :: Maybe (Ptr (FunPtr (InterfaceInitFuncC))) -> InterfaceInitFunc -> Ptr () -> Ptr () -> IO () interfaceInitFuncWrapper funptrptr _cb g_iface iface_data = do _cb g_iface iface_data maybeReleaseFunPtr funptrptr -- object Object newtype Object = Object (ForeignPtr Object) noObject :: Maybe Object noObject = Nothing foreign import ccall "g_object_get_type" c_g_object_get_type :: IO GType type instance ParentTypes Object = '[] instance GObject Object where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_object_get_type class GObject o => ObjectK o instance (GObject o, IsDescendantOf Object o) => ObjectK o toObject :: ObjectK o => o -> IO Object toObject = unsafeCastTo Object -- method Object::new -- method type : Constructor -- Args : [Arg {argName = "object_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_parameters", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TCArray False (-1) 1 (TInterface "GObject" "Parameter"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [Arg {argName = "n_parameters", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- hInArgs : [Arg {argName = "object_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parameters", argType = TCArray False (-1) 1 (TInterface "GObject" "Parameter"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Object" -- throws : False -- Skip return : False foreign import ccall "g_object_newv" g_object_newv :: CGType -> -- object_type : TBasicType TGType Word32 -> -- n_parameters : TBasicType TUInt32 Ptr Parameter -> -- parameters : TCArray False (-1) 1 (TInterface "GObject" "Parameter") IO (Ptr Object) objectNew :: (MonadIO m) => GType -> -- object_type [Parameter] -> -- parameters m Object objectNew object_type parameters = liftIO $ do let n_parameters = fromIntegral $ length parameters let object_type' = gtypeToCGType object_type let parameters' = map unsafeManagedPtrGetPtr parameters parameters'' <- packBlockArray 32 parameters' result <- g_object_newv object_type' n_parameters parameters'' checkUnexpectedReturnNULL "g_object_newv" result result' <- (wrapObject Object) result mapM_ touchManagedPtr parameters freeMem parameters'' return result' -- method Object::bind_property -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target_property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "BindingFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target_property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "BindingFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Binding" -- throws : False -- Skip return : False foreign import ccall "g_object_bind_property" g_object_bind_property :: Ptr Object -> -- _obj : TInterface "GObject" "Object" CString -> -- source_property : TBasicType TUTF8 Ptr Object -> -- target : TInterface "GObject" "Object" CString -> -- target_property : TBasicType TUTF8 CUInt -> -- flags : TInterface "GObject" "BindingFlags" IO (Ptr Binding) objectBindProperty :: (MonadIO m, ObjectK a, ObjectK b) => a -> -- _obj T.Text -> -- source_property b -> -- target T.Text -> -- target_property [BindingFlags] -> -- flags m Binding objectBindProperty _obj source_property target target_property flags = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj source_property' <- textToCString source_property let target' = unsafeManagedPtrCastPtr target target_property' <- textToCString target_property let flags' = gflagsToWord flags result <- g_object_bind_property _obj' source_property' target' target_property' flags' checkUnexpectedReturnNULL "g_object_bind_property" result result' <- (newObject Binding) result touchManagedPtr _obj touchManagedPtr target freeMem source_property' freeMem target_property' return result' -- method Object::bind_property_full -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target_property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "BindingFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "transform_to", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "transform_from", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "source_property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target_property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "BindingFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "transform_to", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "transform_from", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Binding" -- throws : False -- Skip return : False foreign import ccall "g_object_bind_property_with_closures" g_object_bind_property_with_closures :: Ptr Object -> -- _obj : TInterface "GObject" "Object" CString -> -- source_property : TBasicType TUTF8 Ptr Object -> -- target : TInterface "GObject" "Object" CString -> -- target_property : TBasicType TUTF8 CUInt -> -- flags : TInterface "GObject" "BindingFlags" Ptr Closure -> -- transform_to : TInterface "GObject" "Closure" Ptr Closure -> -- transform_from : TInterface "GObject" "Closure" IO (Ptr Binding) objectBindPropertyFull :: (MonadIO m, ObjectK a, ObjectK b) => a -> -- _obj T.Text -> -- source_property b -> -- target T.Text -> -- target_property [BindingFlags] -> -- flags Closure -> -- transform_to Closure -> -- transform_from m Binding objectBindPropertyFull _obj source_property target target_property flags transform_to transform_from = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj source_property' <- textToCString source_property let target' = unsafeManagedPtrCastPtr target target_property' <- textToCString target_property let flags' = gflagsToWord flags let transform_to' = unsafeManagedPtrGetPtr transform_to let transform_from' = unsafeManagedPtrGetPtr transform_from result <- g_object_bind_property_with_closures _obj' source_property' target' target_property' flags' transform_to' transform_from' checkUnexpectedReturnNULL "g_object_bind_property_with_closures" result result' <- (newObject Binding) result touchManagedPtr _obj touchManagedPtr target touchManagedPtr transform_to touchManagedPtr transform_from freeMem source_property' freeMem target_property' return result' -- method Object::force_floating -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_force_floating" g_object_force_floating :: Ptr Object -> -- _obj : TInterface "GObject" "Object" IO () objectForceFloating :: (MonadIO m, ObjectK a) => a -> -- _obj m () objectForceFloating _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_object_force_floating _obj' touchManagedPtr _obj return () -- method Object::freeze_notify -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_freeze_notify" g_object_freeze_notify :: Ptr Object -> -- _obj : TInterface "GObject" "Object" IO () objectFreezeNotify :: (MonadIO m, ObjectK a) => a -> -- _obj m () objectFreezeNotify _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_object_freeze_notify _obj' touchManagedPtr _obj return () -- method Object::get_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_get_data" g_object_get_data :: Ptr Object -> -- _obj : TInterface "GObject" "Object" CString -> -- key : TBasicType TUTF8 IO () objectGetData :: (MonadIO m, ObjectK a) => a -> -- _obj T.Text -> -- key m () objectGetData _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key g_object_get_data _obj' key' touchManagedPtr _obj freeMem key' return () -- method Object::get_property -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_get_property" g_object_get_property :: Ptr Object -> -- _obj : TInterface "GObject" "Object" CString -> -- property_name : TBasicType TUTF8 Ptr GValue -> -- value : TInterface "GObject" "Value" IO () objectGetProperty :: (MonadIO m, ObjectK a) => a -> -- _obj T.Text -> -- property_name GValue -> -- value m () objectGetProperty _obj property_name value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj property_name' <- textToCString property_name let value' = unsafeManagedPtrGetPtr value g_object_get_property _obj' property_name' value' touchManagedPtr _obj touchManagedPtr value freeMem property_name' return () -- method Object::get_qdata -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_get_qdata" g_object_get_qdata :: Ptr Object -> -- _obj : TInterface "GObject" "Object" Word32 -> -- quark : TBasicType TUInt32 IO () objectGetQdata :: (MonadIO m, ObjectK a) => a -> -- _obj Word32 -> -- quark m () objectGetQdata _obj quark = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_object_get_qdata _obj' quark touchManagedPtr _obj return () -- method Object::is_floating -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_object_is_floating" g_object_is_floating :: Ptr Object -> -- _obj : TInterface "GObject" "Object" IO CInt objectIsFloating :: (MonadIO m, ObjectK a) => a -> -- _obj m Bool objectIsFloating _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_object_is_floating _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- method Object::notify -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_notify" g_object_notify :: Ptr Object -> -- _obj : TInterface "GObject" "Object" CString -> -- property_name : TBasicType TUTF8 IO () objectNotify :: (MonadIO m, ObjectK a) => a -> -- _obj T.Text -> -- property_name m () objectNotify _obj property_name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj property_name' <- textToCString property_name g_object_notify _obj' property_name' touchManagedPtr _obj freeMem property_name' return () -- method Object::notify_by_pspec -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_notify_by_pspec" g_object_notify_by_pspec :: Ptr Object -> -- _obj : TInterface "GObject" "Object" Ptr GParamSpec -> -- pspec : TParamSpec IO () objectNotifyByPspec :: (MonadIO m, ObjectK a) => a -> -- _obj GParamSpec -> -- pspec m () objectNotifyByPspec _obj pspec = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let pspec' = unsafeManagedPtrGetPtr pspec g_object_notify_by_pspec _obj' pspec' touchManagedPtr _obj return () -- method Object::ref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Object" -- throws : False -- Skip return : False foreign import ccall "g_object_ref" g_object_ref :: Ptr Object -> -- _obj : TInterface "GObject" "Object" IO (Ptr Object) objectRef :: (MonadIO m, ObjectK a) => a -> -- _obj m Object objectRef _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_object_ref _obj' checkUnexpectedReturnNULL "g_object_ref" result result' <- (newObject Object) result touchManagedPtr _obj return result' -- method Object::ref_sink -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Object" -- throws : False -- Skip return : False foreign import ccall "g_object_ref_sink" g_object_ref_sink :: Ptr Object -> -- _obj : TInterface "GObject" "Object" IO (Ptr Object) objectRefSink :: (MonadIO m, ObjectK a) => a -> -- _obj m Object objectRefSink _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_object_ref_sink _obj' checkUnexpectedReturnNULL "g_object_ref_sink" result result' <- (newObject Object) result touchManagedPtr _obj return result' -- method Object::replace_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "oldval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "oldval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_object_replace_data" g_object_replace_data :: Ptr Object -> -- _obj : TInterface "GObject" "Object" CString -> -- key : TBasicType TUTF8 Ptr () -> -- oldval : TBasicType TVoid Ptr () -> -- newval : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- destroy : TInterface "GLib" "DestroyNotify" FunPtr GLib.DestroyNotifyC -> -- old_destroy : TInterface "GLib" "DestroyNotify" IO CInt objectReplaceData :: (MonadIO m, ObjectK a) => a -> -- _obj T.Text -> -- key Maybe (Ptr ()) -> -- oldval Maybe (Ptr ()) -> -- newval Maybe (GLib.DestroyNotify) -> -- destroy Maybe (GLib.DestroyNotify) -> -- old_destroy m Bool objectReplaceData _obj key oldval newval destroy old_destroy = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key maybeOldval <- case oldval of Nothing -> return nullPtr Just jOldval -> do return jOldval maybeNewval <- case newval of Nothing -> return nullPtr Just jNewval -> do return jNewval ptrdestroy <- callocMem :: IO (Ptr (FunPtr GLib.DestroyNotifyC)) maybeDestroy <- case destroy of Nothing -> return (castPtrToFunPtr nullPtr) Just jDestroy -> do jDestroy' <- GLib.mkDestroyNotify (GLib.destroyNotifyWrapper (Just ptrdestroy) jDestroy) poke ptrdestroy jDestroy' return jDestroy' ptrold_destroy <- callocMem :: IO (Ptr (FunPtr GLib.DestroyNotifyC)) maybeOld_destroy <- case old_destroy of Nothing -> return (castPtrToFunPtr nullPtr) Just jOld_destroy -> do jOld_destroy' <- GLib.mkDestroyNotify (GLib.destroyNotifyWrapper (Just ptrold_destroy) jOld_destroy) poke ptrold_destroy jOld_destroy' return jOld_destroy' result <- g_object_replace_data _obj' key' maybeOldval maybeNewval maybeDestroy maybeOld_destroy let result' = (/= 0) result touchManagedPtr _obj freeMem key' return result' -- method Object::replace_qdata -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "oldval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "oldval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "newval", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "old_destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_object_replace_qdata" g_object_replace_qdata :: Ptr Object -> -- _obj : TInterface "GObject" "Object" Word32 -> -- quark : TBasicType TUInt32 Ptr () -> -- oldval : TBasicType TVoid Ptr () -> -- newval : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- destroy : TInterface "GLib" "DestroyNotify" FunPtr GLib.DestroyNotifyC -> -- old_destroy : TInterface "GLib" "DestroyNotify" IO CInt objectReplaceQdata :: (MonadIO m, ObjectK a) => a -> -- _obj Word32 -> -- quark Maybe (Ptr ()) -> -- oldval Maybe (Ptr ()) -> -- newval Maybe (GLib.DestroyNotify) -> -- destroy Maybe (GLib.DestroyNotify) -> -- old_destroy m Bool objectReplaceQdata _obj quark oldval newval destroy old_destroy = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj maybeOldval <- case oldval of Nothing -> return nullPtr Just jOldval -> do return jOldval maybeNewval <- case newval of Nothing -> return nullPtr Just jNewval -> do return jNewval ptrdestroy <- callocMem :: IO (Ptr (FunPtr GLib.DestroyNotifyC)) maybeDestroy <- case destroy of Nothing -> return (castPtrToFunPtr nullPtr) Just jDestroy -> do jDestroy' <- GLib.mkDestroyNotify (GLib.destroyNotifyWrapper (Just ptrdestroy) jDestroy) poke ptrdestroy jDestroy' return jDestroy' ptrold_destroy <- callocMem :: IO (Ptr (FunPtr GLib.DestroyNotifyC)) maybeOld_destroy <- case old_destroy of Nothing -> return (castPtrToFunPtr nullPtr) Just jOld_destroy -> do jOld_destroy' <- GLib.mkDestroyNotify (GLib.destroyNotifyWrapper (Just ptrold_destroy) jOld_destroy) poke ptrold_destroy jOld_destroy' return jOld_destroy' result <- g_object_replace_qdata _obj' quark maybeOldval maybeNewval maybeDestroy maybeOld_destroy let result' = (/= 0) result touchManagedPtr _obj return result' -- method Object::run_dispose -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_run_dispose" g_object_run_dispose :: Ptr Object -> -- _obj : TInterface "GObject" "Object" IO () objectRunDispose :: (MonadIO m, ObjectK a) => a -> -- _obj m () objectRunDispose _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_object_run_dispose _obj' touchManagedPtr _obj return () -- method Object::set_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_set_data" g_object_set_data :: Ptr Object -> -- _obj : TInterface "GObject" "Object" CString -> -- key : TBasicType TUTF8 Ptr () -> -- data : TBasicType TVoid IO () objectSetData :: (MonadIO m, ObjectK a) => a -> -- _obj T.Text -> -- key Ptr () -> -- data m () objectSetData _obj key data_ = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key g_object_set_data _obj' key' data_ touchManagedPtr _obj freeMem key' return () -- method Object::set_property -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_set_property" g_object_set_property :: Ptr Object -> -- _obj : TInterface "GObject" "Object" CString -> -- property_name : TBasicType TUTF8 Ptr GValue -> -- value : TInterface "GObject" "Value" IO () objectSetProperty :: (MonadIO m, ObjectK a) => a -> -- _obj T.Text -> -- property_name GValue -> -- value m () objectSetProperty _obj property_name value = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj property_name' <- textToCString property_name let value' = unsafeManagedPtrGetPtr value g_object_set_property _obj' property_name' value' touchManagedPtr _obj touchManagedPtr value freeMem property_name' return () -- method Object::steal_data -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_steal_data" g_object_steal_data :: Ptr Object -> -- _obj : TInterface "GObject" "Object" CString -> -- key : TBasicType TUTF8 IO () objectStealData :: (MonadIO m, ObjectK a) => a -> -- _obj T.Text -> -- key m () objectStealData _obj key = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj key' <- textToCString key g_object_steal_data _obj' key' touchManagedPtr _obj freeMem key' return () -- method Object::steal_qdata -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_steal_qdata" g_object_steal_qdata :: Ptr Object -> -- _obj : TInterface "GObject" "Object" Word32 -> -- quark : TBasicType TUInt32 IO () objectStealQdata :: (MonadIO m, ObjectK a) => a -> -- _obj Word32 -> -- quark m () objectStealQdata _obj quark = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_object_steal_qdata _obj' quark touchManagedPtr _obj return () -- method Object::thaw_notify -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_thaw_notify" g_object_thaw_notify :: Ptr Object -> -- _obj : TInterface "GObject" "Object" IO () objectThawNotify :: (MonadIO m, ObjectK a) => a -> -- _obj m () objectThawNotify _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_object_thaw_notify _obj' touchManagedPtr _obj return () -- method Object::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_unref" g_object_unref :: Ptr Object -> -- _obj : TInterface "GObject" "Object" IO () objectUnref :: (MonadIO m, ObjectK a) => a -> -- _obj m () objectUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_object_unref _obj' touchManagedPtr _obj return () -- method Object::watch_closure -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_watch_closure" g_object_watch_closure :: Ptr Object -> -- _obj : TInterface "GObject" "Object" Ptr Closure -> -- closure : TInterface "GObject" "Closure" IO () objectWatchClosure :: (MonadIO m, ObjectK a) => a -> -- _obj Closure -> -- closure m () objectWatchClosure _obj closure = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let closure' = unsafeManagedPtrGetPtr closure g_object_watch_closure _obj' closure' touchManagedPtr _obj touchManagedPtr closure return () -- method Object::compat_control -- method type : MemberFunction -- Args : [Arg {argName = "what", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "what", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_object_compat_control" g_object_compat_control :: Word64 -> -- what : TBasicType TUInt64 Ptr () -> -- data : TBasicType TVoid IO Word64 objectCompatControl :: (MonadIO m) => Word64 -> -- what Ptr () -> -- data m Word64 objectCompatControl what data_ = liftIO $ do result <- g_object_compat_control what data_ return result -- method Object::interface_find_property -- method type : MemberFunction -- Args : [Arg {argName = "g_iface", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "g_iface", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_object_interface_find_property" g_object_interface_find_property :: Ptr () -> -- g_iface : TBasicType TVoid CString -> -- property_name : TBasicType TUTF8 IO (Ptr GParamSpec) objectInterfaceFindProperty :: (MonadIO m) => Ptr () -> -- g_iface T.Text -> -- property_name m GParamSpec objectInterfaceFindProperty g_iface property_name = liftIO $ do property_name' <- textToCString property_name result <- g_object_interface_find_property g_iface property_name' checkUnexpectedReturnNULL "g_object_interface_find_property" result result' <- newGParamSpecFromPtr result freeMem property_name' return result' -- method Object::interface_install_property -- method type : MemberFunction -- Args : [Arg {argName = "g_iface", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "g_iface", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_object_interface_install_property" g_object_interface_install_property :: Ptr () -> -- g_iface : TBasicType TVoid Ptr GParamSpec -> -- pspec : TParamSpec IO () objectInterfaceInstallProperty :: (MonadIO m) => Ptr () -> -- g_iface GParamSpec -> -- pspec m () objectInterfaceInstallProperty g_iface pspec = liftIO $ do let pspec' = unsafeManagedPtrGetPtr pspec g_object_interface_install_property g_iface pspec' return () -- XXX Could not generate method Object::interface_list_properties -- Error was : Not implemented: "unpackCArray : Don't know how to unpack C Array of type TParamSpec" -- signal Object::notify type ObjectNotifyCallback = GParamSpec -> IO () noObjectNotifyCallback :: Maybe ObjectNotifyCallback noObjectNotifyCallback = Nothing type ObjectNotifyCallbackC = Ptr () -> -- object Ptr GParamSpec -> Ptr () -> -- user_data IO () foreign import ccall "wrapper" mkObjectNotifyCallback :: ObjectNotifyCallbackC -> IO (FunPtr ObjectNotifyCallbackC) objectNotifyClosure :: ObjectNotifyCallback -> IO Closure objectNotifyClosure cb = newCClosure =<< mkObjectNotifyCallback wrapped where wrapped = objectNotifyCallbackWrapper cb objectNotifyCallbackWrapper :: ObjectNotifyCallback -> Ptr () -> Ptr GParamSpec -> Ptr () -> IO () objectNotifyCallbackWrapper _cb _ pspec _ = do pspec' <- newGParamSpecFromPtr pspec _cb pspec' onObjectNotify :: (GObject a, MonadIO m) => a -> ObjectNotifyCallback -> m SignalHandlerId onObjectNotify obj cb = liftIO $ connectObjectNotify obj cb SignalConnectBefore afterObjectNotify :: (GObject a, MonadIO m) => a -> ObjectNotifyCallback -> m SignalHandlerId afterObjectNotify obj cb = connectObjectNotify obj cb SignalConnectAfter connectObjectNotify :: (GObject a, MonadIO m) => a -> ObjectNotifyCallback -> SignalConnectMode -> m SignalHandlerId connectObjectNotify obj cb after = liftIO $ do cb' <- mkObjectNotifyCallback (objectNotifyCallbackWrapper cb) connectSignalFunPtr obj "notify" cb' after -- struct ObjectConstructParam newtype ObjectConstructParam = ObjectConstructParam (ForeignPtr ObjectConstructParam) noObjectConstructParam :: Maybe ObjectConstructParam noObjectConstructParam = Nothing objectConstructParamReadPspec :: ObjectConstructParam -> IO GParamSpec objectConstructParamReadPspec s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr GParamSpec) val' <- newGParamSpecFromPtr val return val' objectConstructParamReadValue :: ObjectConstructParam -> IO GValue objectConstructParamReadValue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr GValue) val' <- (newBoxed GValue) val return val' -- callback ObjectFinalizeFunc objectFinalizeFuncClosure :: ObjectFinalizeFunc -> IO Closure objectFinalizeFuncClosure cb = newCClosure =<< mkObjectFinalizeFunc wrapped where wrapped = objectFinalizeFuncWrapper Nothing cb type ObjectFinalizeFuncC = Ptr Object -> IO () foreign import ccall "wrapper" mkObjectFinalizeFunc :: ObjectFinalizeFuncC -> IO (FunPtr ObjectFinalizeFuncC) type ObjectFinalizeFunc = Object -> IO () noObjectFinalizeFunc :: Maybe ObjectFinalizeFunc noObjectFinalizeFunc = Nothing objectFinalizeFuncWrapper :: Maybe (Ptr (FunPtr (ObjectFinalizeFuncC))) -> ObjectFinalizeFunc -> Ptr Object -> IO () objectFinalizeFuncWrapper funptrptr _cb object = do object' <- (newObject Object) object _cb object' maybeReleaseFunPtr funptrptr -- callback ObjectGetPropertyFunc objectGetPropertyFuncClosure :: ObjectGetPropertyFunc -> IO Closure objectGetPropertyFuncClosure cb = newCClosure =<< mkObjectGetPropertyFunc wrapped where wrapped = objectGetPropertyFuncWrapper Nothing cb type ObjectGetPropertyFuncC = Ptr Object -> Word32 -> Ptr GValue -> Ptr GParamSpec -> IO () foreign import ccall "wrapper" mkObjectGetPropertyFunc :: ObjectGetPropertyFuncC -> IO (FunPtr ObjectGetPropertyFuncC) type ObjectGetPropertyFunc = Object -> Word32 -> GValue -> GParamSpec -> IO () noObjectGetPropertyFunc :: Maybe ObjectGetPropertyFunc noObjectGetPropertyFunc = Nothing objectGetPropertyFuncWrapper :: Maybe (Ptr (FunPtr (ObjectGetPropertyFuncC))) -> ObjectGetPropertyFunc -> Ptr Object -> Word32 -> Ptr GValue -> Ptr GParamSpec -> IO () objectGetPropertyFuncWrapper funptrptr _cb object property_id value pspec = do object' <- (newObject Object) object value' <- (newBoxed GValue) value pspec' <- newGParamSpecFromPtr pspec _cb object' property_id value' pspec' maybeReleaseFunPtr funptrptr -- callback ObjectSetPropertyFunc objectSetPropertyFuncClosure :: ObjectSetPropertyFunc -> IO Closure objectSetPropertyFuncClosure cb = newCClosure =<< mkObjectSetPropertyFunc wrapped where wrapped = objectSetPropertyFuncWrapper Nothing cb type ObjectSetPropertyFuncC = Ptr Object -> Word32 -> Ptr GValue -> Ptr GParamSpec -> IO () foreign import ccall "wrapper" mkObjectSetPropertyFunc :: ObjectSetPropertyFuncC -> IO (FunPtr ObjectSetPropertyFuncC) type ObjectSetPropertyFunc = Object -> Word32 -> GValue -> GParamSpec -> IO () noObjectSetPropertyFunc :: Maybe ObjectSetPropertyFunc noObjectSetPropertyFunc = Nothing objectSetPropertyFuncWrapper :: Maybe (Ptr (FunPtr (ObjectSetPropertyFuncC))) -> ObjectSetPropertyFunc -> Ptr Object -> Word32 -> Ptr GValue -> Ptr GParamSpec -> IO () objectSetPropertyFuncWrapper funptrptr _cb object property_id value pspec = do object' <- (newObject Object) object value' <- (newBoxed GValue) value pspec' <- newGParamSpecFromPtr pspec _cb object' property_id value' pspec' maybeReleaseFunPtr funptrptr -- Flags ParamFlags data ParamFlags = ParamFlagsReadable | ParamFlagsWritable | ParamFlagsReadwrite | ParamFlagsConstruct | ParamFlagsConstructOnly | ParamFlagsLaxValidation | ParamFlagsStaticName | ParamFlagsPrivate | ParamFlagsStaticNick | ParamFlagsStaticBlurb | ParamFlagsExplicitNotify | ParamFlagsDeprecated | AnotherParamFlags Int deriving (Show, Eq) instance Enum ParamFlags where fromEnum ParamFlagsReadable = 1 fromEnum ParamFlagsWritable = 2 fromEnum ParamFlagsReadwrite = 3 fromEnum ParamFlagsConstruct = 4 fromEnum ParamFlagsConstructOnly = 8 fromEnum ParamFlagsLaxValidation = 16 fromEnum ParamFlagsStaticName = 32 fromEnum ParamFlagsPrivate = 32 fromEnum ParamFlagsStaticNick = 64 fromEnum ParamFlagsStaticBlurb = 128 fromEnum ParamFlagsExplicitNotify = 1073741824 fromEnum ParamFlagsDeprecated = 2147483648 fromEnum (AnotherParamFlags k) = k toEnum 1 = ParamFlagsReadable toEnum 2 = ParamFlagsWritable toEnum 3 = ParamFlagsReadwrite toEnum 4 = ParamFlagsConstruct toEnum 8 = ParamFlagsConstructOnly toEnum 16 = ParamFlagsLaxValidation toEnum 32 = ParamFlagsStaticName toEnum 64 = ParamFlagsStaticNick toEnum 128 = ParamFlagsStaticBlurb toEnum 1073741824 = ParamFlagsExplicitNotify toEnum 2147483648 = ParamFlagsDeprecated toEnum k = AnotherParamFlags k instance IsGFlag ParamFlags -- struct ParamSpecPool newtype ParamSpecPool = ParamSpecPool (ForeignPtr ParamSpecPool) noParamSpecPool :: Maybe ParamSpecPool noParamSpecPool = Nothing -- method ParamSpecPool::insert -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "ParamSpecPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "owner_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "ParamSpecPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "owner_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_param_spec_pool_insert" g_param_spec_pool_insert :: Ptr ParamSpecPool -> -- _obj : TInterface "GObject" "ParamSpecPool" Ptr GParamSpec -> -- pspec : TParamSpec CGType -> -- owner_type : TBasicType TGType IO () paramSpecPoolInsert :: (MonadIO m) => ParamSpecPool -> -- _obj GParamSpec -> -- pspec GType -> -- owner_type m () paramSpecPoolInsert _obj pspec owner_type = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let pspec' = unsafeManagedPtrGetPtr pspec let owner_type' = gtypeToCGType owner_type g_param_spec_pool_insert _obj' pspec' owner_type' touchManagedPtr _obj return () -- XXX Could not generate method ParamSpecPool::list -- Error was : Not implemented: "unpackCArray : Don't know how to unpack C Array of type TParamSpec" -- method ParamSpecPool::list_owned -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "ParamSpecPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "owner_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "ParamSpecPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "owner_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TGList TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_pool_list_owned" g_param_spec_pool_list_owned :: Ptr ParamSpecPool -> -- _obj : TInterface "GObject" "ParamSpecPool" CGType -> -- owner_type : TBasicType TGType IO (Ptr (GList (Ptr GParamSpec))) paramSpecPoolListOwned :: (MonadIO m) => ParamSpecPool -> -- _obj GType -> -- owner_type m [GParamSpec] paramSpecPoolListOwned _obj owner_type = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let owner_type' = gtypeToCGType owner_type result <- g_param_spec_pool_list_owned _obj' owner_type' checkUnexpectedReturnNULL "g_param_spec_pool_list_owned" result result' <- unpackGList result result'' <- mapM newGParamSpecFromPtr result' g_list_free result touchManagedPtr _obj return result'' -- method ParamSpecPool::lookup -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "ParamSpecPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "owner_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "walk_ancestors", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "ParamSpecPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "owner_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "walk_ancestors", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_pool_lookup" g_param_spec_pool_lookup :: Ptr ParamSpecPool -> -- _obj : TInterface "GObject" "ParamSpecPool" CString -> -- param_name : TBasicType TUTF8 CGType -> -- owner_type : TBasicType TGType CInt -> -- walk_ancestors : TBasicType TBoolean IO (Ptr GParamSpec) paramSpecPoolLookup :: (MonadIO m) => ParamSpecPool -> -- _obj T.Text -> -- param_name GType -> -- owner_type Bool -> -- walk_ancestors m GParamSpec paramSpecPoolLookup _obj param_name owner_type walk_ancestors = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj param_name' <- textToCString param_name let owner_type' = gtypeToCGType owner_type let walk_ancestors' = (fromIntegral . fromEnum) walk_ancestors result <- g_param_spec_pool_lookup _obj' param_name' owner_type' walk_ancestors' checkUnexpectedReturnNULL "g_param_spec_pool_lookup" result result' <- newGParamSpecFromPtr result touchManagedPtr _obj freeMem param_name' return result' -- method ParamSpecPool::remove -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "ParamSpecPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "ParamSpecPool", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_param_spec_pool_remove" g_param_spec_pool_remove :: Ptr ParamSpecPool -> -- _obj : TInterface "GObject" "ParamSpecPool" Ptr GParamSpec -> -- pspec : TParamSpec IO () paramSpecPoolRemove :: (MonadIO m) => ParamSpecPool -> -- _obj GParamSpec -> -- pspec m () paramSpecPoolRemove _obj pspec = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let pspec' = unsafeManagedPtrGetPtr pspec g_param_spec_pool_remove _obj' pspec' touchManagedPtr _obj return () -- struct ParamSpecTypeInfo newtype ParamSpecTypeInfo = ParamSpecTypeInfo (ForeignPtr ParamSpecTypeInfo) noParamSpecTypeInfo :: Maybe ParamSpecTypeInfo noParamSpecTypeInfo = Nothing paramSpecTypeInfoReadInstanceSize :: ParamSpecTypeInfo -> IO Word16 paramSpecTypeInfoReadInstanceSize s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word16 return val paramSpecTypeInfoReadNPreallocs :: ParamSpecTypeInfo -> IO Word16 paramSpecTypeInfoReadNPreallocs s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 2) :: IO Word16 return val -- XXX Skipped getter for "ParamSpecTypeInfo:instance_init" :: Not implemented: "Wrapping foreign callbacks is not supported yet" paramSpecTypeInfoReadValueType :: ParamSpecTypeInfo -> IO GType paramSpecTypeInfoReadValueType s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CGType let val' = GType val return val' -- XXX Skipped getter for "ParamSpecTypeInfo:finalize" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "ParamSpecTypeInfo:value_set_default" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "ParamSpecTypeInfo:value_validate" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "ParamSpecTypeInfo:values_cmp" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- struct Parameter newtype Parameter = Parameter (ForeignPtr Parameter) noParameter :: Maybe Parameter noParameter = Nothing parameterReadName :: Parameter -> IO T.Text parameterReadName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CString val' <- cstringToText val return val' parameterReadValue :: Parameter -> IO GValue parameterReadValue s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr GValue) val' <- (newBoxed GValue) val return val' -- callback SignalAccumulator signalAccumulatorClosure :: SignalAccumulator -> IO Closure signalAccumulatorClosure cb = newCClosure =<< mkSignalAccumulator wrapped where wrapped = signalAccumulatorWrapper Nothing cb type SignalAccumulatorC = Ptr SignalInvocationHint -> Ptr GValue -> Ptr GValue -> Ptr () -> IO CInt foreign import ccall "wrapper" mkSignalAccumulator :: SignalAccumulatorC -> IO (FunPtr SignalAccumulatorC) type SignalAccumulator = SignalInvocationHint -> GValue -> GValue -> Ptr () -> IO Bool noSignalAccumulator :: Maybe SignalAccumulator noSignalAccumulator = Nothing signalAccumulatorWrapper :: Maybe (Ptr (FunPtr (SignalAccumulatorC))) -> SignalAccumulator -> Ptr SignalInvocationHint -> Ptr GValue -> Ptr GValue -> Ptr () -> IO CInt signalAccumulatorWrapper funptrptr _cb ihint return_accu handler_return data_ = do ihint' <- (newPtr 12 SignalInvocationHint) ihint return_accu' <- (newBoxed GValue) return_accu handler_return' <- (newBoxed GValue) handler_return result <- _cb ihint' return_accu' handler_return' data_ maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback SignalEmissionHook signalEmissionHookClosure :: SignalEmissionHook -> IO Closure signalEmissionHookClosure cb = newCClosure =<< mkSignalEmissionHook wrapped where wrapped = signalEmissionHookWrapper Nothing cb type SignalEmissionHookC = Ptr SignalInvocationHint -> Word32 -> Ptr GValue -> Ptr () -> IO CInt foreign import ccall "wrapper" mkSignalEmissionHook :: SignalEmissionHookC -> IO (FunPtr SignalEmissionHookC) type SignalEmissionHook = SignalInvocationHint -> [GValue] -> Ptr () -> IO Bool noSignalEmissionHook :: Maybe SignalEmissionHook noSignalEmissionHook = Nothing signalEmissionHookWrapper :: Maybe (Ptr (FunPtr (SignalEmissionHookC))) -> SignalEmissionHook -> Ptr SignalInvocationHint -> Word32 -> Ptr GValue -> Ptr () -> IO CInt signalEmissionHookWrapper funptrptr _cb ihint n_param_values param_values data_ = do ihint' <- (newPtr 12 SignalInvocationHint) ihint param_values' <- (unpackBoxedArrayWithLength 24 n_param_values) param_values param_values'' <- mapM (newBoxed GValue) param_values' result <- _cb ihint' param_values'' data_ maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- Flags SignalFlags data SignalFlags = SignalFlagsRunFirst | SignalFlagsRunLast | SignalFlagsRunCleanup | SignalFlagsNoRecurse | SignalFlagsDetailed | SignalFlagsAction | SignalFlagsNoHooks | SignalFlagsMustCollect | SignalFlagsDeprecated | AnotherSignalFlags Int deriving (Show, Eq) instance Enum SignalFlags where fromEnum SignalFlagsRunFirst = 1 fromEnum SignalFlagsRunLast = 2 fromEnum SignalFlagsRunCleanup = 4 fromEnum SignalFlagsNoRecurse = 8 fromEnum SignalFlagsDetailed = 16 fromEnum SignalFlagsAction = 32 fromEnum SignalFlagsNoHooks = 64 fromEnum SignalFlagsMustCollect = 128 fromEnum SignalFlagsDeprecated = 256 fromEnum (AnotherSignalFlags k) = k toEnum 1 = SignalFlagsRunFirst toEnum 2 = SignalFlagsRunLast toEnum 4 = SignalFlagsRunCleanup toEnum 8 = SignalFlagsNoRecurse toEnum 16 = SignalFlagsDetailed toEnum 32 = SignalFlagsAction toEnum 64 = SignalFlagsNoHooks toEnum 128 = SignalFlagsMustCollect toEnum 256 = SignalFlagsDeprecated toEnum k = AnotherSignalFlags k instance IsGFlag SignalFlags -- struct SignalInvocationHint newtype SignalInvocationHint = SignalInvocationHint (ForeignPtr SignalInvocationHint) noSignalInvocationHint :: Maybe SignalInvocationHint noSignalInvocationHint = Nothing signalInvocationHintReadSignalId :: SignalInvocationHint -> IO Word32 signalInvocationHintReadSignalId s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word32 return val signalInvocationHintReadDetail :: SignalInvocationHint -> IO Word32 signalInvocationHintReadDetail s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Word32 return val signalInvocationHintReadRunType :: SignalInvocationHint -> IO [SignalFlags] signalInvocationHintReadRunType s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CUInt let val' = wordToGFlags val return val' -- Flags SignalMatchType data SignalMatchType = SignalMatchTypeId | SignalMatchTypeDetail | SignalMatchTypeClosure | SignalMatchTypeFunc | SignalMatchTypeData | SignalMatchTypeUnblocked | AnotherSignalMatchType Int deriving (Show, Eq) instance Enum SignalMatchType where fromEnum SignalMatchTypeId = 1 fromEnum SignalMatchTypeDetail = 2 fromEnum SignalMatchTypeClosure = 4 fromEnum SignalMatchTypeFunc = 8 fromEnum SignalMatchTypeData = 16 fromEnum SignalMatchTypeUnblocked = 32 fromEnum (AnotherSignalMatchType k) = k toEnum 1 = SignalMatchTypeId toEnum 2 = SignalMatchTypeDetail toEnum 4 = SignalMatchTypeClosure toEnum 8 = SignalMatchTypeFunc toEnum 16 = SignalMatchTypeData toEnum 32 = SignalMatchTypeUnblocked toEnum k = AnotherSignalMatchType k instance IsGFlag SignalMatchType -- struct SignalQuery newtype SignalQuery = SignalQuery (ForeignPtr SignalQuery) noSignalQuery :: Maybe SignalQuery noSignalQuery = Nothing signalQueryReadSignalId :: SignalQuery -> IO Word32 signalQueryReadSignalId s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word32 return val signalQueryReadSignalName :: SignalQuery -> IO T.Text signalQueryReadSignalName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' signalQueryReadItype :: SignalQuery -> IO GType signalQueryReadItype s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO CGType let val' = GType val return val' signalQueryReadSignalFlags :: SignalQuery -> IO [SignalFlags] signalQueryReadSignalFlags s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO CUInt let val' = wordToGFlags val return val' signalQueryReadReturnType :: SignalQuery -> IO GType signalQueryReadReturnType s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO CGType let val' = GType val return val' signalQueryReadNParams :: SignalQuery -> IO Word32 signalQueryReadNParams s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 40) :: IO Word32 return val -- XXX Skipped getter for "SignalQuery:param_types" :: Not implemented: "Don't know how to unpack C array of type TCArray False (-1) 5 (TBasicType TGType)" -- callback ToggleNotify toggleNotifyClosure :: ToggleNotify -> IO Closure toggleNotifyClosure cb = newCClosure =<< mkToggleNotify wrapped where wrapped = toggleNotifyWrapper Nothing cb type ToggleNotifyC = Ptr () -> Ptr Object -> CInt -> IO () foreign import ccall "wrapper" mkToggleNotify :: ToggleNotifyC -> IO (FunPtr ToggleNotifyC) type ToggleNotify = Ptr () -> Object -> Bool -> IO () noToggleNotify :: Maybe ToggleNotify noToggleNotify = Nothing toggleNotifyWrapper :: Maybe (Ptr (FunPtr (ToggleNotifyC))) -> ToggleNotify -> Ptr () -> Ptr Object -> CInt -> IO () toggleNotifyWrapper funptrptr _cb data_ object is_last_ref = do object' <- (newObject Object) object let is_last_ref' = (/= 0) is_last_ref _cb data_ object' is_last_ref' maybeReleaseFunPtr funptrptr -- union TypeCValue newtype TypeCValue = TypeCValue (ForeignPtr TypeCValue) noTypeCValue :: Maybe TypeCValue noTypeCValue = Nothing typeCValueReadVInt :: TypeCValue -> IO Int32 typeCValueReadVInt s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val typeCValueReadVLong :: TypeCValue -> IO Int64 typeCValueReadVLong s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int64 return val typeCValueReadVInt64 :: TypeCValue -> IO Int64 typeCValueReadVInt64 s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int64 return val typeCValueReadVDouble :: TypeCValue -> IO Double typeCValueReadVDouble s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CDouble let val' = realToFrac val return val' typeCValueReadVPointer :: TypeCValue -> IO (Ptr ()) typeCValueReadVPointer s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr ()) return val -- struct TypeClass newtype TypeClass = TypeClass (ForeignPtr TypeClass) noTypeClass :: Maybe TypeClass noTypeClass = Nothing -- method TypeClass::peek_parent -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "TypeClass" -- throws : False -- Skip return : False foreign import ccall "g_type_class_peek_parent" g_type_class_peek_parent :: Ptr TypeClass -> -- _obj : TInterface "GObject" "TypeClass" IO (Ptr TypeClass) typeClassPeekParent :: (MonadIO m) => TypeClass -> -- _obj m TypeClass typeClassPeekParent _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_type_class_peek_parent _obj' checkUnexpectedReturnNULL "g_type_class_peek_parent" result result' <- (newPtr 8 TypeClass) result touchManagedPtr _obj return result' -- method TypeClass::unref -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_class_unref" g_type_class_unref :: Ptr TypeClass -> -- _obj : TInterface "GObject" "TypeClass" IO () typeClassUnref :: (MonadIO m) => TypeClass -> -- _obj m () typeClassUnref _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_type_class_unref _obj' touchManagedPtr _obj return () -- callback TypeClassCacheFunc typeClassCacheFuncClosure :: TypeClassCacheFunc -> IO Closure typeClassCacheFuncClosure cb = newCClosure =<< mkTypeClassCacheFunc wrapped where wrapped = typeClassCacheFuncWrapper Nothing cb type TypeClassCacheFuncC = Ptr () -> Ptr TypeClass -> IO CInt foreign import ccall "wrapper" mkTypeClassCacheFunc :: TypeClassCacheFuncC -> IO (FunPtr TypeClassCacheFuncC) type TypeClassCacheFunc = Ptr () -> TypeClass -> IO Bool noTypeClassCacheFunc :: Maybe TypeClassCacheFunc noTypeClassCacheFunc = Nothing typeClassCacheFuncWrapper :: Maybe (Ptr (FunPtr (TypeClassCacheFuncC))) -> TypeClassCacheFunc -> Ptr () -> Ptr TypeClass -> IO CInt typeClassCacheFuncWrapper funptrptr _cb cache_data g_class = do g_class' <- (newPtr 8 TypeClass) g_class result <- _cb cache_data g_class' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- Flags TypeDebugFlags {-# DEPRECATED TypeDebugFlags ["(Since version 2.36)","g_type_init() is now done automatically"]#-} data TypeDebugFlags = TypeDebugFlagsNone | TypeDebugFlagsObjects | TypeDebugFlagsSignals | TypeDebugFlagsInstanceCount | TypeDebugFlagsMask | AnotherTypeDebugFlags Int deriving (Show, Eq) instance Enum TypeDebugFlags where fromEnum TypeDebugFlagsNone = 0 fromEnum TypeDebugFlagsObjects = 1 fromEnum TypeDebugFlagsSignals = 2 fromEnum TypeDebugFlagsInstanceCount = 4 fromEnum TypeDebugFlagsMask = 7 fromEnum (AnotherTypeDebugFlags k) = k toEnum 0 = TypeDebugFlagsNone toEnum 1 = TypeDebugFlagsObjects toEnum 2 = TypeDebugFlagsSignals toEnum 4 = TypeDebugFlagsInstanceCount toEnum 7 = TypeDebugFlagsMask toEnum k = AnotherTypeDebugFlags k instance IsGFlag TypeDebugFlags -- Flags TypeFlags data TypeFlags = TypeFlagsAbstract | TypeFlagsValueAbstract | AnotherTypeFlags Int deriving (Show, Eq) instance Enum TypeFlags where fromEnum TypeFlagsAbstract = 16 fromEnum TypeFlagsValueAbstract = 32 fromEnum (AnotherTypeFlags k) = k toEnum 16 = TypeFlagsAbstract toEnum 32 = TypeFlagsValueAbstract toEnum k = AnotherTypeFlags k instance IsGFlag TypeFlags -- Flags TypeFundamentalFlags data TypeFundamentalFlags = TypeFundamentalFlagsClassed | TypeFundamentalFlagsInstantiatable | TypeFundamentalFlagsDerivable | TypeFundamentalFlagsDeepDerivable | AnotherTypeFundamentalFlags Int deriving (Show, Eq) instance Enum TypeFundamentalFlags where fromEnum TypeFundamentalFlagsClassed = 1 fromEnum TypeFundamentalFlagsInstantiatable = 2 fromEnum TypeFundamentalFlagsDerivable = 4 fromEnum TypeFundamentalFlagsDeepDerivable = 8 fromEnum (AnotherTypeFundamentalFlags k) = k toEnum 1 = TypeFundamentalFlagsClassed toEnum 2 = TypeFundamentalFlagsInstantiatable toEnum 4 = TypeFundamentalFlagsDerivable toEnum 8 = TypeFundamentalFlagsDeepDerivable toEnum k = AnotherTypeFundamentalFlags k instance IsGFlag TypeFundamentalFlags -- struct TypeFundamentalInfo newtype TypeFundamentalInfo = TypeFundamentalInfo (ForeignPtr TypeFundamentalInfo) noTypeFundamentalInfo :: Maybe TypeFundamentalInfo noTypeFundamentalInfo = Nothing typeFundamentalInfoReadTypeFlags :: TypeFundamentalInfo -> IO [TypeFundamentalFlags] typeFundamentalInfoReadTypeFlags s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CUInt let val' = wordToGFlags val return val' -- struct TypeInfo newtype TypeInfo = TypeInfo (ForeignPtr TypeInfo) noTypeInfo :: Maybe TypeInfo noTypeInfo = Nothing typeInfoReadClassSize :: TypeInfo -> IO Word16 typeInfoReadClassSize s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word16 return val -- XXX Skipped getter for "TypeInfo:base_init" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "TypeInfo:base_finalize" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "TypeInfo:class_init" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "TypeInfo:class_finalize" :: Not implemented: "Wrapping foreign callbacks is not supported yet" typeInfoReadClassData :: TypeInfo -> IO (Ptr ()) typeInfoReadClassData s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 40) :: IO (Ptr ()) return val typeInfoReadInstanceSize :: TypeInfo -> IO Word16 typeInfoReadInstanceSize s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 48) :: IO Word16 return val typeInfoReadNPreallocs :: TypeInfo -> IO Word16 typeInfoReadNPreallocs s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 50) :: IO Word16 return val -- XXX Skipped getter for "TypeInfo:instance_init" :: Not implemented: "Wrapping foreign callbacks is not supported yet" typeInfoReadValueTable :: TypeInfo -> IO TypeValueTable typeInfoReadValueTable s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 64) :: IO (Ptr TypeValueTable) val' <- (newPtr 64 TypeValueTable) val return val' -- struct TypeInstance newtype TypeInstance = TypeInstance (ForeignPtr TypeInstance) noTypeInstance :: Maybe TypeInstance noTypeInstance = Nothing -- struct TypeInterface newtype TypeInterface = TypeInterface (ForeignPtr TypeInterface) noTypeInterface :: Maybe TypeInterface noTypeInterface = Nothing -- method TypeInterface::peek_parent -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeInterface", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeInterface", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "TypeInterface" -- throws : False -- Skip return : False foreign import ccall "g_type_interface_peek_parent" g_type_interface_peek_parent :: Ptr TypeInterface -> -- _obj : TInterface "GObject" "TypeInterface" IO (Ptr TypeInterface) typeInterfacePeekParent :: (MonadIO m) => TypeInterface -> -- _obj m TypeInterface typeInterfacePeekParent _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_type_interface_peek_parent _obj' checkUnexpectedReturnNULL "g_type_interface_peek_parent" result result' <- (newPtr 16 TypeInterface) result touchManagedPtr _obj return result' -- callback TypeInterfaceCheckFunc typeInterfaceCheckFuncClosure :: TypeInterfaceCheckFunc -> IO Closure typeInterfaceCheckFuncClosure cb = newCClosure =<< mkTypeInterfaceCheckFunc wrapped where wrapped = typeInterfaceCheckFuncWrapper Nothing cb type TypeInterfaceCheckFuncC = Ptr () -> Ptr () -> IO () foreign import ccall "wrapper" mkTypeInterfaceCheckFunc :: TypeInterfaceCheckFuncC -> IO (FunPtr TypeInterfaceCheckFuncC) type TypeInterfaceCheckFunc = Ptr () -> Ptr () -> IO () noTypeInterfaceCheckFunc :: Maybe TypeInterfaceCheckFunc noTypeInterfaceCheckFunc = Nothing typeInterfaceCheckFuncWrapper :: Maybe (Ptr (FunPtr (TypeInterfaceCheckFuncC))) -> TypeInterfaceCheckFunc -> Ptr () -> Ptr () -> IO () typeInterfaceCheckFuncWrapper funptrptr _cb check_data g_iface = do _cb check_data g_iface maybeReleaseFunPtr funptrptr -- object TypeModule newtype TypeModule = TypeModule (ForeignPtr TypeModule) noTypeModule :: Maybe TypeModule noTypeModule = Nothing foreign import ccall "g_type_module_get_type" c_g_type_module_get_type :: IO GType type instance ParentTypes TypeModule = '[Object, TypePlugin] instance GObject TypeModule where gobjectIsInitiallyUnowned _ = False gobjectType _ = c_g_type_module_get_type class GObject o => TypeModuleK o instance (GObject o, IsDescendantOf TypeModule o) => TypeModuleK o toTypeModule :: TypeModuleK o => o -> IO TypeModule toTypeModule = unsafeCastTo TypeModule -- method TypeModule::add_interface -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "instance_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_info", argType = TInterface "GObject" "InterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "instance_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_info", argType = TInterface "GObject" "InterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_module_add_interface" g_type_module_add_interface :: Ptr TypeModule -> -- _obj : TInterface "GObject" "TypeModule" CGType -> -- instance_type : TBasicType TGType CGType -> -- interface_type : TBasicType TGType Ptr InterfaceInfo -> -- interface_info : TInterface "GObject" "InterfaceInfo" IO () typeModuleAddInterface :: (MonadIO m, TypeModuleK a) => a -> -- _obj GType -> -- instance_type GType -> -- interface_type InterfaceInfo -> -- interface_info m () typeModuleAddInterface _obj instance_type interface_type interface_info = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let instance_type' = gtypeToCGType instance_type let interface_type' = gtypeToCGType interface_type let interface_info' = unsafeManagedPtrGetPtr interface_info g_type_module_add_interface _obj' instance_type' interface_type' interface_info' touchManagedPtr _obj touchManagedPtr interface_info return () -- method TypeModule::register_enum -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "const_static_values", argType = TInterface "GObject" "EnumValue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "const_static_values", argType = TInterface "GObject" "EnumValue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_type_module_register_enum" g_type_module_register_enum :: Ptr TypeModule -> -- _obj : TInterface "GObject" "TypeModule" CString -> -- name : TBasicType TUTF8 Ptr EnumValue -> -- const_static_values : TInterface "GObject" "EnumValue" IO CGType typeModuleRegisterEnum :: (MonadIO m, TypeModuleK a) => a -> -- _obj T.Text -> -- name EnumValue -> -- const_static_values m GType typeModuleRegisterEnum _obj name const_static_values = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj name' <- textToCString name let const_static_values' = unsafeManagedPtrGetPtr const_static_values result <- g_type_module_register_enum _obj' name' const_static_values' let result' = GType result touchManagedPtr _obj touchManagedPtr const_static_values freeMem name' return result' -- method TypeModule::register_flags -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "const_static_values", argType = TInterface "GObject" "FlagsValue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "const_static_values", argType = TInterface "GObject" "FlagsValue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_type_module_register_flags" g_type_module_register_flags :: Ptr TypeModule -> -- _obj : TInterface "GObject" "TypeModule" CString -> -- name : TBasicType TUTF8 Ptr FlagsValue -> -- const_static_values : TInterface "GObject" "FlagsValue" IO CGType typeModuleRegisterFlags :: (MonadIO m, TypeModuleK a) => a -> -- _obj T.Text -> -- name FlagsValue -> -- const_static_values m GType typeModuleRegisterFlags _obj name const_static_values = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj name' <- textToCString name let const_static_values' = unsafeManagedPtrGetPtr const_static_values result <- g_type_module_register_flags _obj' name' const_static_values' let result' = GType result touchManagedPtr _obj touchManagedPtr const_static_values freeMem name' return result' -- method TypeModule::register_type -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type_info", argType = TInterface "GObject" "TypeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "TypeFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "parent_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type_info", argType = TInterface "GObject" "TypeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "TypeFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_type_module_register_type" g_type_module_register_type :: Ptr TypeModule -> -- _obj : TInterface "GObject" "TypeModule" CGType -> -- parent_type : TBasicType TGType CString -> -- type_name : TBasicType TUTF8 Ptr TypeInfo -> -- type_info : TInterface "GObject" "TypeInfo" CUInt -> -- flags : TInterface "GObject" "TypeFlags" IO CGType typeModuleRegisterType :: (MonadIO m, TypeModuleK a) => a -> -- _obj GType -> -- parent_type T.Text -> -- type_name TypeInfo -> -- type_info [TypeFlags] -> -- flags m GType typeModuleRegisterType _obj parent_type type_name type_info flags = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let parent_type' = gtypeToCGType parent_type type_name' <- textToCString type_name let type_info' = unsafeManagedPtrGetPtr type_info let flags' = gflagsToWord flags result <- g_type_module_register_type _obj' parent_type' type_name' type_info' flags' let result' = GType result touchManagedPtr _obj touchManagedPtr type_info freeMem type_name' return result' -- method TypeModule::set_name -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_module_set_name" g_type_module_set_name :: Ptr TypeModule -> -- _obj : TInterface "GObject" "TypeModule" CString -> -- name : TBasicType TUTF8 IO () typeModuleSetName :: (MonadIO m, TypeModuleK a) => a -> -- _obj T.Text -> -- name m () typeModuleSetName _obj name = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj name' <- textToCString name g_type_module_set_name _obj' name' touchManagedPtr _obj freeMem name' return () -- method TypeModule::unuse -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_module_unuse" g_type_module_unuse :: Ptr TypeModule -> -- _obj : TInterface "GObject" "TypeModule" IO () typeModuleUnuse :: (MonadIO m, TypeModuleK a) => a -> -- _obj m () typeModuleUnuse _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_type_module_unuse _obj' touchManagedPtr _obj return () -- method TypeModule::use -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypeModule", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_type_module_use" g_type_module_use :: Ptr TypeModule -> -- _obj : TInterface "GObject" "TypeModule" IO CInt typeModuleUse :: (MonadIO m, TypeModuleK a) => a -> -- _obj m Bool typeModuleUse _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj result <- g_type_module_use _obj' let result' = (/= 0) result touchManagedPtr _obj return result' -- interface TypePlugin newtype TypePlugin = TypePlugin (ForeignPtr TypePlugin) noTypePlugin :: Maybe TypePlugin noTypePlugin = Nothing class ForeignPtrNewtype a => TypePluginK a instance (ForeignPtrNewtype o, IsDescendantOf TypePlugin o) => TypePluginK o type instance ParentTypes TypePlugin = '[] -- method TypePlugin::complete_interface_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypePlugin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "instance_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "GObject" "InterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypePlugin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "instance_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "GObject" "InterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_plugin_complete_interface_info" g_type_plugin_complete_interface_info :: Ptr TypePlugin -> -- _obj : TInterface "GObject" "TypePlugin" CGType -> -- instance_type : TBasicType TGType CGType -> -- interface_type : TBasicType TGType Ptr InterfaceInfo -> -- info : TInterface "GObject" "InterfaceInfo" IO () typePluginCompleteInterfaceInfo :: (MonadIO m, TypePluginK a) => a -> -- _obj GType -> -- instance_type GType -> -- interface_type InterfaceInfo -> -- info m () typePluginCompleteInterfaceInfo _obj instance_type interface_type info = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let instance_type' = gtypeToCGType instance_type let interface_type' = gtypeToCGType interface_type let info' = unsafeManagedPtrGetPtr info g_type_plugin_complete_interface_info _obj' instance_type' interface_type' info' touchManagedPtr _obj touchManagedPtr info return () -- method TypePlugin::complete_type_info -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypePlugin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "g_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "GObject" "TypeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value_table", argType = TInterface "GObject" "TypeValueTable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypePlugin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "g_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "GObject" "TypeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value_table", argType = TInterface "GObject" "TypeValueTable", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_plugin_complete_type_info" g_type_plugin_complete_type_info :: Ptr TypePlugin -> -- _obj : TInterface "GObject" "TypePlugin" CGType -> -- g_type : TBasicType TGType Ptr TypeInfo -> -- info : TInterface "GObject" "TypeInfo" Ptr TypeValueTable -> -- value_table : TInterface "GObject" "TypeValueTable" IO () typePluginCompleteTypeInfo :: (MonadIO m, TypePluginK a) => a -> -- _obj GType -> -- g_type TypeInfo -> -- info TypeValueTable -> -- value_table m () typePluginCompleteTypeInfo _obj g_type info value_table = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj let g_type' = gtypeToCGType g_type let info' = unsafeManagedPtrGetPtr info let value_table' = unsafeManagedPtrGetPtr value_table g_type_plugin_complete_type_info _obj' g_type' info' value_table' touchManagedPtr _obj touchManagedPtr info touchManagedPtr value_table return () -- method TypePlugin::unuse -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypePlugin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypePlugin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_plugin_unuse" g_type_plugin_unuse :: Ptr TypePlugin -> -- _obj : TInterface "GObject" "TypePlugin" IO () typePluginUnuse :: (MonadIO m, TypePluginK a) => a -> -- _obj m () typePluginUnuse _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_type_plugin_unuse _obj' touchManagedPtr _obj return () -- method TypePlugin::use -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "TypePlugin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "TypePlugin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_plugin_use" g_type_plugin_use :: Ptr TypePlugin -> -- _obj : TInterface "GObject" "TypePlugin" IO () typePluginUse :: (MonadIO m, TypePluginK a) => a -> -- _obj m () typePluginUse _obj = liftIO $ do let _obj' = unsafeManagedPtrCastPtr _obj g_type_plugin_use _obj' touchManagedPtr _obj return () -- struct TypePluginClass newtype TypePluginClass = TypePluginClass (ForeignPtr TypePluginClass) noTypePluginClass :: Maybe TypePluginClass noTypePluginClass = Nothing -- XXX Skipped getter for "TypePluginClass:use_plugin" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "TypePluginClass:unuse_plugin" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "TypePluginClass:complete_type_info" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "TypePluginClass:complete_interface_info" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- callback TypePluginCompleteInterfaceInfo -- XXX Could not generate callback wrapper for TypePluginCompleteInterfaceInfo -- Error was : Bad introspection data: "Wrapping not a GObject with no copy..." -- callback TypePluginCompleteTypeInfo -- XXX Could not generate callback wrapper for TypePluginCompleteTypeInfo -- Error was : Bad introspection data: "Wrapping not a GObject with no copy..." -- callback TypePluginUnuse -- XXX Could not generate callback wrapper for TypePluginUnuse -- Error was : Bad introspection data: "Wrapping not a GObject with no copy..." -- callback TypePluginUse -- XXX Could not generate callback wrapper for TypePluginUse -- Error was : Bad introspection data: "Wrapping not a GObject with no copy..." -- struct TypeQuery newtype TypeQuery = TypeQuery (ForeignPtr TypeQuery) noTypeQuery :: Maybe TypeQuery noTypeQuery = Nothing typeQueryReadType :: TypeQuery -> IO GType typeQueryReadType s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CGType let val' = GType val return val' typeQueryReadTypeName :: TypeQuery -> IO T.Text typeQueryReadTypeName s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO CString val' <- cstringToText val return val' typeQueryReadClassSize :: TypeQuery -> IO Word32 typeQueryReadClassSize s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Word32 return val typeQueryReadInstanceSize :: TypeQuery -> IO Word32 typeQueryReadInstanceSize s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 20) :: IO Word32 return val -- struct TypeValueTable newtype TypeValueTable = TypeValueTable (ForeignPtr TypeValueTable) noTypeValueTable :: Maybe TypeValueTable noTypeValueTable = Nothing -- XXX Skipped getter for "TypeValueTable:value_init" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "TypeValueTable:value_free" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- XXX Skipped getter for "TypeValueTable:value_copy" :: Not implemented: "Wrapping foreign callbacks is not supported yet" typeValueTableReadCollectFormat :: TypeValueTable -> IO T.Text typeValueTableReadCollectFormat s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO CString val' <- cstringToText val return val' -- XXX Skipped getter for "TypeValueTable:collect_value" :: Not implemented: "Wrapping foreign callbacks is not supported yet" typeValueTableReadLcopyFormat :: TypeValueTable -> IO T.Text typeValueTableReadLcopyFormat s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 48) :: IO CString val' <- cstringToText val return val' -- XXX Skipped getter for "TypeValueTable:lcopy_value" :: Not implemented: "Wrapping foreign callbacks is not supported yet" -- struct ValueArray newtype ValueArray = ValueArray (ForeignPtr ValueArray) noValueArray :: Maybe ValueArray noValueArray = Nothing foreign import ccall "g_value_array_get_type" c_g_value_array_get_type :: IO GType instance BoxedObject ValueArray where boxedType _ = c_g_value_array_get_type valueArrayReadNValues :: ValueArray -> IO Word32 valueArrayReadNValues s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word32 return val valueArrayReadValues :: ValueArray -> IO GValue valueArrayReadValues s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr GValue) val' <- (newBoxed GValue) val return val' -- method ValueArray::new -- method type : Constructor -- Args : [Arg {argName = "n_prealloced", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "n_prealloced", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "ValueArray" -- throws : False -- Skip return : False foreign import ccall "g_value_array_new" g_value_array_new :: Word32 -> -- n_prealloced : TBasicType TUInt32 IO (Ptr ValueArray) {-# DEPRECATED valueArrayNew ["(Since version 2.32)","Use #GArray and g_array_sized_new() instead."]#-} valueArrayNew :: (MonadIO m) => Word32 -> -- n_prealloced m ValueArray valueArrayNew n_prealloced = liftIO $ do result <- g_value_array_new n_prealloced checkUnexpectedReturnNULL "g_value_array_new" result result' <- (wrapBoxed ValueArray) result return result' -- method ValueArray::append -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "ValueArray" -- throws : False -- Skip return : False foreign import ccall "g_value_array_append" g_value_array_append :: Ptr ValueArray -> -- _obj : TInterface "GObject" "ValueArray" Ptr GValue -> -- value : TInterface "GObject" "Value" IO (Ptr ValueArray) {-# DEPRECATED valueArrayAppend ["(Since version 2.32)","Use #GArray and g_array_append_val() instead."]#-} valueArrayAppend :: (MonadIO m) => ValueArray -> -- _obj Maybe (GValue) -> -- value m ValueArray valueArrayAppend _obj value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeValue <- case value of Nothing -> return nullPtr Just jValue -> do let jValue' = unsafeManagedPtrGetPtr jValue return jValue' result <- g_value_array_append _obj' maybeValue checkUnexpectedReturnNULL "g_value_array_append" result result' <- (newBoxed ValueArray) result touchManagedPtr _obj whenJust value touchManagedPtr return result' -- method ValueArray::copy -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "ValueArray" -- throws : False -- Skip return : False foreign import ccall "g_value_array_copy" g_value_array_copy :: Ptr ValueArray -> -- _obj : TInterface "GObject" "ValueArray" IO (Ptr ValueArray) {-# DEPRECATED valueArrayCopy ["(Since version 2.32)","Use #GArray and g_array_ref() instead."]#-} valueArrayCopy :: (MonadIO m) => ValueArray -> -- _obj m ValueArray valueArrayCopy _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_value_array_copy _obj' checkUnexpectedReturnNULL "g_value_array_copy" result result' <- (wrapBoxed ValueArray) result touchManagedPtr _obj return result' -- method ValueArray::free -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_value_array_free" g_value_array_free :: Ptr ValueArray -> -- _obj : TInterface "GObject" "ValueArray" IO () {-# DEPRECATED valueArrayFree ["(Since version 2.32)","Use #GArray and g_array_unref() instead."]#-} valueArrayFree :: (MonadIO m) => ValueArray -> -- _obj m () valueArrayFree _obj = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj g_value_array_free _obj' touchManagedPtr _obj return () -- method ValueArray::get_nth -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Value" -- throws : False -- Skip return : False foreign import ccall "g_value_array_get_nth" g_value_array_get_nth :: Ptr ValueArray -> -- _obj : TInterface "GObject" "ValueArray" Word32 -> -- index_ : TBasicType TUInt32 IO (Ptr GValue) {-# DEPRECATED valueArrayGetNth ["(Since version 2.32)","Use g_array_index() instead."]#-} valueArrayGetNth :: (MonadIO m) => ValueArray -> -- _obj Word32 -> -- index_ m GValue valueArrayGetNth _obj index_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_value_array_get_nth _obj' index_ checkUnexpectedReturnNULL "g_value_array_get_nth" result result' <- (newBoxed GValue) result touchManagedPtr _obj return result' -- method ValueArray::insert -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "ValueArray" -- throws : False -- Skip return : False foreign import ccall "g_value_array_insert" g_value_array_insert :: Ptr ValueArray -> -- _obj : TInterface "GObject" "ValueArray" Word32 -> -- index_ : TBasicType TUInt32 Ptr GValue -> -- value : TInterface "GObject" "Value" IO (Ptr ValueArray) {-# DEPRECATED valueArrayInsert ["(Since version 2.32)","Use #GArray and g_array_insert_val() instead."]#-} valueArrayInsert :: (MonadIO m) => ValueArray -> -- _obj Word32 -> -- index_ Maybe (GValue) -> -- value m ValueArray valueArrayInsert _obj index_ value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeValue <- case value of Nothing -> return nullPtr Just jValue -> do let jValue' = unsafeManagedPtrGetPtr jValue return jValue' result <- g_value_array_insert _obj' index_ maybeValue checkUnexpectedReturnNULL "g_value_array_insert" result result' <- (newBoxed ValueArray) result touchManagedPtr _obj whenJust value touchManagedPtr return result' -- method ValueArray::prepend -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "ValueArray" -- throws : False -- Skip return : False foreign import ccall "g_value_array_prepend" g_value_array_prepend :: Ptr ValueArray -> -- _obj : TInterface "GObject" "ValueArray" Ptr GValue -> -- value : TInterface "GObject" "Value" IO (Ptr ValueArray) {-# DEPRECATED valueArrayPrepend ["(Since version 2.32)","Use #GArray and g_array_prepend_val() instead."]#-} valueArrayPrepend :: (MonadIO m) => ValueArray -> -- _obj Maybe (GValue) -> -- value m ValueArray valueArrayPrepend _obj value = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj maybeValue <- case value of Nothing -> return nullPtr Just jValue -> do let jValue' = unsafeManagedPtrGetPtr jValue return jValue' result <- g_value_array_prepend _obj' maybeValue checkUnexpectedReturnNULL "g_value_array_prepend" result result' <- (newBoxed ValueArray) result touchManagedPtr _obj whenJust value touchManagedPtr return result' -- method ValueArray::remove -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "ValueArray" -- throws : False -- Skip return : False foreign import ccall "g_value_array_remove" g_value_array_remove :: Ptr ValueArray -> -- _obj : TInterface "GObject" "ValueArray" Word32 -> -- index_ : TBasicType TUInt32 IO (Ptr ValueArray) {-# DEPRECATED valueArrayRemove ["(Since version 2.32)","Use #GArray and g_array_remove_index() instead."]#-} valueArrayRemove :: (MonadIO m) => ValueArray -> -- _obj Word32 -> -- index_ m ValueArray valueArrayRemove _obj index_ = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj result <- g_value_array_remove _obj' index_ checkUnexpectedReturnNULL "g_value_array_remove" result result' <- (newBoxed ValueArray) result touchManagedPtr _obj return result' -- method ValueArray::sort -- method type : OrdinaryMethod -- Args : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "compare_func", argType = TInterface "GLib" "CompareDataFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "_obj", argType = TInterface "GObject" "ValueArray", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "compare_func", argType = TInterface "GLib" "CompareDataFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "ValueArray" -- throws : False -- Skip return : False foreign import ccall "g_value_array_sort_with_data" g_value_array_sort_with_data :: Ptr ValueArray -> -- _obj : TInterface "GObject" "ValueArray" FunPtr GLib.CompareDataFuncC -> -- compare_func : TInterface "GLib" "CompareDataFunc" Ptr () -> -- user_data : TBasicType TVoid IO (Ptr ValueArray) {-# DEPRECATED valueArraySort ["(Since version 2.32)","Use #GArray and g_array_sort_with_data()."]#-} valueArraySort :: (MonadIO m) => ValueArray -> -- _obj GLib.CompareDataFunc -> -- compare_func m ValueArray valueArraySort _obj compare_func = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj compare_func' <- GLib.mkCompareDataFunc (GLib.compareDataFuncWrapper Nothing compare_func) let user_data = nullPtr result <- g_value_array_sort_with_data _obj' compare_func' user_data checkUnexpectedReturnNULL "g_value_array_sort_with_data" result result' <- (newBoxed ValueArray) result safeFreeFunPtr $ castFunPtrToPtr compare_func' touchManagedPtr _obj return result' -- callback ValueTransform valueTransformClosure :: ValueTransform -> IO Closure valueTransformClosure cb = newCClosure =<< mkValueTransform wrapped where wrapped = valueTransformWrapper Nothing cb type ValueTransformC = Ptr GValue -> Ptr GValue -> IO () foreign import ccall "wrapper" mkValueTransform :: ValueTransformC -> IO (FunPtr ValueTransformC) type ValueTransform = GValue -> GValue -> IO () noValueTransform :: Maybe ValueTransform noValueTransform = Nothing valueTransformWrapper :: Maybe (Ptr (FunPtr (ValueTransformC))) -> ValueTransform -> Ptr GValue -> Ptr GValue -> IO () valueTransformWrapper funptrptr _cb src_value dest_value = do src_value' <- (newBoxed GValue) src_value dest_value' <- (newBoxed GValue) dest_value _cb src_value' dest_value' maybeReleaseFunPtr funptrptr -- callback WeakNotify weakNotifyClosure :: WeakNotify -> IO Closure weakNotifyClosure cb = newCClosure =<< mkWeakNotify wrapped where wrapped = weakNotifyWrapper Nothing cb type WeakNotifyC = Ptr () -> Ptr Object -> IO () foreign import ccall "wrapper" mkWeakNotify :: WeakNotifyC -> IO (FunPtr WeakNotifyC) type WeakNotify = Ptr () -> Object -> IO () noWeakNotify :: Maybe WeakNotify noWeakNotify = Nothing weakNotifyWrapper :: Maybe (Ptr (FunPtr (WeakNotifyC))) -> WeakNotify -> Ptr () -> Ptr Object -> IO () weakNotifyWrapper funptrptr _cb data_ where_the_object_was = do where_the_object_was' <- (newObject Object) where_the_object_was _cb data_ where_the_object_was' maybeReleaseFunPtr funptrptr -- struct WeakRef newtype WeakRef = WeakRef (ForeignPtr WeakRef) noWeakRef :: Maybe WeakRef noWeakRef = Nothing -- constant _PARAM_MASK _PARAM_MASK :: Int32 _PARAM_MASK = 255 -- constant _PARAM_STATIC_STRINGS _PARAM_STATIC_STRINGS :: Int32 _PARAM_STATIC_STRINGS = 0 -- constant _PARAM_USER_SHIFT _PARAM_USER_SHIFT :: Int32 _PARAM_USER_SHIFT = 8 -- constant _SIGNAL_FLAGS_MASK _SIGNAL_FLAGS_MASK :: Int32 _SIGNAL_FLAGS_MASK = 511 -- constant _SIGNAL_MATCH_MASK _SIGNAL_MATCH_MASK :: Int32 _SIGNAL_MATCH_MASK = 63 -- constant _TYPE_FLAG_RESERVED_ID_BIT _TYPE_FLAG_RESERVED_ID_BIT :: Word64 _TYPE_FLAG_RESERVED_ID_BIT = 1 -- constant _TYPE_FUNDAMENTAL_MAX _TYPE_FUNDAMENTAL_MAX :: Int32 _TYPE_FUNDAMENTAL_MAX = 255 -- constant _TYPE_FUNDAMENTAL_SHIFT _TYPE_FUNDAMENTAL_SHIFT :: Int32 _TYPE_FUNDAMENTAL_SHIFT = 2 -- constant _TYPE_RESERVED_BSE_FIRST _TYPE_RESERVED_BSE_FIRST :: Int32 _TYPE_RESERVED_BSE_FIRST = 32 -- constant _TYPE_RESERVED_BSE_LAST _TYPE_RESERVED_BSE_LAST :: Int32 _TYPE_RESERVED_BSE_LAST = 48 -- constant _TYPE_RESERVED_GLIB_FIRST _TYPE_RESERVED_GLIB_FIRST :: Int32 _TYPE_RESERVED_GLIB_FIRST = 22 -- constant _TYPE_RESERVED_GLIB_LAST _TYPE_RESERVED_GLIB_LAST :: Int32 _TYPE_RESERVED_GLIB_LAST = 31 -- constant _TYPE_RESERVED_USER_FIRST _TYPE_RESERVED_USER_FIRST :: Int32 _TYPE_RESERVED_USER_FIRST = 49 -- constant _VALUE_COLLECT_FORMAT_MAX_LENGTH _VALUE_COLLECT_FORMAT_MAX_LENGTH :: Int32 _VALUE_COLLECT_FORMAT_MAX_LENGTH = 8 -- constant _VALUE_NOCOPY_CONTENTS _VALUE_NOCOPY_CONTENTS :: Int32 _VALUE_NOCOPY_CONTENTS = 134217728 -- union Value_Data_Union_ newtype Value_Data_Union_ = Value_Data_Union_ (ForeignPtr Value_Data_Union_) noValue_Data_Union_ :: Maybe Value_Data_Union_ noValue_Data_Union_ = Nothing value_Data_Union_ReadVInt :: Value_Data_Union_ -> IO Int32 value_Data_Union_ReadVInt s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int32 return val value_Data_Union_ReadVUint :: Value_Data_Union_ -> IO Word32 value_Data_Union_ReadVUint s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word32 return val value_Data_Union_ReadVLong :: Value_Data_Union_ -> IO Int64 value_Data_Union_ReadVLong s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int64 return val value_Data_Union_ReadVUlong :: Value_Data_Union_ -> IO Word64 value_Data_Union_ReadVUlong s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word64 return val value_Data_Union_ReadVInt64 :: Value_Data_Union_ -> IO Int64 value_Data_Union_ReadVInt64 s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Int64 return val value_Data_Union_ReadVUint64 :: Value_Data_Union_ -> IO Word64 value_Data_Union_ReadVUint64 s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word64 return val value_Data_Union_ReadVFloat :: Value_Data_Union_ -> IO Float value_Data_Union_ReadVFloat s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CFloat let val' = realToFrac val return val' value_Data_Union_ReadVDouble :: Value_Data_Union_ -> IO Double value_Data_Union_ReadVDouble s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO CDouble let val' = realToFrac val return val' value_Data_Union_ReadVPointer :: Value_Data_Union_ -> IO (Ptr ()) value_Data_Union_ReadVPointer s = withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr ()) return val -- function g_boxed_copy -- Args : [Arg {argName = "boxed_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src_boxed", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "boxed_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src_boxed", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_boxed_copy" g_boxed_copy :: CGType -> -- boxed_type : TBasicType TGType Ptr () -> -- src_boxed : TBasicType TVoid IO () boxedCopy :: (MonadIO m) => GType -> -- boxed_type Ptr () -> -- src_boxed m () boxedCopy boxed_type src_boxed = liftIO $ do let boxed_type' = gtypeToCGType boxed_type g_boxed_copy boxed_type' src_boxed return () -- function g_boxed_free -- Args : [Arg {argName = "boxed_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "boxed", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "boxed_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "boxed", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_boxed_free" g_boxed_free :: CGType -> -- boxed_type : TBasicType TGType Ptr () -> -- boxed : TBasicType TVoid IO () boxedFree :: (MonadIO m) => GType -> -- boxed_type Ptr () -> -- boxed m () boxedFree boxed_type boxed = liftIO $ do let boxed_type' = gtypeToCGType boxed_type g_boxed_free boxed_type' boxed return () -- function g_cclosure_marshal_BOOLEAN__BOXED_BOXED -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_BOOLEAN__BOXED_BOXED" g_cclosure_marshal_BOOLEAN__BOXED_BOXED :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalBOOLEAN_BOXEDBOXED :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalBOOLEAN_BOXEDBOXED closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_BOOLEAN__BOXED_BOXED closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_BOOLEAN__FLAGS -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_BOOLEAN__FLAGS" g_cclosure_marshal_BOOLEAN__FLAGS :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalBOOLEAN_FLAGS :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalBOOLEAN_FLAGS closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_BOOLEAN__FLAGS closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_STRING__OBJECT_POINTER -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_STRING__OBJECT_POINTER" g_cclosure_marshal_STRING__OBJECT_POINTER :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalSTRING_OBJECTPOINTER :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalSTRING_OBJECTPOINTER closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_STRING__OBJECT_POINTER closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__BOOLEAN -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__BOOLEAN" g_cclosure_marshal_VOID__BOOLEAN :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_BOOLEAN :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_BOOLEAN closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__BOOLEAN closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__BOXED -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__BOXED" g_cclosure_marshal_VOID__BOXED :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_BOXED :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_BOXED closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__BOXED closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__CHAR -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__CHAR" g_cclosure_marshal_VOID__CHAR :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_CHAR :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_CHAR closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__CHAR closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__DOUBLE -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__DOUBLE" g_cclosure_marshal_VOID__DOUBLE :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_DOUBLE :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_DOUBLE closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__DOUBLE closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__ENUM -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__ENUM" g_cclosure_marshal_VOID__ENUM :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_ENUM :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_ENUM closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__ENUM closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__FLAGS -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__FLAGS" g_cclosure_marshal_VOID__FLAGS :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_FLAGS :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_FLAGS closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__FLAGS closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__FLOAT -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__FLOAT" g_cclosure_marshal_VOID__FLOAT :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_FLOAT :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_FLOAT closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__FLOAT closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__INT -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__INT" g_cclosure_marshal_VOID__INT :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_INT :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_INT closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__INT closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__LONG -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__LONG" g_cclosure_marshal_VOID__LONG :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_LONG :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_LONG closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__LONG closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__OBJECT -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__OBJECT" g_cclosure_marshal_VOID__OBJECT :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_OBJECT :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_OBJECT closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__OBJECT closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__PARAM -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__PARAM" g_cclosure_marshal_VOID__PARAM :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_PARAM :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_PARAM closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__PARAM closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__POINTER -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__POINTER" g_cclosure_marshal_VOID__POINTER :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_POINTER :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_POINTER closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__POINTER closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__STRING -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__STRING" g_cclosure_marshal_VOID__STRING :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_STRING :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_STRING closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__STRING closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__UCHAR -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__UCHAR" g_cclosure_marshal_VOID__UCHAR :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_UCHAR :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_UCHAR closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__UCHAR closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__UINT -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__UINT" g_cclosure_marshal_VOID__UINT :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_UINT :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_UINT closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__UINT closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__UINT_POINTER -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__UINT_POINTER" g_cclosure_marshal_VOID__UINT_POINTER :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_UINTPOINTER :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_UINTPOINTER closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__UINT_POINTER closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__ULONG -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__ULONG" g_cclosure_marshal_VOID__ULONG :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_ULONG :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_ULONG closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__ULONG closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__VARIANT -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__VARIANT" g_cclosure_marshal_VOID__VARIANT :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_VARIANT :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_VARIANT closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__VARIANT closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_VOID__VOID -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_VOID__VOID" g_cclosure_marshal_VOID__VOID :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_value : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalVOID_VOID :: (MonadIO m) => Closure -> -- closure GValue -> -- return_value Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalVOID_VOID closure return_value n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_value' = unsafeManagedPtrGetPtr return_value let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_VOID__VOID closure' return_value' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_value touchManagedPtr param_values return () -- function g_cclosure_marshal_generic -- Args : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_gvalue", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_gvalue", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_param_values", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_values", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "invocation_hint", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "marshal_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_cclosure_marshal_generic" g_cclosure_marshal_generic :: Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr GValue -> -- return_gvalue : TInterface "GObject" "Value" Word32 -> -- n_param_values : TBasicType TUInt32 Ptr GValue -> -- param_values : TInterface "GObject" "Value" Ptr () -> -- invocation_hint : TBasicType TVoid Ptr () -> -- marshal_data : TBasicType TVoid IO () cclosureMarshalGeneric :: (MonadIO m) => Closure -> -- closure GValue -> -- return_gvalue Word32 -> -- n_param_values GValue -> -- param_values Ptr () -> -- invocation_hint Ptr () -> -- marshal_data m () cclosureMarshalGeneric closure return_gvalue n_param_values param_values invocation_hint marshal_data = liftIO $ do let closure' = unsafeManagedPtrGetPtr closure let return_gvalue' = unsafeManagedPtrGetPtr return_gvalue let param_values' = unsafeManagedPtrGetPtr param_values g_cclosure_marshal_generic closure' return_gvalue' n_param_values param_values' invocation_hint marshal_data touchManagedPtr closure touchManagedPtr return_gvalue touchManagedPtr param_values return () -- function g_enum_complete_type_info -- Args : [Arg {argName = "g_enum_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "GObject" "TypeInfo", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "const_values", argType = TInterface "GObject" "EnumValue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "g_enum_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "const_values", argType = TInterface "GObject" "EnumValue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_enum_complete_type_info" g_enum_complete_type_info :: CGType -> -- g_enum_type : TBasicType TGType Ptr TypeInfo -> -- info : TInterface "GObject" "TypeInfo" Ptr EnumValue -> -- const_values : TInterface "GObject" "EnumValue" IO () enumCompleteTypeInfo :: (MonadIO m) => GType -> -- g_enum_type EnumValue -> -- const_values m (TypeInfo) enumCompleteTypeInfo g_enum_type const_values = liftIO $ do let g_enum_type' = gtypeToCGType g_enum_type info <- callocBytes 72 :: IO (Ptr TypeInfo) let const_values' = unsafeManagedPtrGetPtr const_values g_enum_complete_type_info g_enum_type' info const_values' info' <- (wrapPtr TypeInfo) info touchManagedPtr const_values return info' -- function g_enum_get_value -- Args : [Arg {argName = "enum_class", argType = TInterface "GObject" "EnumClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "enum_class", argType = TInterface "GObject" "EnumClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "EnumValue" -- throws : False -- Skip return : False foreign import ccall "g_enum_get_value" g_enum_get_value :: Ptr EnumClass -> -- enum_class : TInterface "GObject" "EnumClass" Int32 -> -- value : TBasicType TInt32 IO (Ptr EnumValue) enumGetValue :: (MonadIO m) => EnumClass -> -- enum_class Int32 -> -- value m EnumValue enumGetValue enum_class value = liftIO $ do let enum_class' = unsafeManagedPtrGetPtr enum_class result <- g_enum_get_value enum_class' value checkUnexpectedReturnNULL "g_enum_get_value" result result' <- (newPtr 24 EnumValue) result touchManagedPtr enum_class return result' -- function g_enum_get_value_by_name -- Args : [Arg {argName = "enum_class", argType = TInterface "GObject" "EnumClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "enum_class", argType = TInterface "GObject" "EnumClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "EnumValue" -- throws : False -- Skip return : False foreign import ccall "g_enum_get_value_by_name" g_enum_get_value_by_name :: Ptr EnumClass -> -- enum_class : TInterface "GObject" "EnumClass" CString -> -- name : TBasicType TUTF8 IO (Ptr EnumValue) enumGetValueByName :: (MonadIO m) => EnumClass -> -- enum_class T.Text -> -- name m EnumValue enumGetValueByName enum_class name = liftIO $ do let enum_class' = unsafeManagedPtrGetPtr enum_class name' <- textToCString name result <- g_enum_get_value_by_name enum_class' name' checkUnexpectedReturnNULL "g_enum_get_value_by_name" result result' <- (newPtr 24 EnumValue) result touchManagedPtr enum_class freeMem name' return result' -- function g_enum_get_value_by_nick -- Args : [Arg {argName = "enum_class", argType = TInterface "GObject" "EnumClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "enum_class", argType = TInterface "GObject" "EnumClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "EnumValue" -- throws : False -- Skip return : False foreign import ccall "g_enum_get_value_by_nick" g_enum_get_value_by_nick :: Ptr EnumClass -> -- enum_class : TInterface "GObject" "EnumClass" CString -> -- nick : TBasicType TUTF8 IO (Ptr EnumValue) enumGetValueByNick :: (MonadIO m) => EnumClass -> -- enum_class T.Text -> -- nick m EnumValue enumGetValueByNick enum_class nick = liftIO $ do let enum_class' = unsafeManagedPtrGetPtr enum_class nick' <- textToCString nick result <- g_enum_get_value_by_nick enum_class' nick' checkUnexpectedReturnNULL "g_enum_get_value_by_nick" result result' <- (newPtr 24 EnumValue) result touchManagedPtr enum_class freeMem nick' return result' -- function g_enum_register_static -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "const_static_values", argType = TInterface "GObject" "EnumValue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "const_static_values", argType = TInterface "GObject" "EnumValue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_enum_register_static" g_enum_register_static :: CString -> -- name : TBasicType TUTF8 Ptr EnumValue -> -- const_static_values : TInterface "GObject" "EnumValue" IO CGType enumRegisterStatic :: (MonadIO m) => T.Text -> -- name EnumValue -> -- const_static_values m GType enumRegisterStatic name const_static_values = liftIO $ do name' <- textToCString name let const_static_values' = unsafeManagedPtrGetPtr const_static_values result <- g_enum_register_static name' const_static_values' let result' = GType result touchManagedPtr const_static_values freeMem name' return result' -- function g_flags_complete_type_info -- Args : [Arg {argName = "g_flags_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "GObject" "TypeInfo", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "const_values", argType = TInterface "GObject" "FlagsValue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "g_flags_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "const_values", argType = TInterface "GObject" "FlagsValue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_flags_complete_type_info" g_flags_complete_type_info :: CGType -> -- g_flags_type : TBasicType TGType Ptr TypeInfo -> -- info : TInterface "GObject" "TypeInfo" Ptr FlagsValue -> -- const_values : TInterface "GObject" "FlagsValue" IO () flagsCompleteTypeInfo :: (MonadIO m) => GType -> -- g_flags_type FlagsValue -> -- const_values m (TypeInfo) flagsCompleteTypeInfo g_flags_type const_values = liftIO $ do let g_flags_type' = gtypeToCGType g_flags_type info <- callocBytes 72 :: IO (Ptr TypeInfo) let const_values' = unsafeManagedPtrGetPtr const_values g_flags_complete_type_info g_flags_type' info const_values' info' <- (wrapPtr TypeInfo) info touchManagedPtr const_values return info' -- function g_flags_get_first_value -- Args : [Arg {argName = "flags_class", argType = TInterface "GObject" "FlagsClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "flags_class", argType = TInterface "GObject" "FlagsClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "FlagsValue" -- throws : False -- Skip return : False foreign import ccall "g_flags_get_first_value" g_flags_get_first_value :: Ptr FlagsClass -> -- flags_class : TInterface "GObject" "FlagsClass" Word32 -> -- value : TBasicType TUInt32 IO (Ptr FlagsValue) flagsGetFirstValue :: (MonadIO m) => FlagsClass -> -- flags_class Word32 -> -- value m FlagsValue flagsGetFirstValue flags_class value = liftIO $ do let flags_class' = unsafeManagedPtrGetPtr flags_class result <- g_flags_get_first_value flags_class' value checkUnexpectedReturnNULL "g_flags_get_first_value" result result' <- (newPtr 24 FlagsValue) result touchManagedPtr flags_class return result' -- function g_flags_get_value_by_name -- Args : [Arg {argName = "flags_class", argType = TInterface "GObject" "FlagsClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "flags_class", argType = TInterface "GObject" "FlagsClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "FlagsValue" -- throws : False -- Skip return : False foreign import ccall "g_flags_get_value_by_name" g_flags_get_value_by_name :: Ptr FlagsClass -> -- flags_class : TInterface "GObject" "FlagsClass" CString -> -- name : TBasicType TUTF8 IO (Ptr FlagsValue) flagsGetValueByName :: (MonadIO m) => FlagsClass -> -- flags_class T.Text -> -- name m FlagsValue flagsGetValueByName flags_class name = liftIO $ do let flags_class' = unsafeManagedPtrGetPtr flags_class name' <- textToCString name result <- g_flags_get_value_by_name flags_class' name' checkUnexpectedReturnNULL "g_flags_get_value_by_name" result result' <- (newPtr 24 FlagsValue) result touchManagedPtr flags_class freeMem name' return result' -- function g_flags_get_value_by_nick -- Args : [Arg {argName = "flags_class", argType = TInterface "GObject" "FlagsClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "flags_class", argType = TInterface "GObject" "FlagsClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "FlagsValue" -- throws : False -- Skip return : False foreign import ccall "g_flags_get_value_by_nick" g_flags_get_value_by_nick :: Ptr FlagsClass -> -- flags_class : TInterface "GObject" "FlagsClass" CString -> -- nick : TBasicType TUTF8 IO (Ptr FlagsValue) flagsGetValueByNick :: (MonadIO m) => FlagsClass -> -- flags_class T.Text -> -- nick m FlagsValue flagsGetValueByNick flags_class nick = liftIO $ do let flags_class' = unsafeManagedPtrGetPtr flags_class nick' <- textToCString nick result <- g_flags_get_value_by_nick flags_class' nick' checkUnexpectedReturnNULL "g_flags_get_value_by_nick" result result' <- (newPtr 24 FlagsValue) result touchManagedPtr flags_class freeMem nick' return result' -- function g_flags_register_static -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "const_static_values", argType = TInterface "GObject" "FlagsValue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "const_static_values", argType = TInterface "GObject" "FlagsValue", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_flags_register_static" g_flags_register_static :: CString -> -- name : TBasicType TUTF8 Ptr FlagsValue -> -- const_static_values : TInterface "GObject" "FlagsValue" IO CGType flagsRegisterStatic :: (MonadIO m) => T.Text -> -- name FlagsValue -> -- const_static_values m GType flagsRegisterStatic name const_static_values = liftIO $ do name' <- textToCString name let const_static_values' = unsafeManagedPtrGetPtr const_static_values result <- g_flags_register_static name' const_static_values' let result' = GType result touchManagedPtr const_static_values freeMem name' return result' -- function g_gtype_get_type -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_gtype_get_type" g_gtype_get_type :: IO CGType gtypeGetType :: (MonadIO m) => m GType gtypeGetType = liftIO $ do result <- g_gtype_get_type let result' = GType result return result' -- function g_param_spec_boolean -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_boolean" g_param_spec_boolean :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 CInt -> -- default_value : TBasicType TBoolean CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecBoolean :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb Bool -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecBoolean name nick blurb default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let default_value' = (fromIntegral . fromEnum) default_value let flags' = gflagsToWord flags result <- g_param_spec_boolean name' nick' blurb' default_value' flags' checkUnexpectedReturnNULL "g_param_spec_boolean" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_boxed -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "boxed_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "boxed_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_boxed" g_param_spec_boxed :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 CGType -> -- boxed_type : TBasicType TGType CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecBoxed :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb GType -> -- boxed_type [ParamFlags] -> -- flags m GParamSpec paramSpecBoxed name nick blurb boxed_type flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let boxed_type' = gtypeToCGType boxed_type let flags' = gflagsToWord flags result <- g_param_spec_boxed name' nick' blurb' boxed_type' flags' checkUnexpectedReturnNULL "g_param_spec_boxed" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_char -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_char" g_param_spec_char :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 Int8 -> -- minimum : TBasicType TInt8 Int8 -> -- maximum : TBasicType TInt8 Int8 -> -- default_value : TBasicType TInt8 CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecChar :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb Int8 -> -- minimum Int8 -> -- maximum Int8 -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecChar name nick blurb minimum maximum default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let flags' = gflagsToWord flags result <- g_param_spec_char name' nick' blurb' minimum maximum default_value flags' checkUnexpectedReturnNULL "g_param_spec_char" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_double -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_double" g_param_spec_double :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 CDouble -> -- minimum : TBasicType TDouble CDouble -> -- maximum : TBasicType TDouble CDouble -> -- default_value : TBasicType TDouble CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecDouble :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb Double -> -- minimum Double -> -- maximum Double -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecDouble name nick blurb minimum maximum default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let minimum' = realToFrac minimum let maximum' = realToFrac maximum let default_value' = realToFrac default_value let flags' = gflagsToWord flags result <- g_param_spec_double name' nick' blurb' minimum' maximum' default_value' flags' checkUnexpectedReturnNULL "g_param_spec_double" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_enum -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "enum_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "enum_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_enum" g_param_spec_enum :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 CGType -> -- enum_type : TBasicType TGType Int32 -> -- default_value : TBasicType TInt32 CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecEnum :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb GType -> -- enum_type Int32 -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecEnum name nick blurb enum_type default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let enum_type' = gtypeToCGType enum_type let flags' = gflagsToWord flags result <- g_param_spec_enum name' nick' blurb' enum_type' default_value flags' checkUnexpectedReturnNULL "g_param_spec_enum" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_flags -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_flags" g_param_spec_flags :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 CGType -> -- flags_type : TBasicType TGType Word32 -> -- default_value : TBasicType TUInt32 CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecFlags :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb GType -> -- flags_type Word32 -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecFlags name nick blurb flags_type default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let flags_type' = gtypeToCGType flags_type let flags' = gflagsToWord flags result <- g_param_spec_flags name' nick' blurb' flags_type' default_value flags' checkUnexpectedReturnNULL "g_param_spec_flags" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_float -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TFloat, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TFloat, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TFloat, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TFloat, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TFloat, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TFloat, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_float" g_param_spec_float :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 CFloat -> -- minimum : TBasicType TFloat CFloat -> -- maximum : TBasicType TFloat CFloat -> -- default_value : TBasicType TFloat CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecFloat :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb Float -> -- minimum Float -> -- maximum Float -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecFloat name nick blurb minimum maximum default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let minimum' = realToFrac minimum let maximum' = realToFrac maximum let default_value' = realToFrac default_value let flags' = gflagsToWord flags result <- g_param_spec_float name' nick' blurb' minimum' maximum' default_value' flags' checkUnexpectedReturnNULL "g_param_spec_float" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_gtype -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_a_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_a_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_gtype" g_param_spec_gtype :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 CGType -> -- is_a_type : TBasicType TGType CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecGtype :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb GType -> -- is_a_type [ParamFlags] -> -- flags m GParamSpec paramSpecGtype name nick blurb is_a_type flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let is_a_type' = gtypeToCGType is_a_type let flags' = gflagsToWord flags result <- g_param_spec_gtype name' nick' blurb' is_a_type' flags' checkUnexpectedReturnNULL "g_param_spec_gtype" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_int -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_int" g_param_spec_int :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 Int32 -> -- minimum : TBasicType TInt32 Int32 -> -- maximum : TBasicType TInt32 Int32 -> -- default_value : TBasicType TInt32 CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecInt :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb Int32 -> -- minimum Int32 -> -- maximum Int32 -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecInt name nick blurb minimum maximum default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let flags' = gflagsToWord flags result <- g_param_spec_int name' nick' blurb' minimum maximum default_value flags' checkUnexpectedReturnNULL "g_param_spec_int" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_int64 -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_int64" g_param_spec_int64 :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 Int64 -> -- minimum : TBasicType TInt64 Int64 -> -- maximum : TBasicType TInt64 Int64 -> -- default_value : TBasicType TInt64 CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecInt64 :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb Int64 -> -- minimum Int64 -> -- maximum Int64 -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecInt64 name nick blurb minimum maximum default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let flags' = gflagsToWord flags result <- g_param_spec_int64 name' nick' blurb' minimum maximum default_value flags' checkUnexpectedReturnNULL "g_param_spec_int64" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_long -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_long" g_param_spec_long :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 Int64 -> -- minimum : TBasicType TInt64 Int64 -> -- maximum : TBasicType TInt64 Int64 -> -- default_value : TBasicType TInt64 CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecLong :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb Int64 -> -- minimum Int64 -> -- maximum Int64 -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecLong name nick blurb minimum maximum default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let flags' = gflagsToWord flags result <- g_param_spec_long name' nick' blurb' minimum maximum default_value flags' checkUnexpectedReturnNULL "g_param_spec_long" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_object -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_object" g_param_spec_object :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 CGType -> -- object_type : TBasicType TGType CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecObject :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb GType -> -- object_type [ParamFlags] -> -- flags m GParamSpec paramSpecObject name nick blurb object_type flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let object_type' = gtypeToCGType object_type let flags' = gflagsToWord flags result <- g_param_spec_object name' nick' blurb' object_type' flags' checkUnexpectedReturnNULL "g_param_spec_object" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_param -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "param_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_param" g_param_spec_param :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 CGType -> -- param_type : TBasicType TGType CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecParam :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb GType -> -- param_type [ParamFlags] -> -- flags m GParamSpec paramSpecParam name nick blurb param_type flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let param_type' = gtypeToCGType param_type let flags' = gflagsToWord flags result <- g_param_spec_param name' nick' blurb' param_type' flags' checkUnexpectedReturnNULL "g_param_spec_param" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_pointer -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_pointer" g_param_spec_pointer :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecPointer :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb [ParamFlags] -> -- flags m GParamSpec paramSpecPointer name nick blurb flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let flags' = gflagsToWord flags result <- g_param_spec_pointer name' nick' blurb' flags' checkUnexpectedReturnNULL "g_param_spec_pointer" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_pool_new -- Args : [Arg {argName = "type_prefixing", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type_prefixing", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "ParamSpecPool" -- throws : False -- Skip return : False foreign import ccall "g_param_spec_pool_new" g_param_spec_pool_new :: CInt -> -- type_prefixing : TBasicType TBoolean IO (Ptr ParamSpecPool) paramSpecPoolNew :: (MonadIO m) => Bool -> -- type_prefixing m ParamSpecPool paramSpecPoolNew type_prefixing = liftIO $ do let type_prefixing' = (fromIntegral . fromEnum) type_prefixing result <- g_param_spec_pool_new type_prefixing' checkUnexpectedReturnNULL "g_param_spec_pool_new" result -- XXX Wrapping a foreign struct/union with no known destructor, leak? result' <- (\x -> ParamSpecPool <$> newForeignPtr_ x) result return result' -- function g_param_spec_string -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_string" g_param_spec_string :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 CString -> -- default_value : TBasicType TUTF8 CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecString :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb T.Text -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecString name nick blurb default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb default_value' <- textToCString default_value let flags' = gflagsToWord flags result <- g_param_spec_string name' nick' blurb' default_value' flags' checkUnexpectedReturnNULL "g_param_spec_string" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' freeMem default_value' return result' -- function g_param_spec_uchar -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_uchar" g_param_spec_uchar :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 Word8 -> -- minimum : TBasicType TUInt8 Word8 -> -- maximum : TBasicType TUInt8 Word8 -> -- default_value : TBasicType TUInt8 CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecUchar :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb Word8 -> -- minimum Word8 -> -- maximum Word8 -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecUchar name nick blurb minimum maximum default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let flags' = gflagsToWord flags result <- g_param_spec_uchar name' nick' blurb' minimum maximum default_value flags' checkUnexpectedReturnNULL "g_param_spec_uchar" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_uint -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_uint" g_param_spec_uint :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 Word32 -> -- minimum : TBasicType TUInt32 Word32 -> -- maximum : TBasicType TUInt32 Word32 -> -- default_value : TBasicType TUInt32 CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecUint :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb Word32 -> -- minimum Word32 -> -- maximum Word32 -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecUint name nick blurb minimum maximum default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let flags' = gflagsToWord flags result <- g_param_spec_uint name' nick' blurb' minimum maximum default_value flags' checkUnexpectedReturnNULL "g_param_spec_uint" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_uint64 -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_uint64" g_param_spec_uint64 :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 Word64 -> -- minimum : TBasicType TUInt64 Word64 -> -- maximum : TBasicType TUInt64 Word64 -> -- default_value : TBasicType TUInt64 CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecUint64 :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb Word64 -> -- minimum Word64 -> -- maximum Word64 -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecUint64 name nick blurb minimum maximum default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let flags' = gflagsToWord flags result <- g_param_spec_uint64 name' nick' blurb' minimum maximum default_value flags' checkUnexpectedReturnNULL "g_param_spec_uint64" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_ulong -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "minimum", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "maximum", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_ulong" g_param_spec_ulong :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 Word64 -> -- minimum : TBasicType TUInt64 Word64 -> -- maximum : TBasicType TUInt64 Word64 -> -- default_value : TBasicType TUInt64 CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecUlong :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb Word64 -> -- minimum Word64 -> -- maximum Word64 -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecUlong name nick blurb minimum maximum default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let flags' = gflagsToWord flags result <- g_param_spec_ulong name' nick' blurb' minimum maximum default_value flags' checkUnexpectedReturnNULL "g_param_spec_ulong" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_unichar -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TBasicType TUniChar, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_unichar" g_param_spec_unichar :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 CInt -> -- default_value : TBasicType TUniChar CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecUnichar :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb Char -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecUnichar name nick blurb default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let default_value' = (fromIntegral . ord) default_value let flags' = gflagsToWord flags result <- g_param_spec_unichar name' nick' blurb' default_value' flags' checkUnexpectedReturnNULL "g_param_spec_unichar" result result' <- wrapGParamSpecPtr result freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_spec_variant -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "nick", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "blurb", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TInterface "GLib" "VariantType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "default_value", argType = TVariant, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "flags", argType = TInterface "GObject" "ParamFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TParamSpec -- throws : False -- Skip return : False foreign import ccall "g_param_spec_variant" g_param_spec_variant :: CString -> -- name : TBasicType TUTF8 CString -> -- nick : TBasicType TUTF8 CString -> -- blurb : TBasicType TUTF8 Ptr GLib.VariantType -> -- type : TInterface "GLib" "VariantType" Ptr GVariant -> -- default_value : TVariant CUInt -> -- flags : TInterface "GObject" "ParamFlags" IO (Ptr GParamSpec) paramSpecVariant :: (MonadIO m) => T.Text -> -- name T.Text -> -- nick T.Text -> -- blurb GLib.VariantType -> -- type Maybe (GVariant) -> -- default_value [ParamFlags] -> -- flags m GParamSpec paramSpecVariant name nick blurb type_ default_value flags = liftIO $ do name' <- textToCString name nick' <- textToCString nick blurb' <- textToCString blurb let type_' = unsafeManagedPtrGetPtr type_ maybeDefault_value <- case default_value of Nothing -> return nullPtr Just jDefault_value -> do jDefault_value' <- refGVariant jDefault_value return jDefault_value' let flags' = gflagsToWord flags result <- g_param_spec_variant name' nick' blurb' type_' maybeDefault_value flags' checkUnexpectedReturnNULL "g_param_spec_variant" result result' <- wrapGParamSpecPtr result touchManagedPtr type_ freeMem name' freeMem nick' freeMem blurb' return result' -- function g_param_type_register_static -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pspec_info", argType = TInterface "GObject" "ParamSpecTypeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pspec_info", argType = TInterface "GObject" "ParamSpecTypeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_param_type_register_static" g_param_type_register_static :: CString -> -- name : TBasicType TUTF8 Ptr ParamSpecTypeInfo -> -- pspec_info : TInterface "GObject" "ParamSpecTypeInfo" IO CGType paramTypeRegisterStatic :: (MonadIO m) => T.Text -> -- name ParamSpecTypeInfo -> -- pspec_info m GType paramTypeRegisterStatic name pspec_info = liftIO $ do name' <- textToCString name let pspec_info' = unsafeManagedPtrGetPtr pspec_info result <- g_param_type_register_static name' pspec_info' let result' = GType result touchManagedPtr pspec_info freeMem name' return result' -- function g_param_value_convert -- Args : [Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "strict_validation", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "src_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "strict_validation", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_param_value_convert" g_param_value_convert :: Ptr GParamSpec -> -- pspec : TParamSpec Ptr GValue -> -- src_value : TInterface "GObject" "Value" Ptr GValue -> -- dest_value : TInterface "GObject" "Value" CInt -> -- strict_validation : TBasicType TBoolean IO CInt paramValueConvert :: (MonadIO m) => GParamSpec -> -- pspec GValue -> -- src_value GValue -> -- dest_value Bool -> -- strict_validation m Bool paramValueConvert pspec src_value dest_value strict_validation = liftIO $ do let pspec' = unsafeManagedPtrGetPtr pspec let src_value' = unsafeManagedPtrGetPtr src_value let dest_value' = unsafeManagedPtrGetPtr dest_value let strict_validation' = (fromIntegral . fromEnum) strict_validation result <- g_param_value_convert pspec' src_value' dest_value' strict_validation' let result' = (/= 0) result touchManagedPtr src_value touchManagedPtr dest_value return result' -- function g_param_value_defaults -- Args : [Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_param_value_defaults" g_param_value_defaults :: Ptr GParamSpec -> -- pspec : TParamSpec Ptr GValue -> -- value : TInterface "GObject" "Value" IO CInt paramValueDefaults :: (MonadIO m) => GParamSpec -> -- pspec GValue -> -- value m Bool paramValueDefaults pspec value = liftIO $ do let pspec' = unsafeManagedPtrGetPtr pspec let value' = unsafeManagedPtrGetPtr value result <- g_param_value_defaults pspec' value' let result' = (/= 0) result touchManagedPtr value return result' -- function g_param_value_set_default -- Args : [Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_param_value_set_default" g_param_value_set_default :: Ptr GParamSpec -> -- pspec : TParamSpec Ptr GValue -> -- value : TInterface "GObject" "Value" IO () paramValueSetDefault :: (MonadIO m) => GParamSpec -> -- pspec GValue -> -- value m () paramValueSetDefault pspec value = liftIO $ do let pspec' = unsafeManagedPtrGetPtr pspec let value' = unsafeManagedPtrGetPtr value g_param_value_set_default pspec' value' touchManagedPtr value return () -- function g_param_value_validate -- Args : [Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_param_value_validate" g_param_value_validate :: Ptr GParamSpec -> -- pspec : TParamSpec Ptr GValue -> -- value : TInterface "GObject" "Value" IO CInt paramValueValidate :: (MonadIO m) => GParamSpec -> -- pspec GValue -> -- value m Bool paramValueValidate pspec value = liftIO $ do let pspec' = unsafeManagedPtrGetPtr pspec let value' = unsafeManagedPtrGetPtr value result <- g_param_value_validate pspec' value' let result' = (/= 0) result touchManagedPtr value return result' -- function g_param_values_cmp -- Args : [Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value1", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value2", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "pspec", argType = TParamSpec, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value1", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value2", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_param_values_cmp" g_param_values_cmp :: Ptr GParamSpec -> -- pspec : TParamSpec Ptr GValue -> -- value1 : TInterface "GObject" "Value" Ptr GValue -> -- value2 : TInterface "GObject" "Value" IO Int32 paramValuesCmp :: (MonadIO m) => GParamSpec -> -- pspec GValue -> -- value1 GValue -> -- value2 m Int32 paramValuesCmp pspec value1 value2 = liftIO $ do let pspec' = unsafeManagedPtrGetPtr pspec let value1' = unsafeManagedPtrGetPtr value1 let value2' = unsafeManagedPtrGetPtr value2 result <- g_param_values_cmp pspec' value1' value2' touchManagedPtr value1 touchManagedPtr value2 return result -- function g_pointer_type_register_static -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_pointer_type_register_static" g_pointer_type_register_static :: CString -> -- name : TBasicType TUTF8 IO CGType pointerTypeRegisterStatic :: (MonadIO m) => T.Text -> -- name m GType pointerTypeRegisterStatic name = liftIO $ do name' <- textToCString name result <- g_pointer_type_register_static name' let result' = GType result freeMem name' return result' -- function g_signal_accumulator_first_wins -- Args : [Arg {argName = "ihint", argType = TInterface "GObject" "SignalInvocationHint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_accu", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_return", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dummy", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ihint", argType = TInterface "GObject" "SignalInvocationHint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_accu", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_return", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dummy", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_signal_accumulator_first_wins" g_signal_accumulator_first_wins :: Ptr SignalInvocationHint -> -- ihint : TInterface "GObject" "SignalInvocationHint" Ptr GValue -> -- return_accu : TInterface "GObject" "Value" Ptr GValue -> -- handler_return : TInterface "GObject" "Value" Ptr () -> -- dummy : TBasicType TVoid IO CInt signalAccumulatorFirstWins :: (MonadIO m) => SignalInvocationHint -> -- ihint GValue -> -- return_accu GValue -> -- handler_return Ptr () -> -- dummy m Bool signalAccumulatorFirstWins ihint return_accu handler_return dummy = liftIO $ do let ihint' = unsafeManagedPtrGetPtr ihint let return_accu' = unsafeManagedPtrGetPtr return_accu let handler_return' = unsafeManagedPtrGetPtr handler_return result <- g_signal_accumulator_first_wins ihint' return_accu' handler_return' dummy let result' = (/= 0) result touchManagedPtr ihint touchManagedPtr return_accu touchManagedPtr handler_return return result' -- function g_signal_accumulator_true_handled -- Args : [Arg {argName = "ihint", argType = TInterface "GObject" "SignalInvocationHint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_accu", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_return", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dummy", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "ihint", argType = TInterface "GObject" "SignalInvocationHint", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_accu", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_return", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dummy", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_signal_accumulator_true_handled" g_signal_accumulator_true_handled :: Ptr SignalInvocationHint -> -- ihint : TInterface "GObject" "SignalInvocationHint" Ptr GValue -> -- return_accu : TInterface "GObject" "Value" Ptr GValue -> -- handler_return : TInterface "GObject" "Value" Ptr () -> -- dummy : TBasicType TVoid IO CInt signalAccumulatorTrueHandled :: (MonadIO m) => SignalInvocationHint -> -- ihint GValue -> -- return_accu GValue -> -- handler_return Ptr () -> -- dummy m Bool signalAccumulatorTrueHandled ihint return_accu handler_return dummy = liftIO $ do let ihint' = unsafeManagedPtrGetPtr ihint let return_accu' = unsafeManagedPtrGetPtr return_accu let handler_return' = unsafeManagedPtrGetPtr handler_return result <- g_signal_accumulator_true_handled ihint' return_accu' handler_return' dummy let result' = (/= 0) result touchManagedPtr ihint touchManagedPtr return_accu touchManagedPtr handler_return return result' -- function g_signal_add_emission_hook -- Args : [Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook_func", argType = TInterface "GObject" "SignalEmissionHook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing},Arg {argName = "hook_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data_destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook_func", argType = TInterface "GObject" "SignalEmissionHook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_signal_add_emission_hook" g_signal_add_emission_hook :: Word32 -> -- signal_id : TBasicType TUInt32 Word32 -> -- detail : TBasicType TUInt32 FunPtr SignalEmissionHookC -> -- hook_func : TInterface "GObject" "SignalEmissionHook" Ptr () -> -- hook_data : TBasicType TVoid FunPtr GLib.DestroyNotifyC -> -- data_destroy : TInterface "GLib" "DestroyNotify" IO Word64 signalAddEmissionHook :: (MonadIO m) => Word32 -> -- signal_id Word32 -> -- detail SignalEmissionHook -> -- hook_func m Word64 signalAddEmissionHook signal_id detail hook_func = liftIO $ do hook_func' <- mkSignalEmissionHook (signalEmissionHookWrapper Nothing hook_func) let hook_data = castFunPtrToPtr hook_func' let data_destroy = safeFreeFunPtrPtr result <- g_signal_add_emission_hook signal_id detail hook_func' hook_data data_destroy return result -- function g_signal_chain_from_overridden -- Args : [Arg {argName = "instance_and_params", argType = TCArray False (-1) (-1) (TInterface "GObject" "Value"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance_and_params", argType = TCArray False (-1) (-1) (TInterface "GObject" "Value"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_signal_chain_from_overridden" g_signal_chain_from_overridden :: Ptr (Ptr GValue) -> -- instance_and_params : TCArray False (-1) (-1) (TInterface "GObject" "Value") Ptr GValue -> -- return_value : TInterface "GObject" "Value" IO () signalChainFromOverridden :: (MonadIO m) => Ptr (Ptr GValue) -> -- instance_and_params GValue -> -- return_value m () signalChainFromOverridden instance_and_params return_value = liftIO $ do let return_value' = unsafeManagedPtrGetPtr return_value g_signal_chain_from_overridden instance_and_params return_value' touchManagedPtr return_value return () -- function g_signal_connect_closure -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_signal", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "after", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_signal", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "after", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_signal_connect_closure" g_signal_connect_closure :: Ptr Object -> -- instance : TInterface "GObject" "Object" CString -> -- detailed_signal : TBasicType TUTF8 Ptr Closure -> -- closure : TInterface "GObject" "Closure" CInt -> -- after : TBasicType TBoolean IO Word64 signalConnectClosure :: (MonadIO m, ObjectK a) => a -> -- instance T.Text -> -- detailed_signal Closure -> -- closure Bool -> -- after m Word64 signalConnectClosure instance_ detailed_signal closure after = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ detailed_signal' <- textToCString detailed_signal let closure' = unsafeManagedPtrGetPtr closure let after' = (fromIntegral . fromEnum) after result <- g_signal_connect_closure instance_' detailed_signal' closure' after' touchManagedPtr instance_ touchManagedPtr closure freeMem detailed_signal' return result -- function g_signal_connect_closure_by_id -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "after", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "after", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_signal_connect_closure_by_id" g_signal_connect_closure_by_id :: Ptr Object -> -- instance : TInterface "GObject" "Object" Word32 -> -- signal_id : TBasicType TUInt32 Word32 -> -- detail : TBasicType TUInt32 Ptr Closure -> -- closure : TInterface "GObject" "Closure" CInt -> -- after : TBasicType TBoolean IO Word64 signalConnectClosureById :: (MonadIO m, ObjectK a) => a -> -- instance Word32 -> -- signal_id Word32 -> -- detail Closure -> -- closure Bool -> -- after m Word64 signalConnectClosureById instance_ signal_id detail closure after = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ let closure' = unsafeManagedPtrGetPtr closure let after' = (fromIntegral . fromEnum) after result <- g_signal_connect_closure_by_id instance_' signal_id detail closure' after' touchManagedPtr instance_ touchManagedPtr closure return result -- function g_signal_emitv -- Args : [Arg {argName = "instance_and_params", argType = TCArray False (-1) (-1) (TInterface "GObject" "Value"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance_and_params", argType = TCArray False (-1) (-1) (TInterface "GObject" "Value"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "return_value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_signal_emitv" g_signal_emitv :: Ptr (Ptr GValue) -> -- instance_and_params : TCArray False (-1) (-1) (TInterface "GObject" "Value") Word32 -> -- signal_id : TBasicType TUInt32 Word32 -> -- detail : TBasicType TUInt32 Ptr GValue -> -- return_value : TInterface "GObject" "Value" IO () signalEmitv :: (MonadIO m) => Ptr (Ptr GValue) -> -- instance_and_params Word32 -> -- signal_id Word32 -> -- detail GValue -> -- return_value m () signalEmitv instance_and_params signal_id detail return_value = liftIO $ do let return_value' = unsafeManagedPtrGetPtr return_value g_signal_emitv instance_and_params signal_id detail return_value' touchManagedPtr return_value return () -- function g_signal_get_invocation_hint -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "SignalInvocationHint" -- throws : False -- Skip return : False foreign import ccall "g_signal_get_invocation_hint" g_signal_get_invocation_hint :: Ptr Object -> -- instance : TInterface "GObject" "Object" IO (Ptr SignalInvocationHint) signalGetInvocationHint :: (MonadIO m, ObjectK a) => a -> -- instance m SignalInvocationHint signalGetInvocationHint instance_ = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ result <- g_signal_get_invocation_hint instance_' checkUnexpectedReturnNULL "g_signal_get_invocation_hint" result result' <- (newPtr 12 SignalInvocationHint) result touchManagedPtr instance_ return result' -- function g_signal_handler_block -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_id", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_id", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_signal_handler_block" g_signal_handler_block :: Ptr Object -> -- instance : TInterface "GObject" "Object" Word64 -> -- handler_id : TBasicType TUInt64 IO () signalHandlerBlock :: (MonadIO m, ObjectK a) => a -> -- instance Word64 -> -- handler_id m () signalHandlerBlock instance_ handler_id = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ g_signal_handler_block instance_' handler_id touchManagedPtr instance_ return () -- function g_signal_handler_disconnect -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_id", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_id", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_signal_handler_disconnect" g_signal_handler_disconnect :: Ptr Object -> -- instance : TInterface "GObject" "Object" Word64 -> -- handler_id : TBasicType TUInt64 IO () signalHandlerDisconnect :: (MonadIO m, ObjectK a) => a -> -- instance Word64 -> -- handler_id m () signalHandlerDisconnect instance_ handler_id = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ g_signal_handler_disconnect instance_' handler_id touchManagedPtr instance_ return () -- function g_signal_handler_find -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mask", argType = TInterface "GObject" "SignalMatchType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mask", argType = TInterface "GObject" "SignalMatchType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt64 -- throws : False -- Skip return : False foreign import ccall "g_signal_handler_find" g_signal_handler_find :: Ptr Object -> -- instance : TInterface "GObject" "Object" CUInt -> -- mask : TInterface "GObject" "SignalMatchType" Word32 -> -- signal_id : TBasicType TUInt32 Word32 -> -- detail : TBasicType TUInt32 Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr () -> -- func : TBasicType TVoid Ptr () -> -- data : TBasicType TVoid IO Word64 signalHandlerFind :: (MonadIO m, ObjectK a) => a -> -- instance [SignalMatchType] -> -- mask Word32 -> -- signal_id Word32 -> -- detail Maybe (Closure) -> -- closure Ptr () -> -- func Ptr () -> -- data m Word64 signalHandlerFind instance_ mask signal_id detail closure func data_ = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ let mask' = gflagsToWord mask maybeClosure <- case closure of Nothing -> return nullPtr Just jClosure -> do let jClosure' = unsafeManagedPtrGetPtr jClosure return jClosure' result <- g_signal_handler_find instance_' mask' signal_id detail maybeClosure func data_ touchManagedPtr instance_ whenJust closure touchManagedPtr return result -- function g_signal_handler_is_connected -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_id", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_id", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_signal_handler_is_connected" g_signal_handler_is_connected :: Ptr Object -> -- instance : TInterface "GObject" "Object" Word64 -> -- handler_id : TBasicType TUInt64 IO CInt signalHandlerIsConnected :: (MonadIO m, ObjectK a) => a -> -- instance Word64 -> -- handler_id m Bool signalHandlerIsConnected instance_ handler_id = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ result <- g_signal_handler_is_connected instance_' handler_id let result' = (/= 0) result touchManagedPtr instance_ return result' -- function g_signal_handler_unblock -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_id", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "handler_id", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_signal_handler_unblock" g_signal_handler_unblock :: Ptr Object -> -- instance : TInterface "GObject" "Object" Word64 -> -- handler_id : TBasicType TUInt64 IO () signalHandlerUnblock :: (MonadIO m, ObjectK a) => a -> -- instance Word64 -> -- handler_id m () signalHandlerUnblock instance_ handler_id = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ g_signal_handler_unblock instance_' handler_id touchManagedPtr instance_ return () -- function g_signal_handlers_block_matched -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mask", argType = TInterface "GObject" "SignalMatchType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mask", argType = TInterface "GObject" "SignalMatchType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_signal_handlers_block_matched" g_signal_handlers_block_matched :: Ptr Object -> -- instance : TInterface "GObject" "Object" CUInt -> -- mask : TInterface "GObject" "SignalMatchType" Word32 -> -- signal_id : TBasicType TUInt32 Word32 -> -- detail : TBasicType TUInt32 Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr () -> -- func : TBasicType TVoid Ptr () -> -- data : TBasicType TVoid IO Word32 signalHandlersBlockMatched :: (MonadIO m, ObjectK a) => a -> -- instance [SignalMatchType] -> -- mask Word32 -> -- signal_id Word32 -> -- detail Maybe (Closure) -> -- closure Ptr () -> -- func Ptr () -> -- data m Word32 signalHandlersBlockMatched instance_ mask signal_id detail closure func data_ = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ let mask' = gflagsToWord mask maybeClosure <- case closure of Nothing -> return nullPtr Just jClosure -> do let jClosure' = unsafeManagedPtrGetPtr jClosure return jClosure' result <- g_signal_handlers_block_matched instance_' mask' signal_id detail maybeClosure func data_ touchManagedPtr instance_ whenJust closure touchManagedPtr return result -- function g_signal_handlers_destroy -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_signal_handlers_destroy" g_signal_handlers_destroy :: Ptr Object -> -- instance : TInterface "GObject" "Object" IO () signalHandlersDestroy :: (MonadIO m, ObjectK a) => a -> -- instance m () signalHandlersDestroy instance_ = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ g_signal_handlers_destroy instance_' touchManagedPtr instance_ return () -- function g_signal_handlers_disconnect_matched -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mask", argType = TInterface "GObject" "SignalMatchType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mask", argType = TInterface "GObject" "SignalMatchType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_signal_handlers_disconnect_matched" g_signal_handlers_disconnect_matched :: Ptr Object -> -- instance : TInterface "GObject" "Object" CUInt -> -- mask : TInterface "GObject" "SignalMatchType" Word32 -> -- signal_id : TBasicType TUInt32 Word32 -> -- detail : TBasicType TUInt32 Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr () -> -- func : TBasicType TVoid Ptr () -> -- data : TBasicType TVoid IO Word32 signalHandlersDisconnectMatched :: (MonadIO m, ObjectK a) => a -> -- instance [SignalMatchType] -> -- mask Word32 -> -- signal_id Word32 -> -- detail Maybe (Closure) -> -- closure Ptr () -> -- func Ptr () -> -- data m Word32 signalHandlersDisconnectMatched instance_ mask signal_id detail closure func data_ = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ let mask' = gflagsToWord mask maybeClosure <- case closure of Nothing -> return nullPtr Just jClosure -> do let jClosure' = unsafeManagedPtrGetPtr jClosure return jClosure' result <- g_signal_handlers_disconnect_matched instance_' mask' signal_id detail maybeClosure func data_ touchManagedPtr instance_ whenJust closure touchManagedPtr return result -- function g_signal_handlers_unblock_matched -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mask", argType = TInterface "GObject" "SignalMatchType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mask", argType = TInterface "GObject" "SignalMatchType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_signal_handlers_unblock_matched" g_signal_handlers_unblock_matched :: Ptr Object -> -- instance : TInterface "GObject" "Object" CUInt -> -- mask : TInterface "GObject" "SignalMatchType" Word32 -> -- signal_id : TBasicType TUInt32 Word32 -> -- detail : TBasicType TUInt32 Ptr Closure -> -- closure : TInterface "GObject" "Closure" Ptr () -> -- func : TBasicType TVoid Ptr () -> -- data : TBasicType TVoid IO Word32 signalHandlersUnblockMatched :: (MonadIO m, ObjectK a) => a -> -- instance [SignalMatchType] -> -- mask Word32 -> -- signal_id Word32 -> -- detail Maybe (Closure) -> -- closure Ptr () -> -- func Ptr () -> -- data m Word32 signalHandlersUnblockMatched instance_ mask signal_id detail closure func data_ = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ let mask' = gflagsToWord mask maybeClosure <- case closure of Nothing -> return nullPtr Just jClosure -> do let jClosure' = unsafeManagedPtrGetPtr jClosure return jClosure' result <- g_signal_handlers_unblock_matched instance_' mask' signal_id detail maybeClosure func data_ touchManagedPtr instance_ whenJust closure touchManagedPtr return result -- function g_signal_has_handler_pending -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "may_be_blocked", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "may_be_blocked", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_signal_has_handler_pending" g_signal_has_handler_pending :: Ptr Object -> -- instance : TInterface "GObject" "Object" Word32 -> -- signal_id : TBasicType TUInt32 Word32 -> -- detail : TBasicType TUInt32 CInt -> -- may_be_blocked : TBasicType TBoolean IO CInt signalHasHandlerPending :: (MonadIO m, ObjectK a) => a -> -- instance Word32 -> -- signal_id Word32 -> -- detail Bool -> -- may_be_blocked m Bool signalHasHandlerPending instance_ signal_id detail may_be_blocked = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ let may_be_blocked' = (fromIntegral . fromEnum) may_be_blocked result <- g_signal_has_handler_pending instance_' signal_id detail may_be_blocked' let result' = (/= 0) result touchManagedPtr instance_ return result' -- function g_signal_list_ids -- Args : [Arg {argName = "itype", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_ids", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_ids", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "itype", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 1 (TBasicType TUInt32) -- throws : False -- Skip return : False foreign import ccall "g_signal_list_ids" g_signal_list_ids :: CGType -> -- itype : TBasicType TGType Ptr Word32 -> -- n_ids : TBasicType TUInt32 IO (Ptr Word32) signalListIds :: (MonadIO m) => GType -> -- itype m [Word32] signalListIds itype = liftIO $ do let itype' = gtypeToCGType itype n_ids <- allocMem :: IO (Ptr Word32) result <- g_signal_list_ids itype' n_ids n_ids' <- peek n_ids checkUnexpectedReturnNULL "g_signal_list_ids" result result' <- (unpackStorableArrayWithLength n_ids') result freeMem n_ids return result' -- function g_signal_lookup -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "itype", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "itype", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_signal_lookup" g_signal_lookup :: CString -> -- name : TBasicType TUTF8 CGType -> -- itype : TBasicType TGType IO Word32 signalLookup :: (MonadIO m) => T.Text -> -- name GType -> -- itype m Word32 signalLookup name itype = liftIO $ do name' <- textToCString name let itype' = gtypeToCGType itype result <- g_signal_lookup name' itype' freeMem name' return result -- function g_signal_name -- Args : [Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_signal_name" g_signal_name :: Word32 -> -- signal_id : TBasicType TUInt32 IO CString signalName :: (MonadIO m) => Word32 -> -- signal_id m T.Text signalName signal_id = liftIO $ do result <- g_signal_name signal_id checkUnexpectedReturnNULL "g_signal_name" result result' <- cstringToText result return result' -- function g_signal_override_class_closure -- Args : [Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "instance_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "class_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "instance_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "class_closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_signal_override_class_closure" g_signal_override_class_closure :: Word32 -> -- signal_id : TBasicType TUInt32 CGType -> -- instance_type : TBasicType TGType Ptr Closure -> -- class_closure : TInterface "GObject" "Closure" IO () signalOverrideClassClosure :: (MonadIO m) => Word32 -> -- signal_id GType -> -- instance_type Closure -> -- class_closure m () signalOverrideClassClosure signal_id instance_type class_closure = liftIO $ do let instance_type' = gtypeToCGType instance_type let class_closure' = unsafeManagedPtrGetPtr class_closure g_signal_override_class_closure signal_id instance_type' class_closure' touchManagedPtr class_closure return () -- function g_signal_parse_name -- Args : [Arg {argName = "detailed_signal", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "itype", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id_p", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "detail_p", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "force_detail_quark", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "detailed_signal", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "itype", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "force_detail_quark", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_signal_parse_name" g_signal_parse_name :: CString -> -- detailed_signal : TBasicType TUTF8 CGType -> -- itype : TBasicType TGType Ptr Word32 -> -- signal_id_p : TBasicType TUInt32 Ptr Word32 -> -- detail_p : TBasicType TUInt32 CInt -> -- force_detail_quark : TBasicType TBoolean IO CInt signalParseName :: (MonadIO m) => T.Text -> -- detailed_signal GType -> -- itype Bool -> -- force_detail_quark m (Bool,Word32,Word32) signalParseName detailed_signal itype force_detail_quark = liftIO $ do detailed_signal' <- textToCString detailed_signal let itype' = gtypeToCGType itype signal_id_p <- allocMem :: IO (Ptr Word32) detail_p <- allocMem :: IO (Ptr Word32) let force_detail_quark' = (fromIntegral . fromEnum) force_detail_quark result <- g_signal_parse_name detailed_signal' itype' signal_id_p detail_p force_detail_quark' let result' = (/= 0) result signal_id_p' <- peek signal_id_p detail_p' <- peek detail_p freeMem detailed_signal' freeMem signal_id_p freeMem detail_p return (result', signal_id_p', detail_p') -- function g_signal_query -- Args : [Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "query", argType = TInterface "GObject" "SignalQuery", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_signal_query" g_signal_query :: Word32 -> -- signal_id : TBasicType TUInt32 Ptr SignalQuery -> -- query : TInterface "GObject" "SignalQuery" IO () signalQuery :: (MonadIO m) => Word32 -> -- signal_id m (SignalQuery) signalQuery signal_id = liftIO $ do query <- callocBytes 56 :: IO (Ptr SignalQuery) g_signal_query signal_id query query' <- (wrapPtr SignalQuery) query return query' -- function g_signal_remove_emission_hook -- Args : [Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook_id", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hook_id", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_signal_remove_emission_hook" g_signal_remove_emission_hook :: Word32 -> -- signal_id : TBasicType TUInt32 Word64 -> -- hook_id : TBasicType TUInt64 IO () signalRemoveEmissionHook :: (MonadIO m) => Word32 -> -- signal_id Word64 -> -- hook_id m () signalRemoveEmissionHook signal_id hook_id = liftIO $ do g_signal_remove_emission_hook signal_id hook_id return () -- function g_signal_stop_emission -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "signal_id", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detail", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_signal_stop_emission" g_signal_stop_emission :: Ptr Object -> -- instance : TInterface "GObject" "Object" Word32 -> -- signal_id : TBasicType TUInt32 Word32 -> -- detail : TBasicType TUInt32 IO () signalStopEmission :: (MonadIO m, ObjectK a) => a -> -- instance Word32 -> -- signal_id Word32 -> -- detail m () signalStopEmission instance_ signal_id detail = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ g_signal_stop_emission instance_' signal_id detail touchManagedPtr instance_ return () -- function g_signal_stop_emission_by_name -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_signal", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "detailed_signal", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_signal_stop_emission_by_name" g_signal_stop_emission_by_name :: Ptr Object -> -- instance : TInterface "GObject" "Object" CString -> -- detailed_signal : TBasicType TUTF8 IO () signalStopEmissionByName :: (MonadIO m, ObjectK a) => a -> -- instance T.Text -> -- detailed_signal m () signalStopEmissionByName instance_ detailed_signal = liftIO $ do let instance_' = unsafeManagedPtrCastPtr instance_ detailed_signal' <- textToCString detailed_signal g_signal_stop_emission_by_name instance_' detailed_signal' touchManagedPtr instance_ freeMem detailed_signal' return () -- function g_signal_type_cclosure_new -- Args : [Arg {argName = "itype", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "struct_offset", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "itype", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "struct_offset", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "Closure" -- throws : False -- Skip return : False foreign import ccall "g_signal_type_cclosure_new" g_signal_type_cclosure_new :: CGType -> -- itype : TBasicType TGType Word32 -> -- struct_offset : TBasicType TUInt32 IO (Ptr Closure) signalTypeCclosureNew :: (MonadIO m) => GType -> -- itype Word32 -> -- struct_offset m Closure signalTypeCclosureNew itype struct_offset = liftIO $ do let itype' = gtypeToCGType itype result <- g_signal_type_cclosure_new itype' struct_offset checkUnexpectedReturnNULL "g_signal_type_cclosure_new" result result' <- (wrapBoxed Closure) result return result' -- function g_source_set_closure -- Args : [Arg {argName = "source", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "source", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "closure", argType = TInterface "GObject" "Closure", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_set_closure" g_source_set_closure :: Ptr GLib.Source -> -- source : TInterface "GLib" "Source" Ptr Closure -> -- closure : TInterface "GObject" "Closure" IO () sourceSetClosure :: (MonadIO m) => GLib.Source -> -- source Closure -> -- closure m () sourceSetClosure source closure = liftIO $ do let source' = unsafeManagedPtrGetPtr source let closure' = unsafeManagedPtrGetPtr closure g_source_set_closure source' closure' touchManagedPtr source touchManagedPtr closure return () -- function g_source_set_dummy_callback -- Args : [Arg {argName = "source", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "source", argType = TInterface "GLib" "Source", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_source_set_dummy_callback" g_source_set_dummy_callback :: Ptr GLib.Source -> -- source : TInterface "GLib" "Source" IO () sourceSetDummyCallback :: (MonadIO m) => GLib.Source -> -- source m () sourceSetDummyCallback source = liftIO $ do let source' = unsafeManagedPtrGetPtr source g_source_set_dummy_callback source' touchManagedPtr source return () -- function g_strdup_value_contents -- Args : [Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_strdup_value_contents" g_strdup_value_contents :: Ptr GValue -> -- value : TInterface "GObject" "Value" IO CString strdupValueContents :: (MonadIO m) => GValue -> -- value m T.Text strdupValueContents value = liftIO $ do let value' = unsafeManagedPtrGetPtr value result <- g_strdup_value_contents value' checkUnexpectedReturnNULL "g_strdup_value_contents" result result' <- cstringToText result freeMem result touchManagedPtr value return result' -- function g_type_add_class_private -- Args : [Arg {argName = "class_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "private_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "class_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "private_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_add_class_private" g_type_add_class_private :: CGType -> -- class_type : TBasicType TGType Word64 -> -- private_size : TBasicType TUInt64 IO () typeAddClassPrivate :: (MonadIO m) => GType -> -- class_type Word64 -> -- private_size m () typeAddClassPrivate class_type private_size = liftIO $ do let class_type' = gtypeToCGType class_type g_type_add_class_private class_type' private_size return () -- function g_type_add_instance_private -- Args : [Arg {argName = "class_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "private_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "class_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "private_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_type_add_instance_private" g_type_add_instance_private :: CGType -> -- class_type : TBasicType TGType Word64 -> -- private_size : TBasicType TUInt64 IO Int32 typeAddInstancePrivate :: (MonadIO m) => GType -> -- class_type Word64 -> -- private_size m Int32 typeAddInstancePrivate class_type private_size = liftIO $ do let class_type' = gtypeToCGType class_type result <- g_type_add_instance_private class_type' private_size return result -- function g_type_add_interface_dynamic -- Args : [Arg {argName = "instance_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "plugin", argType = TInterface "GObject" "TypePlugin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "plugin", argType = TInterface "GObject" "TypePlugin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_add_interface_dynamic" g_type_add_interface_dynamic :: CGType -> -- instance_type : TBasicType TGType CGType -> -- interface_type : TBasicType TGType Ptr TypePlugin -> -- plugin : TInterface "GObject" "TypePlugin" IO () typeAddInterfaceDynamic :: (MonadIO m, TypePluginK a) => GType -> -- instance_type GType -> -- interface_type a -> -- plugin m () typeAddInterfaceDynamic instance_type interface_type plugin = liftIO $ do let instance_type' = gtypeToCGType instance_type let interface_type' = gtypeToCGType interface_type let plugin' = unsafeManagedPtrCastPtr plugin g_type_add_interface_dynamic instance_type' interface_type' plugin' touchManagedPtr plugin return () -- function g_type_add_interface_static -- Args : [Arg {argName = "instance_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "GObject" "InterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "interface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "GObject" "InterfaceInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_add_interface_static" g_type_add_interface_static :: CGType -> -- instance_type : TBasicType TGType CGType -> -- interface_type : TBasicType TGType Ptr InterfaceInfo -> -- info : TInterface "GObject" "InterfaceInfo" IO () typeAddInterfaceStatic :: (MonadIO m) => GType -> -- instance_type GType -> -- interface_type InterfaceInfo -> -- info m () typeAddInterfaceStatic instance_type interface_type info = liftIO $ do let instance_type' = gtypeToCGType instance_type let interface_type' = gtypeToCGType interface_type let info' = unsafeManagedPtrGetPtr info g_type_add_interface_static instance_type' interface_type' info' touchManagedPtr info return () -- function g_type_check_class_is_a -- Args : [Arg {argName = "g_class", argType = TInterface "GObject" "TypeClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_a_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "g_class", argType = TInterface "GObject" "TypeClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_a_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_type_check_class_is_a" g_type_check_class_is_a :: Ptr TypeClass -> -- g_class : TInterface "GObject" "TypeClass" CGType -> -- is_a_type : TBasicType TGType IO CInt typeCheckClassIsA :: (MonadIO m) => TypeClass -> -- g_class GType -> -- is_a_type m Bool typeCheckClassIsA g_class is_a_type = liftIO $ do let g_class' = unsafeManagedPtrGetPtr g_class let is_a_type' = gtypeToCGType is_a_type result <- g_type_check_class_is_a g_class' is_a_type' let result' = (/= 0) result touchManagedPtr g_class return result' -- function g_type_check_instance -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "TypeInstance", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "TypeInstance", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_type_check_instance" g_type_check_instance :: Ptr TypeInstance -> -- instance : TInterface "GObject" "TypeInstance" IO CInt typeCheckInstance :: (MonadIO m) => TypeInstance -> -- instance m Bool typeCheckInstance instance_ = liftIO $ do let instance_' = unsafeManagedPtrGetPtr instance_ result <- g_type_check_instance instance_' let result' = (/= 0) result touchManagedPtr instance_ return result' -- function g_type_check_instance_is_a -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "TypeInstance", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "TypeInstance", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_type_check_instance_is_a" g_type_check_instance_is_a :: Ptr TypeInstance -> -- instance : TInterface "GObject" "TypeInstance" CGType -> -- iface_type : TBasicType TGType IO CInt typeCheckInstanceIsA :: (MonadIO m) => TypeInstance -> -- instance GType -> -- iface_type m Bool typeCheckInstanceIsA instance_ iface_type = liftIO $ do let instance_' = unsafeManagedPtrGetPtr instance_ let iface_type' = gtypeToCGType iface_type result <- g_type_check_instance_is_a instance_' iface_type' let result' = (/= 0) result touchManagedPtr instance_ return result' -- function g_type_check_instance_is_fundamentally_a -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "TypeInstance", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fundamental_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "TypeInstance", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fundamental_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_type_check_instance_is_fundamentally_a" g_type_check_instance_is_fundamentally_a :: Ptr TypeInstance -> -- instance : TInterface "GObject" "TypeInstance" CGType -> -- fundamental_type : TBasicType TGType IO CInt typeCheckInstanceIsFundamentallyA :: (MonadIO m) => TypeInstance -> -- instance GType -> -- fundamental_type m Bool typeCheckInstanceIsFundamentallyA instance_ fundamental_type = liftIO $ do let instance_' = unsafeManagedPtrGetPtr instance_ let fundamental_type' = gtypeToCGType fundamental_type result <- g_type_check_instance_is_fundamentally_a instance_' fundamental_type' let result' = (/= 0) result touchManagedPtr instance_ return result' -- function g_type_check_is_value_type -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_type_check_is_value_type" g_type_check_is_value_type :: CGType -> -- type : TBasicType TGType IO CInt typeCheckIsValueType :: (MonadIO m) => GType -> -- type m Bool typeCheckIsValueType type_ = liftIO $ do let type_' = gtypeToCGType type_ result <- g_type_check_is_value_type type_' let result' = (/= 0) result return result' -- function g_type_check_value -- Args : [Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_type_check_value" g_type_check_value :: Ptr GValue -> -- value : TInterface "GObject" "Value" IO CInt typeCheckValue :: (MonadIO m) => GValue -> -- value m Bool typeCheckValue value = liftIO $ do let value' = unsafeManagedPtrGetPtr value result <- g_type_check_value value' let result' = (/= 0) result touchManagedPtr value return result' -- function g_type_check_value_holds -- Args : [Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "value", argType = TInterface "GObject" "Value", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_type_check_value_holds" g_type_check_value_holds :: Ptr GValue -> -- value : TInterface "GObject" "Value" CGType -> -- type : TBasicType TGType IO CInt typeCheckValueHolds :: (MonadIO m) => GValue -> -- value GType -> -- type m Bool typeCheckValueHolds value type_ = liftIO $ do let value' = unsafeManagedPtrGetPtr value let type_' = gtypeToCGType type_ result <- g_type_check_value_holds value' type_' let result' = (/= 0) result touchManagedPtr value return result' -- function g_type_children -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_children", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_children", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 1 (TBasicType TGType) -- throws : False -- Skip return : False foreign import ccall "g_type_children" g_type_children :: CGType -> -- type : TBasicType TGType Ptr Word32 -> -- n_children : TBasicType TUInt32 IO (Ptr CGType) typeChildren :: (MonadIO m) => GType -> -- type m [GType] typeChildren type_ = liftIO $ do let type_' = gtypeToCGType type_ n_children <- allocMem :: IO (Ptr Word32) result <- g_type_children type_' n_children n_children' <- peek n_children checkUnexpectedReturnNULL "g_type_children" result result' <- (unpackMapStorableArrayWithLength GType n_children') result freeMem result freeMem n_children return result' -- function g_type_class_add_private -- Args : [Arg {argName = "g_class", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "private_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "g_class", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "private_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_class_add_private" g_type_class_add_private :: Ptr () -> -- g_class : TBasicType TVoid Word64 -> -- private_size : TBasicType TUInt64 IO () typeClassAddPrivate :: (MonadIO m) => Ptr () -> -- g_class Word64 -> -- private_size m () typeClassAddPrivate g_class private_size = liftIO $ do g_type_class_add_private g_class private_size return () -- function g_type_class_adjust_private_offset -- Args : [Arg {argName = "g_class", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "private_size_or_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "g_class", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "private_size_or_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_class_adjust_private_offset" g_type_class_adjust_private_offset :: Ptr () -> -- g_class : TBasicType TVoid Int32 -> -- private_size_or_offset : TBasicType TInt32 IO () typeClassAdjustPrivateOffset :: (MonadIO m) => Ptr () -> -- g_class Int32 -> -- private_size_or_offset m () typeClassAdjustPrivateOffset g_class private_size_or_offset = liftIO $ do g_type_class_adjust_private_offset g_class private_size_or_offset return () -- function g_type_class_peek -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "TypeClass" -- throws : False -- Skip return : False foreign import ccall "g_type_class_peek" g_type_class_peek :: CGType -> -- type : TBasicType TGType IO (Ptr TypeClass) typeClassPeek :: (MonadIO m) => GType -> -- type m TypeClass typeClassPeek type_ = liftIO $ do let type_' = gtypeToCGType type_ result <- g_type_class_peek type_' checkUnexpectedReturnNULL "g_type_class_peek" result result' <- (newPtr 8 TypeClass) result return result' -- function g_type_class_peek_static -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "TypeClass" -- throws : False -- Skip return : False foreign import ccall "g_type_class_peek_static" g_type_class_peek_static :: CGType -> -- type : TBasicType TGType IO (Ptr TypeClass) typeClassPeekStatic :: (MonadIO m) => GType -> -- type m TypeClass typeClassPeekStatic type_ = liftIO $ do let type_' = gtypeToCGType type_ result <- g_type_class_peek_static type_' checkUnexpectedReturnNULL "g_type_class_peek_static" result result' <- (newPtr 8 TypeClass) result return result' -- function g_type_class_ref -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "TypeClass" -- throws : False -- Skip return : False foreign import ccall "g_type_class_ref" g_type_class_ref :: CGType -> -- type : TBasicType TGType IO (Ptr TypeClass) typeClassRef :: (MonadIO m) => GType -> -- type m TypeClass typeClassRef type_ = liftIO $ do let type_' = gtypeToCGType type_ result <- g_type_class_ref type_' checkUnexpectedReturnNULL "g_type_class_ref" result result' <- (newPtr 8 TypeClass) result return result' -- function g_type_default_interface_peek -- Args : [Arg {argName = "g_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "g_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "TypeInterface" -- throws : False -- Skip return : False foreign import ccall "g_type_default_interface_peek" g_type_default_interface_peek :: CGType -> -- g_type : TBasicType TGType IO (Ptr TypeInterface) typeDefaultInterfacePeek :: (MonadIO m) => GType -> -- g_type m TypeInterface typeDefaultInterfacePeek g_type = liftIO $ do let g_type' = gtypeToCGType g_type result <- g_type_default_interface_peek g_type' checkUnexpectedReturnNULL "g_type_default_interface_peek" result result' <- (newPtr 16 TypeInterface) result return result' -- function g_type_default_interface_ref -- Args : [Arg {argName = "g_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "g_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "TypeInterface" -- throws : False -- Skip return : False foreign import ccall "g_type_default_interface_ref" g_type_default_interface_ref :: CGType -> -- g_type : TBasicType TGType IO (Ptr TypeInterface) typeDefaultInterfaceRef :: (MonadIO m) => GType -> -- g_type m TypeInterface typeDefaultInterfaceRef g_type = liftIO $ do let g_type' = gtypeToCGType g_type result <- g_type_default_interface_ref g_type' checkUnexpectedReturnNULL "g_type_default_interface_ref" result result' <- (newPtr 16 TypeInterface) result return result' -- function g_type_default_interface_unref -- Args : [Arg {argName = "g_iface", argType = TInterface "GObject" "TypeInterface", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "g_iface", argType = TInterface "GObject" "TypeInterface", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_default_interface_unref" g_type_default_interface_unref :: Ptr TypeInterface -> -- g_iface : TInterface "GObject" "TypeInterface" IO () typeDefaultInterfaceUnref :: (MonadIO m) => TypeInterface -> -- g_iface m () typeDefaultInterfaceUnref g_iface = liftIO $ do let g_iface' = unsafeManagedPtrGetPtr g_iface g_type_default_interface_unref g_iface' touchManagedPtr g_iface return () -- function g_type_depth -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_type_depth" g_type_depth :: CGType -> -- type : TBasicType TGType IO Word32 typeDepth :: (MonadIO m) => GType -> -- type m Word32 typeDepth type_ = liftIO $ do let type_' = gtypeToCGType type_ result <- g_type_depth type_' return result -- function g_type_ensure -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_ensure" g_type_ensure :: CGType -> -- type : TBasicType TGType IO () typeEnsure :: (MonadIO m) => GType -> -- type m () typeEnsure type_ = liftIO $ do let type_' = gtypeToCGType type_ g_type_ensure type_' return () -- function g_type_free_instance -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "TypeInstance", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "TypeInstance", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_free_instance" g_type_free_instance :: Ptr TypeInstance -> -- instance : TInterface "GObject" "TypeInstance" IO () typeFreeInstance :: (MonadIO m) => TypeInstance -> -- instance m () typeFreeInstance instance_ = liftIO $ do let instance_' = unsafeManagedPtrGetPtr instance_ g_type_free_instance instance_' touchManagedPtr instance_ return () -- function g_type_from_name -- Args : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_type_from_name" g_type_from_name :: CString -> -- name : TBasicType TUTF8 IO CGType typeFromName :: (MonadIO m) => T.Text -> -- name m GType typeFromName name = liftIO $ do name' <- textToCString name result <- g_type_from_name name' let result' = GType result freeMem name' return result' -- function g_type_fundamental -- Args : [Arg {argName = "type_id", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type_id", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_type_fundamental" g_type_fundamental :: CGType -> -- type_id : TBasicType TGType IO CGType typeFundamental :: (MonadIO m) => GType -> -- type_id m GType typeFundamental type_id = liftIO $ do let type_id' = gtypeToCGType type_id result <- g_type_fundamental type_id' let result' = GType result return result' -- function g_type_fundamental_next -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_type_fundamental_next" g_type_fundamental_next :: IO CGType typeFundamentalNext :: (MonadIO m) => m GType typeFundamentalNext = liftIO $ do result <- g_type_fundamental_next let result' = GType result return result' -- function g_type_get_instance_count -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TInt32 -- throws : False -- Skip return : False foreign import ccall "g_type_get_instance_count" g_type_get_instance_count :: CGType -> -- type : TBasicType TGType IO Int32 typeGetInstanceCount :: (MonadIO m) => GType -> -- type m Int32 typeGetInstanceCount type_ = liftIO $ do let type_' = gtypeToCGType type_ result <- g_type_get_instance_count type_' return result -- function g_type_get_plugin -- XXX Could not generate function g_type_get_plugin -- Error was : Bad introspection data: "Wrapping not a GObject with no copy..." -- function g_type_get_qdata -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_get_qdata" g_type_get_qdata :: CGType -> -- type : TBasicType TGType Word32 -> -- quark : TBasicType TUInt32 IO () typeGetQdata :: (MonadIO m) => GType -> -- type Word32 -> -- quark m () typeGetQdata type_ quark = liftIO $ do let type_' = gtypeToCGType type_ g_type_get_qdata type_' quark return () -- function g_type_get_type_registration_serial -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_type_get_type_registration_serial" g_type_get_type_registration_serial :: IO Word32 typeGetTypeRegistrationSerial :: (MonadIO m) => m Word32 typeGetTypeRegistrationSerial = liftIO $ do result <- g_type_get_type_registration_serial return result -- function g_type_init -- Args : [] -- Lengths : [] -- hInArgs : [] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_init" g_type_init :: IO () {-# DEPRECATED typeInit ["(Since version 2.36)","the type system is now initialised automatically"]#-} typeInit :: (MonadIO m) => m () typeInit = liftIO $ do g_type_init return () -- function g_type_init_with_debug_flags -- Args : [Arg {argName = "debug_flags", argType = TInterface "GObject" "TypeDebugFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "debug_flags", argType = TInterface "GObject" "TypeDebugFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_init_with_debug_flags" g_type_init_with_debug_flags :: CUInt -> -- debug_flags : TInterface "GObject" "TypeDebugFlags" IO () {-# DEPRECATED typeInitWithDebugFlags ["(Since version 2.36)","the type system is now initialised automatically"]#-} typeInitWithDebugFlags :: (MonadIO m) => [TypeDebugFlags] -> -- debug_flags m () typeInitWithDebugFlags debug_flags = liftIO $ do let debug_flags' = gflagsToWord debug_flags g_type_init_with_debug_flags debug_flags' return () -- function g_type_interface_add_prerequisite -- Args : [Arg {argName = "interface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "prerequisite_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "interface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "prerequisite_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_interface_add_prerequisite" g_type_interface_add_prerequisite :: CGType -> -- interface_type : TBasicType TGType CGType -> -- prerequisite_type : TBasicType TGType IO () typeInterfaceAddPrerequisite :: (MonadIO m) => GType -> -- interface_type GType -> -- prerequisite_type m () typeInterfaceAddPrerequisite interface_type prerequisite_type = liftIO $ do let interface_type' = gtypeToCGType interface_type let prerequisite_type' = gtypeToCGType prerequisite_type g_type_interface_add_prerequisite interface_type' prerequisite_type' return () -- function g_type_interface_get_plugin -- XXX Could not generate function g_type_interface_get_plugin -- Error was : Bad introspection data: "Wrapping not a GObject with no copy..." -- function g_type_interface_peek -- Args : [Arg {argName = "instance_class", argType = TInterface "GObject" "TypeClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance_class", argType = TInterface "GObject" "TypeClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "iface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TInterface "GObject" "TypeInterface" -- throws : False -- Skip return : False foreign import ccall "g_type_interface_peek" g_type_interface_peek :: Ptr TypeClass -> -- instance_class : TInterface "GObject" "TypeClass" CGType -> -- iface_type : TBasicType TGType IO (Ptr TypeInterface) typeInterfacePeek :: (MonadIO m) => TypeClass -> -- instance_class GType -> -- iface_type m TypeInterface typeInterfacePeek instance_class iface_type = liftIO $ do let instance_class' = unsafeManagedPtrGetPtr instance_class let iface_type' = gtypeToCGType iface_type result <- g_type_interface_peek instance_class' iface_type' checkUnexpectedReturnNULL "g_type_interface_peek" result result' <- (newPtr 16 TypeInterface) result touchManagedPtr instance_class return result' -- function g_type_interface_prerequisites -- Args : [Arg {argName = "interface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_prerequisites", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_prerequisites", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "interface_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 1 (TBasicType TGType) -- throws : False -- Skip return : False foreign import ccall "g_type_interface_prerequisites" g_type_interface_prerequisites :: CGType -> -- interface_type : TBasicType TGType Ptr Word32 -> -- n_prerequisites : TBasicType TUInt32 IO (Ptr CGType) typeInterfacePrerequisites :: (MonadIO m) => GType -> -- interface_type m [GType] typeInterfacePrerequisites interface_type = liftIO $ do let interface_type' = gtypeToCGType interface_type n_prerequisites <- allocMem :: IO (Ptr Word32) result <- g_type_interface_prerequisites interface_type' n_prerequisites n_prerequisites' <- peek n_prerequisites checkUnexpectedReturnNULL "g_type_interface_prerequisites" result result' <- (unpackMapStorableArrayWithLength GType n_prerequisites') result freeMem result freeMem n_prerequisites return result' -- function g_type_interfaces -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_interfaces", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- Lengths : [Arg {argName = "n_interfaces", argType = TBasicType TUInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TCArray False (-1) 1 (TBasicType TGType) -- throws : False -- Skip return : False foreign import ccall "g_type_interfaces" g_type_interfaces :: CGType -> -- type : TBasicType TGType Ptr Word32 -> -- n_interfaces : TBasicType TUInt32 IO (Ptr CGType) typeInterfaces :: (MonadIO m) => GType -> -- type m [GType] typeInterfaces type_ = liftIO $ do let type_' = gtypeToCGType type_ n_interfaces <- allocMem :: IO (Ptr Word32) result <- g_type_interfaces type_' n_interfaces n_interfaces' <- peek n_interfaces checkUnexpectedReturnNULL "g_type_interfaces" result result' <- (unpackMapStorableArrayWithLength GType n_interfaces') result freeMem result freeMem n_interfaces return result' -- function g_type_is_a -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_a_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_a_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_type_is_a" g_type_is_a :: CGType -> -- type : TBasicType TGType CGType -> -- is_a_type : TBasicType TGType IO CInt typeIsA :: (MonadIO m) => GType -> -- type GType -> -- is_a_type m Bool typeIsA type_ is_a_type = liftIO $ do let type_' = gtypeToCGType type_ let is_a_type' = gtypeToCGType is_a_type result <- g_type_is_a type_' is_a_type' let result' = (/= 0) result return result' -- function g_type_name -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_type_name" g_type_name :: CGType -> -- type : TBasicType TGType IO CString typeName :: (MonadIO m) => GType -> -- type m T.Text typeName type_ = liftIO $ do let type_' = gtypeToCGType type_ result <- g_type_name type_' checkUnexpectedReturnNULL "g_type_name" result result' <- cstringToText result return result' -- function g_type_name_from_class -- Args : [Arg {argName = "g_class", argType = TInterface "GObject" "TypeClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "g_class", argType = TInterface "GObject" "TypeClass", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_type_name_from_class" g_type_name_from_class :: Ptr TypeClass -> -- g_class : TInterface "GObject" "TypeClass" IO CString typeNameFromClass :: (MonadIO m) => TypeClass -> -- g_class m T.Text typeNameFromClass g_class = liftIO $ do let g_class' = unsafeManagedPtrGetPtr g_class result <- g_type_name_from_class g_class' checkUnexpectedReturnNULL "g_type_name_from_class" result result' <- cstringToText result touchManagedPtr g_class return result' -- function g_type_name_from_instance -- Args : [Arg {argName = "instance", argType = TInterface "GObject" "TypeInstance", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "instance", argType = TInterface "GObject" "TypeInstance", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUTF8 -- throws : False -- Skip return : False foreign import ccall "g_type_name_from_instance" g_type_name_from_instance :: Ptr TypeInstance -> -- instance : TInterface "GObject" "TypeInstance" IO CString typeNameFromInstance :: (MonadIO m) => TypeInstance -> -- instance m T.Text typeNameFromInstance instance_ = liftIO $ do let instance_' = unsafeManagedPtrGetPtr instance_ result <- g_type_name_from_instance instance_' checkUnexpectedReturnNULL "g_type_name_from_instance" result result' <- cstringToText result touchManagedPtr instance_ return result' -- function g_type_next_base -- Args : [Arg {argName = "leaf_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "leaf_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "root_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_type_next_base" g_type_next_base :: CGType -> -- leaf_type : TBasicType TGType CGType -> -- root_type : TBasicType TGType IO CGType typeNextBase :: (MonadIO m) => GType -> -- leaf_type GType -> -- root_type m GType typeNextBase leaf_type root_type = liftIO $ do let leaf_type' = gtypeToCGType leaf_type let root_type' = gtypeToCGType root_type result <- g_type_next_base leaf_type' root_type' let result' = GType result return result' -- function g_type_parent -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_type_parent" g_type_parent :: CGType -> -- type : TBasicType TGType IO CGType typeParent :: (MonadIO m) => GType -> -- type m GType typeParent type_ = liftIO $ do let type_' = gtypeToCGType type_ result <- g_type_parent type_' let result' = GType result return result' -- function g_type_qname -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TUInt32 -- throws : False -- Skip return : False foreign import ccall "g_type_qname" g_type_qname :: CGType -> -- type : TBasicType TGType IO Word32 typeQname :: (MonadIO m) => GType -> -- type m Word32 typeQname type_ = liftIO $ do let type_' = gtypeToCGType type_ result <- g_type_qname type_' return result -- function g_type_query -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "query", argType = TInterface "GObject" "TypeQuery", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_query" g_type_query :: CGType -> -- type : TBasicType TGType Ptr TypeQuery -> -- query : TInterface "GObject" "TypeQuery" IO () typeQuery :: (MonadIO m) => GType -> -- type m (TypeQuery) typeQuery type_ = liftIO $ do let type_' = gtypeToCGType type_ query <- callocBytes 24 :: IO (Ptr TypeQuery) g_type_query type_' query query' <- (wrapPtr TypeQuery) query return query' -- function g_type_register_dynamic -- Args : [Arg {argName = "parent_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "plugin", argType = TInterface "GObject" "TypePlugin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "TypeFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "parent_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "plugin", argType = TInterface "GObject" "TypePlugin", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "TypeFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_type_register_dynamic" g_type_register_dynamic :: CGType -> -- parent_type : TBasicType TGType CString -> -- type_name : TBasicType TUTF8 Ptr TypePlugin -> -- plugin : TInterface "GObject" "TypePlugin" CUInt -> -- flags : TInterface "GObject" "TypeFlags" IO CGType typeRegisterDynamic :: (MonadIO m, TypePluginK a) => GType -> -- parent_type T.Text -> -- type_name a -> -- plugin [TypeFlags] -> -- flags m GType typeRegisterDynamic parent_type type_name plugin flags = liftIO $ do let parent_type' = gtypeToCGType parent_type type_name' <- textToCString type_name let plugin' = unsafeManagedPtrCastPtr plugin let flags' = gflagsToWord flags result <- g_type_register_dynamic parent_type' type_name' plugin' flags' let result' = GType result touchManagedPtr plugin freeMem type_name' return result' -- function g_type_register_fundamental -- Args : [Arg {argName = "type_id", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "GObject" "TypeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "finfo", argType = TInterface "GObject" "TypeFundamentalInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "TypeFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type_id", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "GObject" "TypeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "finfo", argType = TInterface "GObject" "TypeFundamentalInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "TypeFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_type_register_fundamental" g_type_register_fundamental :: CGType -> -- type_id : TBasicType TGType CString -> -- type_name : TBasicType TUTF8 Ptr TypeInfo -> -- info : TInterface "GObject" "TypeInfo" Ptr TypeFundamentalInfo -> -- finfo : TInterface "GObject" "TypeFundamentalInfo" CUInt -> -- flags : TInterface "GObject" "TypeFlags" IO CGType typeRegisterFundamental :: (MonadIO m) => GType -> -- type_id T.Text -> -- type_name TypeInfo -> -- info TypeFundamentalInfo -> -- finfo [TypeFlags] -> -- flags m GType typeRegisterFundamental type_id type_name info finfo flags = liftIO $ do let type_id' = gtypeToCGType type_id type_name' <- textToCString type_name let info' = unsafeManagedPtrGetPtr info let finfo' = unsafeManagedPtrGetPtr finfo let flags' = gflagsToWord flags result <- g_type_register_fundamental type_id' type_name' info' finfo' flags' let result' = GType result touchManagedPtr info touchManagedPtr finfo freeMem type_name' return result' -- function g_type_register_static -- Args : [Arg {argName = "parent_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "GObject" "TypeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "TypeFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "parent_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "type_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "info", argType = TInterface "GObject" "TypeInfo", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GObject" "TypeFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TGType -- throws : False -- Skip return : False foreign import ccall "g_type_register_static" g_type_register_static :: CGType -> -- parent_type : TBasicType TGType CString -> -- type_name : TBasicType TUTF8 Ptr TypeInfo -> -- info : TInterface "GObject" "TypeInfo" CUInt -> -- flags : TInterface "GObject" "TypeFlags" IO CGType typeRegisterStatic :: (MonadIO m) => GType -> -- parent_type T.Text -> -- type_name TypeInfo -> -- info [TypeFlags] -> -- flags m GType typeRegisterStatic parent_type type_name info flags = liftIO $ do let parent_type' = gtypeToCGType parent_type type_name' <- textToCString type_name let info' = unsafeManagedPtrGetPtr info let flags' = gflagsToWord flags result <- g_type_register_static parent_type' type_name' info' flags' let result' = GType result touchManagedPtr info freeMem type_name' return result' -- function g_type_set_qdata -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "quark", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TVoid -- throws : False -- Skip return : False foreign import ccall "g_type_set_qdata" g_type_set_qdata :: CGType -> -- type : TBasicType TGType Word32 -> -- quark : TBasicType TUInt32 Ptr () -> -- data : TBasicType TVoid IO () typeSetQdata :: (MonadIO m) => GType -> -- type Word32 -> -- quark Ptr () -> -- data m () typeSetQdata type_ quark data_ = liftIO $ do let type_' = gtypeToCGType type_ g_type_set_qdata type_' quark data_ return () -- function g_type_test_flags -- Args : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_type_test_flags" g_type_test_flags :: CGType -> -- type : TBasicType TGType Word32 -> -- flags : TBasicType TUInt32 IO CInt typeTestFlags :: (MonadIO m) => GType -> -- type Word32 -> -- flags m Bool typeTestFlags type_ flags = liftIO $ do let type_' = gtypeToCGType type_ result <- g_type_test_flags type_' flags let result' = (/= 0) result return result' -- function g_value_type_compatible -- Args : [Arg {argName = "src_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "src_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_value_type_compatible" g_value_type_compatible :: CGType -> -- src_type : TBasicType TGType CGType -> -- dest_type : TBasicType TGType IO CInt valueTypeCompatible :: (MonadIO m) => GType -> -- src_type GType -> -- dest_type m Bool valueTypeCompatible src_type dest_type = liftIO $ do let src_type' = gtypeToCGType src_type let dest_type' = gtypeToCGType dest_type result <- g_value_type_compatible src_type' dest_type' let result' = (/= 0) result return result' -- function g_value_type_transformable -- Args : [Arg {argName = "src_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- Lengths : [] -- hInArgs : [Arg {argName = "src_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "dest_type", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}] -- returnType : TBasicType TBoolean -- throws : False -- Skip return : False foreign import ccall "g_value_type_transformable" g_value_type_transformable :: CGType -> -- src_type : TBasicType TGType CGType -> -- dest_type : TBasicType TGType IO CInt valueTypeTransformable :: (MonadIO m) => GType -> -- src_type GType -> -- dest_type m Bool valueTypeTransformable src_type dest_type = liftIO $ do let src_type' = gtypeToCGType src_type let dest_type' = gtypeToCGType dest_type result <- g_value_type_transformable src_type' dest_type' let result' = (/= 0) result return result' -- callback ClosureMarshalFieldCallback closureMarshalFieldCallbackClosure :: ClosureMarshalFieldCallback -> IO Closure closureMarshalFieldCallbackClosure cb = newCClosure =<< mkClosureMarshalFieldCallback wrapped where wrapped = closureMarshalFieldCallbackWrapper Nothing cb type ClosureMarshalFieldCallbackC = Ptr Closure -> Ptr GValue -> Word32 -> Ptr GValue -> Ptr () -> Ptr () -> IO () foreign import ccall "wrapper" mkClosureMarshalFieldCallback :: ClosureMarshalFieldCallbackC -> IO (FunPtr ClosureMarshalFieldCallbackC) type ClosureMarshalFieldCallback = Closure -> GValue -> Word32 -> GValue -> Ptr () -> Ptr () -> IO () noClosureMarshalFieldCallback :: Maybe ClosureMarshalFieldCallback noClosureMarshalFieldCallback = Nothing closureMarshalFieldCallbackWrapper :: Maybe (Ptr (FunPtr (ClosureMarshalFieldCallbackC))) -> ClosureMarshalFieldCallback -> Ptr Closure -> Ptr GValue -> Word32 -> Ptr GValue -> Ptr () -> Ptr () -> IO () closureMarshalFieldCallbackWrapper funptrptr _cb closure return_value n_param_values param_values invocation_hint marshal_data = do closure' <- (newBoxed Closure) closure return_value' <- (newBoxed GValue) return_value param_values' <- (newBoxed GValue) param_values _cb closure' return_value' n_param_values param_values' invocation_hint marshal_data maybeReleaseFunPtr funptrptr -- callback ParamSpecTypeInfoInstanceInitFieldCallback paramSpecTypeInfoInstanceInitFieldCallbackClosure :: ParamSpecTypeInfoInstanceInitFieldCallback -> IO Closure paramSpecTypeInfoInstanceInitFieldCallbackClosure cb = newCClosure =<< mkParamSpecTypeInfoInstanceInitFieldCallback wrapped where wrapped = paramSpecTypeInfoInstanceInitFieldCallbackWrapper Nothing cb type ParamSpecTypeInfoInstanceInitFieldCallbackC = Ptr GParamSpec -> IO () foreign import ccall "wrapper" mkParamSpecTypeInfoInstanceInitFieldCallback :: ParamSpecTypeInfoInstanceInitFieldCallbackC -> IO (FunPtr ParamSpecTypeInfoInstanceInitFieldCallbackC) type ParamSpecTypeInfoInstanceInitFieldCallback = GParamSpec -> IO () noParamSpecTypeInfoInstanceInitFieldCallback :: Maybe ParamSpecTypeInfoInstanceInitFieldCallback noParamSpecTypeInfoInstanceInitFieldCallback = Nothing paramSpecTypeInfoInstanceInitFieldCallbackWrapper :: Maybe (Ptr (FunPtr (ParamSpecTypeInfoInstanceInitFieldCallbackC))) -> ParamSpecTypeInfoInstanceInitFieldCallback -> Ptr GParamSpec -> IO () paramSpecTypeInfoInstanceInitFieldCallbackWrapper funptrptr _cb pspec = do pspec' <- newGParamSpecFromPtr pspec _cb pspec' maybeReleaseFunPtr funptrptr -- callback ParamSpecTypeInfoFinalizeFieldCallback paramSpecTypeInfoFinalizeFieldCallbackClosure :: ParamSpecTypeInfoFinalizeFieldCallback -> IO Closure paramSpecTypeInfoFinalizeFieldCallbackClosure cb = newCClosure =<< mkParamSpecTypeInfoFinalizeFieldCallback wrapped where wrapped = paramSpecTypeInfoFinalizeFieldCallbackWrapper Nothing cb type ParamSpecTypeInfoFinalizeFieldCallbackC = Ptr GParamSpec -> IO () foreign import ccall "wrapper" mkParamSpecTypeInfoFinalizeFieldCallback :: ParamSpecTypeInfoFinalizeFieldCallbackC -> IO (FunPtr ParamSpecTypeInfoFinalizeFieldCallbackC) type ParamSpecTypeInfoFinalizeFieldCallback = GParamSpec -> IO () noParamSpecTypeInfoFinalizeFieldCallback :: Maybe ParamSpecTypeInfoFinalizeFieldCallback noParamSpecTypeInfoFinalizeFieldCallback = Nothing paramSpecTypeInfoFinalizeFieldCallbackWrapper :: Maybe (Ptr (FunPtr (ParamSpecTypeInfoFinalizeFieldCallbackC))) -> ParamSpecTypeInfoFinalizeFieldCallback -> Ptr GParamSpec -> IO () paramSpecTypeInfoFinalizeFieldCallbackWrapper funptrptr _cb pspec = do pspec' <- newGParamSpecFromPtr pspec _cb pspec' maybeReleaseFunPtr funptrptr -- callback ParamSpecTypeInfoValueSetDefaultFieldCallback paramSpecTypeInfoValueSetDefaultFieldCallbackClosure :: ParamSpecTypeInfoValueSetDefaultFieldCallback -> IO Closure paramSpecTypeInfoValueSetDefaultFieldCallbackClosure cb = newCClosure =<< mkParamSpecTypeInfoValueSetDefaultFieldCallback wrapped where wrapped = paramSpecTypeInfoValueSetDefaultFieldCallbackWrapper Nothing cb type ParamSpecTypeInfoValueSetDefaultFieldCallbackC = Ptr GParamSpec -> Ptr GValue -> IO () foreign import ccall "wrapper" mkParamSpecTypeInfoValueSetDefaultFieldCallback :: ParamSpecTypeInfoValueSetDefaultFieldCallbackC -> IO (FunPtr ParamSpecTypeInfoValueSetDefaultFieldCallbackC) type ParamSpecTypeInfoValueSetDefaultFieldCallback = GParamSpec -> GValue -> IO () noParamSpecTypeInfoValueSetDefaultFieldCallback :: Maybe ParamSpecTypeInfoValueSetDefaultFieldCallback noParamSpecTypeInfoValueSetDefaultFieldCallback = Nothing paramSpecTypeInfoValueSetDefaultFieldCallbackWrapper :: Maybe (Ptr (FunPtr (ParamSpecTypeInfoValueSetDefaultFieldCallbackC))) -> ParamSpecTypeInfoValueSetDefaultFieldCallback -> Ptr GParamSpec -> Ptr GValue -> IO () paramSpecTypeInfoValueSetDefaultFieldCallbackWrapper funptrptr _cb pspec value = do pspec' <- newGParamSpecFromPtr pspec value' <- (newBoxed GValue) value _cb pspec' value' maybeReleaseFunPtr funptrptr -- callback ParamSpecTypeInfoValueValidateFieldCallback paramSpecTypeInfoValueValidateFieldCallbackClosure :: ParamSpecTypeInfoValueValidateFieldCallback -> IO Closure paramSpecTypeInfoValueValidateFieldCallbackClosure cb = newCClosure =<< mkParamSpecTypeInfoValueValidateFieldCallback wrapped where wrapped = paramSpecTypeInfoValueValidateFieldCallbackWrapper Nothing cb type ParamSpecTypeInfoValueValidateFieldCallbackC = Ptr GParamSpec -> Ptr GValue -> IO CInt foreign import ccall "wrapper" mkParamSpecTypeInfoValueValidateFieldCallback :: ParamSpecTypeInfoValueValidateFieldCallbackC -> IO (FunPtr ParamSpecTypeInfoValueValidateFieldCallbackC) type ParamSpecTypeInfoValueValidateFieldCallback = GParamSpec -> GValue -> IO Bool noParamSpecTypeInfoValueValidateFieldCallback :: Maybe ParamSpecTypeInfoValueValidateFieldCallback noParamSpecTypeInfoValueValidateFieldCallback = Nothing paramSpecTypeInfoValueValidateFieldCallbackWrapper :: Maybe (Ptr (FunPtr (ParamSpecTypeInfoValueValidateFieldCallbackC))) -> ParamSpecTypeInfoValueValidateFieldCallback -> Ptr GParamSpec -> Ptr GValue -> IO CInt paramSpecTypeInfoValueValidateFieldCallbackWrapper funptrptr _cb pspec value = do pspec' <- newGParamSpecFromPtr pspec value' <- (newBoxed GValue) value result <- _cb pspec' value' maybeReleaseFunPtr funptrptr let result' = (fromIntegral . fromEnum) result return result' -- callback ParamSpecTypeInfoValuesCmpFieldCallback paramSpecTypeInfoValuesCmpFieldCallbackClosure :: ParamSpecTypeInfoValuesCmpFieldCallback -> IO Closure paramSpecTypeInfoValuesCmpFieldCallbackClosure cb = newCClosure =<< mkParamSpecTypeInfoValuesCmpFieldCallback wrapped where wrapped = paramSpecTypeInfoValuesCmpFieldCallbackWrapper Nothing cb type ParamSpecTypeInfoValuesCmpFieldCallbackC = Ptr GParamSpec -> Ptr GValue -> Ptr GValue -> IO Int32 foreign import ccall "wrapper" mkParamSpecTypeInfoValuesCmpFieldCallback :: ParamSpecTypeInfoValuesCmpFieldCallbackC -> IO (FunPtr ParamSpecTypeInfoValuesCmpFieldCallbackC) type ParamSpecTypeInfoValuesCmpFieldCallback = GParamSpec -> GValue -> GValue -> IO Int32 noParamSpecTypeInfoValuesCmpFieldCallback :: Maybe ParamSpecTypeInfoValuesCmpFieldCallback noParamSpecTypeInfoValuesCmpFieldCallback = Nothing paramSpecTypeInfoValuesCmpFieldCallbackWrapper :: Maybe (Ptr (FunPtr (ParamSpecTypeInfoValuesCmpFieldCallbackC))) -> ParamSpecTypeInfoValuesCmpFieldCallback -> Ptr GParamSpec -> Ptr GValue -> Ptr GValue -> IO Int32 paramSpecTypeInfoValuesCmpFieldCallbackWrapper funptrptr _cb pspec value1 value2 = do pspec' <- newGParamSpecFromPtr pspec value1' <- (newBoxed GValue) value1 value2' <- (newBoxed GValue) value2 result <- _cb pspec' value1' value2' maybeReleaseFunPtr funptrptr return result -- callback TypeValueTableValueInitFieldCallback typeValueTableValueInitFieldCallbackClosure :: TypeValueTableValueInitFieldCallback -> IO Closure typeValueTableValueInitFieldCallbackClosure cb = newCClosure =<< mkTypeValueTableValueInitFieldCallback wrapped where wrapped = typeValueTableValueInitFieldCallbackWrapper Nothing cb type TypeValueTableValueInitFieldCallbackC = Ptr GValue -> IO () foreign import ccall "wrapper" mkTypeValueTableValueInitFieldCallback :: TypeValueTableValueInitFieldCallbackC -> IO (FunPtr TypeValueTableValueInitFieldCallbackC) type TypeValueTableValueInitFieldCallback = GValue -> IO () noTypeValueTableValueInitFieldCallback :: Maybe TypeValueTableValueInitFieldCallback noTypeValueTableValueInitFieldCallback = Nothing typeValueTableValueInitFieldCallbackWrapper :: Maybe (Ptr (FunPtr (TypeValueTableValueInitFieldCallbackC))) -> TypeValueTableValueInitFieldCallback -> Ptr GValue -> IO () typeValueTableValueInitFieldCallbackWrapper funptrptr _cb value = do value' <- (newBoxed GValue) value _cb value' maybeReleaseFunPtr funptrptr -- callback TypeValueTableValueFreeFieldCallback typeValueTableValueFreeFieldCallbackClosure :: TypeValueTableValueFreeFieldCallback -> IO Closure typeValueTableValueFreeFieldCallbackClosure cb = newCClosure =<< mkTypeValueTableValueFreeFieldCallback wrapped where wrapped = typeValueTableValueFreeFieldCallbackWrapper Nothing cb type TypeValueTableValueFreeFieldCallbackC = Ptr GValue -> IO () foreign import ccall "wrapper" mkTypeValueTableValueFreeFieldCallback :: TypeValueTableValueFreeFieldCallbackC -> IO (FunPtr TypeValueTableValueFreeFieldCallbackC) type TypeValueTableValueFreeFieldCallback = GValue -> IO () noTypeValueTableValueFreeFieldCallback :: Maybe TypeValueTableValueFreeFieldCallback noTypeValueTableValueFreeFieldCallback = Nothing typeValueTableValueFreeFieldCallbackWrapper :: Maybe (Ptr (FunPtr (TypeValueTableValueFreeFieldCallbackC))) -> TypeValueTableValueFreeFieldCallback -> Ptr GValue -> IO () typeValueTableValueFreeFieldCallbackWrapper funptrptr _cb value = do value' <- (newBoxed GValue) value _cb value' maybeReleaseFunPtr funptrptr -- callback TypeValueTableValueCopyFieldCallback typeValueTableValueCopyFieldCallbackClosure :: TypeValueTableValueCopyFieldCallback -> IO Closure typeValueTableValueCopyFieldCallbackClosure cb = newCClosure =<< mkTypeValueTableValueCopyFieldCallback wrapped where wrapped = typeValueTableValueCopyFieldCallbackWrapper Nothing cb type TypeValueTableValueCopyFieldCallbackC = Ptr GValue -> Ptr GValue -> IO () foreign import ccall "wrapper" mkTypeValueTableValueCopyFieldCallback :: TypeValueTableValueCopyFieldCallbackC -> IO (FunPtr TypeValueTableValueCopyFieldCallbackC) type TypeValueTableValueCopyFieldCallback = GValue -> GValue -> IO () noTypeValueTableValueCopyFieldCallback :: Maybe TypeValueTableValueCopyFieldCallback noTypeValueTableValueCopyFieldCallback = Nothing typeValueTableValueCopyFieldCallbackWrapper :: Maybe (Ptr (FunPtr (TypeValueTableValueCopyFieldCallbackC))) -> TypeValueTableValueCopyFieldCallback -> Ptr GValue -> Ptr GValue -> IO () typeValueTableValueCopyFieldCallbackWrapper funptrptr _cb src_value dest_value = do src_value' <- (newBoxed GValue) src_value dest_value' <- (newBoxed GValue) dest_value _cb src_value' dest_value' maybeReleaseFunPtr funptrptr -- callback TypeValueTableCollectValueFieldCallback typeValueTableCollectValueFieldCallbackClosure :: TypeValueTableCollectValueFieldCallback -> IO Closure typeValueTableCollectValueFieldCallbackClosure cb = newCClosure =<< mkTypeValueTableCollectValueFieldCallback wrapped where wrapped = typeValueTableCollectValueFieldCallbackWrapper Nothing cb type TypeValueTableCollectValueFieldCallbackC = Ptr GValue -> Word32 -> Ptr TypeCValue -> Word32 -> IO CString foreign import ccall "wrapper" mkTypeValueTableCollectValueFieldCallback :: TypeValueTableCollectValueFieldCallbackC -> IO (FunPtr TypeValueTableCollectValueFieldCallbackC) type TypeValueTableCollectValueFieldCallback = GValue -> Word32 -> TypeCValue -> Word32 -> IO T.Text noTypeValueTableCollectValueFieldCallback :: Maybe TypeValueTableCollectValueFieldCallback noTypeValueTableCollectValueFieldCallback = Nothing typeValueTableCollectValueFieldCallbackWrapper :: Maybe (Ptr (FunPtr (TypeValueTableCollectValueFieldCallbackC))) -> TypeValueTableCollectValueFieldCallback -> Ptr GValue -> Word32 -> Ptr TypeCValue -> Word32 -> IO CString typeValueTableCollectValueFieldCallbackWrapper funptrptr _cb value n_collect_values collect_values collect_flags = do value' <- (newBoxed GValue) value collect_values' <- (newPtr 8 TypeCValue) collect_values result <- _cb value' n_collect_values collect_values' collect_flags maybeReleaseFunPtr funptrptr result' <- textToCString result return result' -- callback TypeValueTableLcopyValueFieldCallback typeValueTableLcopyValueFieldCallbackClosure :: TypeValueTableLcopyValueFieldCallback -> IO Closure typeValueTableLcopyValueFieldCallbackClosure cb = newCClosure =<< mkTypeValueTableLcopyValueFieldCallback wrapped where wrapped = typeValueTableLcopyValueFieldCallbackWrapper Nothing cb type TypeValueTableLcopyValueFieldCallbackC = Ptr GValue -> Word32 -> Ptr TypeCValue -> Word32 -> IO CString foreign import ccall "wrapper" mkTypeValueTableLcopyValueFieldCallback :: TypeValueTableLcopyValueFieldCallbackC -> IO (FunPtr TypeValueTableLcopyValueFieldCallbackC) type TypeValueTableLcopyValueFieldCallback = GValue -> Word32 -> TypeCValue -> Word32 -> IO T.Text noTypeValueTableLcopyValueFieldCallback :: Maybe TypeValueTableLcopyValueFieldCallback noTypeValueTableLcopyValueFieldCallback = Nothing typeValueTableLcopyValueFieldCallbackWrapper :: Maybe (Ptr (FunPtr (TypeValueTableLcopyValueFieldCallbackC))) -> TypeValueTableLcopyValueFieldCallback -> Ptr GValue -> Word32 -> Ptr TypeCValue -> Word32 -> IO CString typeValueTableLcopyValueFieldCallbackWrapper funptrptr _cb value n_collect_values collect_values collect_flags = do value' <- (newBoxed GValue) value collect_values' <- (newPtr 8 TypeCValue) collect_values result <- _cb value' n_collect_values collect_values' collect_flags maybeReleaseFunPtr funptrptr result' <- textToCString result return result'