{- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte License : LGPL-2.1 Maintainer : Iñaki García Etxebarria (garetxe@gmail.com) The #GHook struct represents a single hook function in a #GHookList. -} module GI.GLib.Structs.Hook ( -- * Exported types Hook(..) , newZeroHook , noHook , -- * Methods -- ** hookCompareIds HookCompareIdsMethodInfo , hookCompareIds , -- ** hookDestroy hookDestroy , -- ** hookDestroyLink hookDestroyLink , -- ** hookFree hookFree , -- ** hookInsertBefore hookInsertBefore , -- ** hookPrepend hookPrepend , -- ** hookUnref hookUnref , -- * Properties -- ** Data hookClearData , hookData , hookReadData , hookWriteData , -- ** Flags hookFlags , hookReadFlags , hookWriteFlags , -- ** Func hookClearFunc , hookFunc , hookReadFunc , hookWriteFunc , -- ** HookId hookHookId , hookReadHookId , hookWriteHookId , -- ** Next hookClearNext , hookNext , hookReadNext , hookWriteNext , -- ** Prev hookClearPrev , hookPrev , hookReadPrev , hookWritePrev , -- ** RefCount hookReadRefCount , hookRefCount , hookWriteRefCount , ) where import Data.GI.Base.ShortPrelude import qualified Data.GI.Base.Attributes as GI.Attributes import qualified Data.Text as T import qualified Data.ByteString.Char8 as B import qualified Data.Map as Map import GI.GLib.Types import GI.GLib.Callbacks newtype Hook = Hook (ForeignPtr Hook) instance WrappedPtr Hook where wrappedPtrCalloc = callocBytes 64 wrappedPtrCopy = copyPtr 64 wrappedPtrFree = Just ptr_to_g_free -- | Construct a `Hook` struct initialized to zero. newZeroHook :: MonadIO m => m Hook newZeroHook = liftIO $ wrappedPtrCalloc >>= wrapPtr Hook instance tag ~ 'AttrSet => Constructible Hook tag where new _ attrs = do o <- newZeroHook GI.Attributes.set o attrs return o noHook :: Maybe Hook noHook = Nothing hookReadData :: MonadIO m => Hook -> m (Ptr ()) hookReadData s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO (Ptr ()) return val hookWriteData :: MonadIO m => Hook -> Ptr () -> m () hookWriteData s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 0) (val :: Ptr ()) hookClearData :: MonadIO m => Hook -> m () hookClearData s = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 0) (nullPtr :: Ptr ()) data HookDataFieldInfo instance AttrInfo HookDataFieldInfo where type AttrAllowedOps HookDataFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear] type AttrSetTypeConstraint HookDataFieldInfo = (~) (Ptr ()) type AttrBaseTypeConstraint HookDataFieldInfo = (~) Hook type AttrGetType HookDataFieldInfo = Ptr () type AttrLabel HookDataFieldInfo = "data" attrGet _ = hookReadData attrSet _ = hookWriteData attrConstruct = undefined attrClear _ = hookClearData hookData :: AttrLabelProxy "data" hookData = AttrLabelProxy hookReadNext :: MonadIO m => Hook -> m (Maybe Hook) hookReadNext s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO (Ptr Hook) result <- convertIfNonNull val $ \val' -> do val'' <- (newPtr Hook) val' return val'' return result hookWriteNext :: MonadIO m => Hook -> Ptr Hook -> m () hookWriteNext s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 8) (val :: Ptr Hook) hookClearNext :: MonadIO m => Hook -> m () hookClearNext s = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 8) (nullPtr :: Ptr Hook) data HookNextFieldInfo instance AttrInfo HookNextFieldInfo where type AttrAllowedOps HookNextFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear] type AttrSetTypeConstraint HookNextFieldInfo = (~) (Ptr Hook) type AttrBaseTypeConstraint HookNextFieldInfo = (~) Hook type AttrGetType HookNextFieldInfo = Maybe Hook type AttrLabel HookNextFieldInfo = "next" attrGet _ = hookReadNext attrSet _ = hookWriteNext attrConstruct = undefined attrClear _ = hookClearNext hookNext :: AttrLabelProxy "next" hookNext = AttrLabelProxy hookReadPrev :: MonadIO m => Hook -> m (Maybe Hook) hookReadPrev s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO (Ptr Hook) result <- convertIfNonNull val $ \val' -> do val'' <- (newPtr Hook) val' return val'' return result hookWritePrev :: MonadIO m => Hook -> Ptr Hook -> m () hookWritePrev s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 16) (val :: Ptr Hook) hookClearPrev :: MonadIO m => Hook -> m () hookClearPrev s = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 16) (nullPtr :: Ptr Hook) data HookPrevFieldInfo instance AttrInfo HookPrevFieldInfo where type AttrAllowedOps HookPrevFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear] type AttrSetTypeConstraint HookPrevFieldInfo = (~) (Ptr Hook) type AttrBaseTypeConstraint HookPrevFieldInfo = (~) Hook type AttrGetType HookPrevFieldInfo = Maybe Hook type AttrLabel HookPrevFieldInfo = "prev" attrGet _ = hookReadPrev attrSet _ = hookWritePrev attrConstruct = undefined attrClear _ = hookClearPrev hookPrev :: AttrLabelProxy "prev" hookPrev = AttrLabelProxy hookReadRefCount :: MonadIO m => Hook -> m Word32 hookReadRefCount s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO Word32 return val hookWriteRefCount :: MonadIO m => Hook -> Word32 -> m () hookWriteRefCount s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 24) (val :: Word32) data HookRefCountFieldInfo instance AttrInfo HookRefCountFieldInfo where type AttrAllowedOps HookRefCountFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint HookRefCountFieldInfo = (~) Word32 type AttrBaseTypeConstraint HookRefCountFieldInfo = (~) Hook type AttrGetType HookRefCountFieldInfo = Word32 type AttrLabel HookRefCountFieldInfo = "ref_count" attrGet _ = hookReadRefCount attrSet _ = hookWriteRefCount attrConstruct = undefined attrClear _ = undefined hookRefCount :: AttrLabelProxy "refCount" hookRefCount = AttrLabelProxy hookReadHookId :: MonadIO m => Hook -> m CULong hookReadHookId s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 32) :: IO CULong return val hookWriteHookId :: MonadIO m => Hook -> CULong -> m () hookWriteHookId s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 32) (val :: CULong) data HookHookIdFieldInfo instance AttrInfo HookHookIdFieldInfo where type AttrAllowedOps HookHookIdFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint HookHookIdFieldInfo = (~) CULong type AttrBaseTypeConstraint HookHookIdFieldInfo = (~) Hook type AttrGetType HookHookIdFieldInfo = CULong type AttrLabel HookHookIdFieldInfo = "hook_id" attrGet _ = hookReadHookId attrSet _ = hookWriteHookId attrConstruct = undefined attrClear _ = undefined hookHookId :: AttrLabelProxy "hookId" hookHookId = AttrLabelProxy hookReadFlags :: MonadIO m => Hook -> m Word32 hookReadFlags s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 40) :: IO Word32 return val hookWriteFlags :: MonadIO m => Hook -> Word32 -> m () hookWriteFlags s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 40) (val :: Word32) data HookFlagsFieldInfo instance AttrInfo HookFlagsFieldInfo where type AttrAllowedOps HookFlagsFieldInfo = '[ 'AttrSet, 'AttrGet] type AttrSetTypeConstraint HookFlagsFieldInfo = (~) Word32 type AttrBaseTypeConstraint HookFlagsFieldInfo = (~) Hook type AttrGetType HookFlagsFieldInfo = Word32 type AttrLabel HookFlagsFieldInfo = "flags" attrGet _ = hookReadFlags attrSet _ = hookWriteFlags attrConstruct = undefined attrClear _ = undefined hookFlags :: AttrLabelProxy "flags" hookFlags = AttrLabelProxy hookReadFunc :: MonadIO m => Hook -> m (Ptr ()) hookReadFunc s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 48) :: IO (Ptr ()) return val hookWriteFunc :: MonadIO m => Hook -> Ptr () -> m () hookWriteFunc s val = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 48) (val :: Ptr ()) hookClearFunc :: MonadIO m => Hook -> m () hookClearFunc s = liftIO $ withManagedPtr s $ \ptr -> do poke (ptr `plusPtr` 48) (nullPtr :: Ptr ()) data HookFuncFieldInfo instance AttrInfo HookFuncFieldInfo where type AttrAllowedOps HookFuncFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear] type AttrSetTypeConstraint HookFuncFieldInfo = (~) (Ptr ()) type AttrBaseTypeConstraint HookFuncFieldInfo = (~) Hook type AttrGetType HookFuncFieldInfo = Ptr () type AttrLabel HookFuncFieldInfo = "func" attrGet _ = hookReadFunc attrSet _ = hookWriteFunc attrConstruct = undefined attrClear _ = hookClearFunc hookFunc :: AttrLabelProxy "func" hookFunc = AttrLabelProxy -- XXX Skipped attribute for "Hook:destroy" :: Not implemented: "Wrapping foreign callbacks is not supported yet" type instance AttributeList Hook = HookAttributeList type HookAttributeList = ('[ '("data", HookDataFieldInfo), '("next", HookNextFieldInfo), '("prev", HookPrevFieldInfo), '("refCount", HookRefCountFieldInfo), '("hookId", HookHookIdFieldInfo), '("flags", HookFlagsFieldInfo), '("func", HookFuncFieldInfo)] :: [(Symbol, *)]) -- method Hook::compare_ids -- method type : OrdinaryMethod -- Args : [Arg {argCName = "_obj", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "sibling", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TBasicType TInt) -- throws : False -- Skip return : False foreign import ccall "g_hook_compare_ids" g_hook_compare_ids :: Ptr Hook -> -- _obj : TInterface "GLib" "Hook" Ptr Hook -> -- sibling : TInterface "GLib" "Hook" IO Int32 hookCompareIds :: (MonadIO m) => Hook -- _obj -> Hook -- sibling -> m Int32 -- result hookCompareIds _obj sibling = liftIO $ do let _obj' = unsafeManagedPtrGetPtr _obj let sibling' = unsafeManagedPtrGetPtr sibling result <- g_hook_compare_ids _obj' sibling' touchManagedPtr _obj touchManagedPtr sibling return result data HookCompareIdsMethodInfo instance (signature ~ (Hook -> m Int32), MonadIO m) => MethodInfo HookCompareIdsMethodInfo Hook signature where overloadedMethod _ = hookCompareIds -- method Hook::destroy -- method type : MemberFunction -- Args : [Arg {argCName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "hook_id", argType = TBasicType TULong, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Just (TBasicType TBoolean) -- throws : False -- Skip return : False foreign import ccall "g_hook_destroy" g_hook_destroy :: Ptr HookList -> -- hook_list : TInterface "GLib" "HookList" CULong -> -- hook_id : TBasicType TULong IO CInt hookDestroy :: (MonadIO m) => HookList -- hookList -> CULong -- hookId -> m Bool -- result hookDestroy hookList hookId = liftIO $ do let hookList' = unsafeManagedPtrGetPtr hookList result <- g_hook_destroy hookList' hookId let result' = (/= 0) result touchManagedPtr hookList return result' -- method Hook::destroy_link -- method type : MemberFunction -- Args : [Arg {argCName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Nothing -- throws : False -- Skip return : False foreign import ccall "g_hook_destroy_link" g_hook_destroy_link :: Ptr HookList -> -- hook_list : TInterface "GLib" "HookList" Ptr Hook -> -- hook : TInterface "GLib" "Hook" IO () hookDestroyLink :: (MonadIO m) => HookList -- hookList -> Hook -- hook -> m () -- result hookDestroyLink hookList hook = liftIO $ do let hookList' = unsafeManagedPtrGetPtr hookList let hook' = unsafeManagedPtrGetPtr hook g_hook_destroy_link hookList' hook' touchManagedPtr hookList touchManagedPtr hook return () -- method Hook::free -- method type : MemberFunction -- Args : [Arg {argCName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Nothing -- throws : False -- Skip return : False foreign import ccall "g_hook_free" g_hook_free :: Ptr HookList -> -- hook_list : TInterface "GLib" "HookList" Ptr Hook -> -- hook : TInterface "GLib" "Hook" IO () hookFree :: (MonadIO m) => HookList -- hookList -> Hook -- hook -> m () -- result hookFree hookList hook = liftIO $ do let hookList' = unsafeManagedPtrGetPtr hookList let hook' = unsafeManagedPtrGetPtr hook g_hook_free hookList' hook' touchManagedPtr hookList touchManagedPtr hook return () -- method Hook::insert_before -- method type : MemberFunction -- Args : [Arg {argCName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "sibling", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Nothing -- throws : False -- Skip return : False foreign import ccall "g_hook_insert_before" g_hook_insert_before :: Ptr HookList -> -- hook_list : TInterface "GLib" "HookList" Ptr Hook -> -- sibling : TInterface "GLib" "Hook" Ptr Hook -> -- hook : TInterface "GLib" "Hook" IO () hookInsertBefore :: (MonadIO m) => HookList -- hookList -> Hook -- sibling -> Hook -- hook -> m () -- result hookInsertBefore hookList sibling hook = liftIO $ do let hookList' = unsafeManagedPtrGetPtr hookList let sibling' = unsafeManagedPtrGetPtr sibling let hook' = unsafeManagedPtrGetPtr hook g_hook_insert_before hookList' sibling' hook' touchManagedPtr hookList touchManagedPtr sibling touchManagedPtr hook return () -- method Hook::prepend -- method type : MemberFunction -- Args : [Arg {argCName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Nothing -- throws : False -- Skip return : False foreign import ccall "g_hook_prepend" g_hook_prepend :: Ptr HookList -> -- hook_list : TInterface "GLib" "HookList" Ptr Hook -> -- hook : TInterface "GLib" "Hook" IO () hookPrepend :: (MonadIO m) => HookList -- hookList -> Hook -- hook -> m () -- result hookPrepend hookList hook = liftIO $ do let hookList' = unsafeManagedPtrGetPtr hookList let hook' = unsafeManagedPtrGetPtr hook g_hook_prepend hookList' hook' touchManagedPtr hookList touchManagedPtr hook return () -- method Hook::unref -- method type : MemberFunction -- Args : [Arg {argCName = "hook_list", argType = TInterface "GLib" "HookList", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "hook", argType = TInterface "GLib" "Hook", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}] -- Lengths : [] -- returnType : Nothing -- throws : False -- Skip return : False foreign import ccall "g_hook_unref" g_hook_unref :: Ptr HookList -> -- hook_list : TInterface "GLib" "HookList" Ptr Hook -> -- hook : TInterface "GLib" "Hook" IO () hookUnref :: (MonadIO m) => HookList -- hookList -> Hook -- hook -> m () -- result hookUnref hookList hook = liftIO $ do let hookList' = unsafeManagedPtrGetPtr hookList let hook' = unsafeManagedPtrGetPtr hook g_hook_unref hookList' hook' touchManagedPtr hookList touchManagedPtr hook return () type family ResolveHookMethod (t :: Symbol) (o :: *) :: * where ResolveHookMethod "compareIds" o = HookCompareIdsMethodInfo ResolveHookMethod l o = MethodResolutionFailed l o instance (info ~ ResolveHookMethod t Hook, MethodInfo info Hook p) => IsLabelProxy t (Hook -> p) where fromLabelProxy _ = overloadedMethod (MethodProxy :: MethodProxy info) #if MIN_VERSION_base(4,9,0) instance (info ~ ResolveHookMethod t Hook, MethodInfo info Hook p) => IsLabel t (Hook -> p) where fromLabel _ = overloadedMethod (MethodProxy :: MethodProxy info) #endif