{-# LANGUAGE FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, MonoLocalBinds, MultiParamTypeClasses, ScopedTypeVariables, TypeSynonymInstances, UndecidableInstances #-} ---------- GENERATED FILE, EDITS WILL BE LOST ---------- module Graphics.UI.Qtah.Generated.Core.QObject ( QObjectValue (..), QObjectConstPtr (..), connect, connectWithType, disconnect, disconnectWithReceiver, disconnectWithReceiverAndMethod, disconnectWithSignal, disconnectWithSignalAndReceiver, disconnectWithSignalAndReceiverAndMethod, dynamicPropertyNames, inherits, isWidgetType, isWindowType, metaObject, objectName, parent, property, signalsBlocked, thread, QObjectPtr (..), blockSignals, children, deleteLater, dumpObjectInfo, dumpObjectTree, event, eventFilter, installEventFilter, killTimer, moveToThread, setObjectName, setParent, removeEventFilter, setProperty, startTimer, emitDestroyed, connectWithTypeStatic, connectWithSenderSignalStatic, connectWithSenderSignalTypeStatic, connectStatic, disconnectStatic, disconnectWithMetaobject, QObjectConst (..), castQObjectToConst, QObject (..), castQObjectToNonconst, new, newWithParent, QObjectSuper (..), QObjectSuperConst (..), ) where import qualified Data.ByteString as QtahDBS import qualified Foreign as HoppyF import qualified Foreign.C as HoppyFC import qualified Foreign.Hoppy.Runtime as HoppyFHR import qualified Graphics.UI.Qtah.Generated.Core.QEvent as M34 import qualified Graphics.UI.Qtah.Generated.Core.QList.QByteArray as M196 import {-# SOURCE #-} qualified Graphics.UI.Qtah.Generated.Core.QList.QObject as M202 import qualified Graphics.UI.Qtah.Generated.Core.QMetaMethod as M82 import {-# SOURCE #-} qualified Graphics.UI.Qtah.Generated.Core.QMetaObject as M84 import qualified Graphics.UI.Qtah.Generated.Core.QMetaObject.Connection as M86 import qualified Graphics.UI.Qtah.Generated.Core.QString as M142 import {-# SOURCE #-} qualified Graphics.UI.Qtah.Generated.Core.QThread as M156 import qualified Graphics.UI.Qtah.Generated.Core.QVariant as M168 import qualified Graphics.UI.Qtah.Generated.Core.Types as M190 import qualified Graphics.UI.Qtah.Std as M1 import Prelude (($), (.), (/=), (=<<), (==), (>>=)) import qualified Prelude as HoppyP import qualified Prelude as QtahP foreign import ccall "genpop__QObject_new" new' :: HoppyP.IO (HoppyF.Ptr QObject) foreign import ccall "genpop__QObject_newWithParent" newWithParent' :: HoppyF.Ptr QObject -> HoppyP.IO (HoppyF.Ptr QObject) foreign import ccall "genpop__QObject_blockSignals" blockSignals' :: HoppyF.Ptr QObject -> HoppyFC.CBool -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_children" children' :: HoppyF.Ptr QObject -> HoppyP.IO (HoppyF.Ptr M202.QListQObjectConst) foreign import ccall "genpop__QObject_connect" connect' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr QObjectConst -> HoppyF.Ptr HoppyFC.CChar -> HoppyF.Ptr HoppyFC.CChar -> HoppyP.IO (HoppyF.Ptr M86.ConnectionConst) foreign import ccall "genpop__QObject_connectWithType" connectWithType' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr QObjectConst -> HoppyF.Ptr HoppyFC.CChar -> HoppyF.Ptr HoppyFC.CChar -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M86.ConnectionConst) foreign import ccall "genpop__QObject_connectWithTypeStatic" connectWithTypeStatic' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr HoppyFC.CChar -> HoppyF.Ptr QObjectConst -> HoppyF.Ptr HoppyFC.CChar -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M86.ConnectionConst) foreign import ccall "genpop__QObject_connectWithSenderSignalStatic" connectWithSenderSignalStatic' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr M82.QMetaMethodConst -> HoppyF.Ptr QObjectConst -> HoppyF.Ptr M82.QMetaMethodConst -> HoppyP.IO (HoppyF.Ptr M86.ConnectionConst) foreign import ccall "genpop__QObject_connectWithSenderSignalTypeStatic" connectWithSenderSignalTypeStatic' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr M82.QMetaMethodConst -> HoppyF.Ptr QObjectConst -> HoppyF.Ptr M82.QMetaMethodConst -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M86.ConnectionConst) foreign import ccall "genpop__QObject_connectStatic" connectStatic' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr M1.StdStringConst -> HoppyF.Ptr QObjectConst -> HoppyF.Ptr M1.StdStringConst -> HoppyP.IO (HoppyF.Ptr M86.ConnectionConst) foreign import ccall "genpop__QObject_disconnectStatic" disconnectStatic' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr M1.StdStringConst -> HoppyF.Ptr QObjectConst -> HoppyF.Ptr M1.StdStringConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_deleteLater" deleteLater' :: HoppyF.Ptr QObject -> HoppyP.IO () foreign import ccall "genpop__QObject_disconnect" disconnect' :: HoppyF.Ptr QObjectConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_disconnectWithReceiver" disconnectWithReceiver' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr QObjectConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_disconnectWithReceiverAndMethod" disconnectWithReceiverAndMethod' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr QObjectConst -> HoppyF.Ptr HoppyFC.CChar -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_disconnectWithSignal" disconnectWithSignal' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr HoppyFC.CChar -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_disconnectWithSignalAndReceiver" disconnectWithSignalAndReceiver' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr HoppyFC.CChar -> HoppyF.Ptr QObjectConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_disconnectWithSignalAndReceiverAndMethod" disconnectWithSignalAndReceiverAndMethod' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr HoppyFC.CChar -> HoppyF.Ptr QObjectConst -> HoppyF.Ptr HoppyFC.CChar -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_disconnectWithMetaobject" disconnectWithMetaobject' :: HoppyF.Ptr M86.ConnectionConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_dumpObjectInfo" dumpObjectInfo' :: HoppyF.Ptr QObject -> HoppyP.IO () foreign import ccall "genpop__QObject_dumpObjectTree" dumpObjectTree' :: HoppyF.Ptr QObject -> HoppyP.IO () foreign import ccall "genpop__QObject_dynamicPropertyNames" dynamicPropertyNames' :: HoppyF.Ptr QObjectConst -> HoppyP.IO (HoppyF.Ptr M196.QListQByteArrayConst) foreign import ccall "genpop__QObject_event" event' :: HoppyF.Ptr QObject -> HoppyF.Ptr M34.QEvent -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_eventFilter" eventFilter' :: HoppyF.Ptr QObject -> HoppyF.Ptr QObject -> HoppyF.Ptr M34.QEvent -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_inherits" inherits' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr M142.QStringConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_installEventFilter" installEventFilter' :: HoppyF.Ptr QObject -> HoppyF.Ptr QObject -> HoppyP.IO () foreign import ccall "genpop__QObject_isWidgetType" isWidgetType' :: HoppyF.Ptr QObjectConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_isWindowType" isWindowType' :: HoppyF.Ptr QObjectConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_killTimer" killTimer' :: HoppyF.Ptr QObject -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QObject_metaObject" metaObject' :: HoppyF.Ptr QObjectConst -> HoppyP.IO (HoppyF.Ptr M84.QMetaObjectConst) foreign import ccall "genpop__QObject_moveToThread" moveToThread' :: HoppyF.Ptr QObject -> HoppyF.Ptr M156.QThread -> HoppyP.IO () foreign import ccall "genpop__QObject_objectName" objectName' :: HoppyF.Ptr QObjectConst -> HoppyP.IO (HoppyF.Ptr M142.QStringConst) foreign import ccall "genpop__QObject_setObjectName" setObjectName' :: HoppyF.Ptr QObject -> HoppyF.Ptr M142.QStringConst -> HoppyP.IO () foreign import ccall "genpop__QObject_parent" parent' :: HoppyF.Ptr QObjectConst -> HoppyP.IO (HoppyF.Ptr QObject) foreign import ccall "genpop__QObject_setParent" setParent' :: HoppyF.Ptr QObject -> HoppyF.Ptr QObject -> HoppyP.IO () foreign import ccall "genpop__QObject_property" property' :: HoppyF.Ptr QObjectConst -> HoppyF.Ptr M142.QStringConst -> HoppyP.IO (HoppyF.Ptr M168.QVariantConst) foreign import ccall "genpop__QObject_removeEventFilter" removeEventFilter' :: HoppyF.Ptr QObject -> HoppyF.Ptr QObject -> HoppyP.IO () foreign import ccall "genpop__QObject_setProperty" setProperty' :: HoppyF.Ptr QObject -> HoppyF.Ptr M142.QStringConst -> HoppyF.Ptr M168.QVariantConst -> HoppyP.IO () foreign import ccall "genpop__QObject_signalsBlocked" signalsBlocked' :: HoppyF.Ptr QObjectConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QObject_startTimer" startTimer' :: HoppyF.Ptr QObject -> HoppyFC.CInt -> HoppyP.IO HoppyFC.CInt foreign import ccall "genpop__QObject_thread" thread' :: HoppyF.Ptr QObjectConst -> HoppyP.IO (HoppyF.Ptr M156.QThread) foreign import ccall "genpop__QObject_emitDestroyed" emitDestroyed' :: HoppyF.Ptr QObject -> HoppyF.Ptr QObject -> HoppyP.IO () foreign import ccall "gendel__QObject" delete'QObject :: HoppyF.Ptr QObjectConst -> HoppyP.IO () foreign import ccall "&gendel__QObject" deletePtr'QObject :: HoppyF.FunPtr (HoppyF.Ptr QObjectConst -> HoppyP.IO ()) class QObjectValue a where withQObjectPtr :: a -> (QObjectConst -> HoppyP.IO b) -> HoppyP.IO b instance {-# OVERLAPPABLE #-} QObjectConstPtr a => QObjectValue a where withQObjectPtr = HoppyP.flip ($) . toQObjectConst class (HoppyFHR.CppPtr this) => QObjectConstPtr this where toQObjectConst :: this -> QObjectConst connect :: (QObjectValue this, QObjectValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyF.Ptr HoppyFC.CChar) -> (HoppyF.Ptr HoppyFC.CChar) -> (HoppyP.IO M86.Connection) connect arg'1 arg'2 arg'3 arg'4 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> withQObjectPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> let arg'3' = arg'3 in let arg'4' = arg'4 in (HoppyFHR.decodeAndDelete . M86.ConnectionConst) =<< (connect' arg'1' arg'2' arg'3' arg'4') connectWithType :: (QObjectValue this, QObjectValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyF.Ptr HoppyFC.CChar) -> (HoppyF.Ptr HoppyFC.CChar) -> (M190.QtConnectionType) -> (HoppyP.IO M86.Connection) connectWithType arg'1 arg'2 arg'3 arg'4 arg'5 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> withQObjectPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> let arg'3' = arg'3 in let arg'4' = arg'4 in ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'5 >>= \arg'5' -> (HoppyFHR.decodeAndDelete . M86.ConnectionConst) =<< (connectWithType' arg'1' arg'2' arg'3' arg'4' arg'5') disconnect :: (QObjectValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Bool) disconnect arg'1 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( (HoppyP.return . (/= 0)) ) =<< (disconnect' arg'1') disconnectWithReceiver :: (QObjectValue this, QObjectValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO HoppyP.Bool) disconnectWithReceiver arg'1 arg'2 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> withQObjectPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( (HoppyP.return . (/= 0)) ) =<< (disconnectWithReceiver' arg'1' arg'2') disconnectWithReceiverAndMethod :: (QObjectValue this, QObjectValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyF.Ptr HoppyFC.CChar) -> (HoppyP.IO HoppyP.Bool) disconnectWithReceiverAndMethod arg'1 arg'2 arg'3 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> withQObjectPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> let arg'3' = arg'3 in ( (HoppyP.return . (/= 0)) ) =<< (disconnectWithReceiverAndMethod' arg'1' arg'2' arg'3') disconnectWithSignal :: (QObjectValue this) => (this) {- ^ this -} -> (HoppyF.Ptr HoppyFC.CChar) -> (HoppyP.IO HoppyP.Bool) disconnectWithSignal arg'1 arg'2 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> let arg'2' = arg'2 in ( (HoppyP.return . (/= 0)) ) =<< (disconnectWithSignal' arg'1' arg'2') disconnectWithSignalAndReceiver :: (QObjectValue this, QObjectValue arg'3) => (this) {- ^ this -} -> (HoppyF.Ptr HoppyFC.CChar) -> (arg'3) -> (HoppyP.IO HoppyP.Bool) disconnectWithSignalAndReceiver arg'1 arg'2 arg'3 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> let arg'2' = arg'2 in withQObjectPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> ( (HoppyP.return . (/= 0)) ) =<< (disconnectWithSignalAndReceiver' arg'1' arg'2' arg'3') disconnectWithSignalAndReceiverAndMethod :: (QObjectValue this, QObjectValue arg'3) => (this) {- ^ this -} -> (HoppyF.Ptr HoppyFC.CChar) -> (arg'3) -> (HoppyF.Ptr HoppyFC.CChar) -> (HoppyP.IO HoppyP.Bool) disconnectWithSignalAndReceiverAndMethod arg'1 arg'2 arg'3 arg'4 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> let arg'2' = arg'2 in withQObjectPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> let arg'4' = arg'4 in ( (HoppyP.return . (/= 0)) ) =<< (disconnectWithSignalAndReceiverAndMethod' arg'1' arg'2' arg'3' arg'4') dynamicPropertyNames :: (QObjectValue this) => (this) {- ^ this -} -> (HoppyP.IO [QtahDBS.ByteString]) dynamicPropertyNames arg'1 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M196.QListQByteArrayConst) =<< (dynamicPropertyNames' arg'1') inherits :: (QObjectValue arg'1, M142.QStringValue className) => (arg'1) -> (className) {- ^ className -} -> (HoppyP.IO HoppyP.Bool) inherits arg'1 arg'2 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M142.withQStringPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( (HoppyP.return . (/= 0)) ) =<< (inherits' arg'1' arg'2') isWidgetType :: (QObjectValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Bool) isWidgetType arg'1 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( (HoppyP.return . (/= 0)) ) =<< (isWidgetType' arg'1') isWindowType :: (QObjectValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Bool) isWindowType arg'1 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( (HoppyP.return . (/= 0)) ) =<< (isWindowType' arg'1') metaObject :: (QObjectValue this) => (this) {- ^ this -} -> (HoppyP.IO M84.QMetaObjectConst) metaObject arg'1 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M84.QMetaObjectConst (metaObject' arg'1') objectName :: (QObjectValue this) => (this) {- ^ this -} -> (HoppyP.IO QtahP.String) objectName arg'1 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M142.QStringConst) =<< (objectName' arg'1') parent :: (QObjectValue this) => (this) {- ^ this -} -> (HoppyP.IO QObject) parent arg'1 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap QObject (parent' arg'1') property :: (QObjectValue arg'1, M142.QStringValue name) => (arg'1) -> (name) {- ^ name -} -> (HoppyP.IO M168.QVariant) property arg'1 arg'2 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M142.withQStringPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (HoppyFHR.decodeAndDelete . M168.QVariantConst) =<< (property' arg'1' arg'2') signalsBlocked :: (QObjectValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Bool) signalsBlocked arg'1 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( (HoppyP.return . (/= 0)) ) =<< (signalsBlocked' arg'1') thread :: (QObjectValue this) => (this) {- ^ this -} -> (HoppyP.IO M156.QThread) thread arg'1 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M156.QThread (thread' arg'1') class (QObjectConstPtr this) => QObjectPtr this where toQObject :: this -> QObject blockSignals :: (QObjectPtr this) => (this) {- ^ this -} -> (HoppyP.Bool) {- ^ block -} -> (HoppyP.IO HoppyP.Bool) blockSignals arg'1 arg'2 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> ( \x -> HoppyP.return $ if x then 1 else 0 ) arg'2 >>= \arg'2' -> ( (HoppyP.return . (/= 0)) ) =<< (blockSignals' arg'1' arg'2') children :: (QObjectPtr this) => (this) {- ^ this -} -> (HoppyP.IO [QObject]) children arg'1 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> (HoppyFHR.decodeAndDelete . M202.QListQObjectConst) =<< (children' arg'1') deleteLater :: (QObjectPtr this) => (this) {- ^ this -} -> (HoppyP.IO ()) deleteLater arg'1 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> (deleteLater' arg'1') dumpObjectInfo :: (QObjectPtr this) => (this) {- ^ this -} -> (HoppyP.IO ()) dumpObjectInfo arg'1 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> (dumpObjectInfo' arg'1') dumpObjectTree :: (QObjectPtr this) => (this) {- ^ this -} -> (HoppyP.IO ()) dumpObjectTree arg'1 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> (dumpObjectTree' arg'1') event :: (QObjectPtr this, M34.QEventPtr event) => (this) {- ^ this -} -> (event) {- ^ event -} -> (HoppyP.IO HoppyP.Bool) event arg'1 arg'2 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (M34.toQEvent arg'2) $ \arg'2' -> ( (HoppyP.return . (/= 0)) ) =<< (event' arg'1' arg'2') eventFilter :: (QObjectPtr this, QObjectPtr watched, M34.QEventPtr event) => (this) {- ^ this -} -> (watched) {- ^ watched -} -> (event) {- ^ event -} -> (HoppyP.IO HoppyP.Bool) eventFilter arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (toQObject arg'2) $ \arg'2' -> HoppyFHR.withCppPtr (M34.toQEvent arg'3) $ \arg'3' -> ( (HoppyP.return . (/= 0)) ) =<< (eventFilter' arg'1' arg'2' arg'3') installEventFilter :: (QObjectPtr this, QObjectPtr filterObj) => (this) {- ^ this -} -> (filterObj) {- ^ filterObj -} -> (HoppyP.IO ()) installEventFilter arg'1 arg'2 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (toQObject arg'2) $ \arg'2' -> (installEventFilter' arg'1' arg'2') killTimer :: (QObjectPtr this) => (this) {- ^ this -} -> (HoppyP.Int) {- ^ id -} -> (HoppyP.IO ()) killTimer arg'1 arg'2 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> (killTimer' arg'1' arg'2') moveToThread :: (QObjectPtr this, M156.QThreadPtr targetThread) => (this) {- ^ this -} -> (targetThread) {- ^ targetThread -} -> (HoppyP.IO ()) moveToThread arg'1 arg'2 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (M156.toQThread arg'2) $ \arg'2' -> (moveToThread' arg'1' arg'2') setObjectName :: (QObjectPtr this, M142.QStringValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) setObjectName arg'1 arg'2 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> M142.withQStringPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> (setObjectName' arg'1' arg'2') setParent :: (QObjectPtr this, QObjectPtr arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) setParent arg'1 arg'2 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (toQObject arg'2) $ \arg'2' -> (setParent' arg'1' arg'2') removeEventFilter :: (QObjectPtr this, QObjectPtr obj) => (this) {- ^ this -} -> (obj) {- ^ obj -} -> (HoppyP.IO ()) removeEventFilter arg'1 arg'2 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (toQObject arg'2) $ \arg'2' -> (removeEventFilter' arg'1' arg'2') setProperty :: (QObjectPtr arg'1, M142.QStringValue name, M168.QVariantValue value) => (arg'1) -> (name) {- ^ name -} -> (value) {- ^ value -} -> (HoppyP.IO ()) setProperty arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> M142.withQStringPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> M168.withQVariantPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> (setProperty' arg'1' arg'2' arg'3') startTimer :: (QObjectPtr this) => (this) {- ^ this -} -> (HoppyP.Int) {- ^ interval -} -> (HoppyP.IO HoppyP.Int) startTimer arg'1 arg'2 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) =<< (startTimer' arg'1' arg'2') emitDestroyed :: (QObjectPtr this, QObjectPtr arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) emitDestroyed arg'1 arg'2 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (toQObject arg'2) $ \arg'2' -> (emitDestroyed' arg'1' arg'2') connectWithTypeStatic :: (QObjectValue arg'1, QObjectValue arg'3) => (arg'1) -> (HoppyF.Ptr HoppyFC.CChar) -> (arg'3) -> (HoppyF.Ptr HoppyFC.CChar) -> (M190.QtConnectionType) -> (HoppyP.IO M86.Connection) connectWithTypeStatic arg'1 arg'2 arg'3 arg'4 arg'5 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> let arg'2' = arg'2 in withQObjectPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> let arg'4' = arg'4 in ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'5 >>= \arg'5' -> (HoppyFHR.decodeAndDelete . M86.ConnectionConst) =<< (connectWithTypeStatic' arg'1' arg'2' arg'3' arg'4' arg'5') connectWithSenderSignalStatic :: (QObjectValue arg'1, M82.QMetaMethodValue arg'2, QObjectValue arg'3, M82.QMetaMethodValue arg'4) => (arg'1) -> (arg'2) -> (arg'3) -> (arg'4) -> (HoppyP.IO M86.Connection) connectWithSenderSignalStatic arg'1 arg'2 arg'3 arg'4 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M82.withQMetaMethodPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> withQObjectPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> M82.withQMetaMethodPtr arg'4 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'4' -> (HoppyFHR.decodeAndDelete . M86.ConnectionConst) =<< (connectWithSenderSignalStatic' arg'1' arg'2' arg'3' arg'4') connectWithSenderSignalTypeStatic :: (QObjectValue arg'1, M82.QMetaMethodValue arg'2, QObjectValue arg'3, M82.QMetaMethodValue arg'4) => (arg'1) -> (arg'2) -> (arg'3) -> (arg'4) -> (M190.QtConnectionType) -> (HoppyP.IO M86.Connection) connectWithSenderSignalTypeStatic arg'1 arg'2 arg'3 arg'4 arg'5 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M82.withQMetaMethodPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> withQObjectPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> M82.withQMetaMethodPtr arg'4 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'4' -> ( HoppyP.return . HoppyFHR.fromCppEnum ) arg'5 >>= \arg'5' -> (HoppyFHR.decodeAndDelete . M86.ConnectionConst) =<< (connectWithSenderSignalTypeStatic' arg'1' arg'2' arg'3' arg'4' arg'5') connectStatic :: (QObjectValue arg'1, M1.StdStringValue arg'2, QObjectValue arg'3, M1.StdStringValue arg'4) => (arg'1) -> (arg'2) -> (arg'3) -> (arg'4) -> (HoppyP.IO M86.Connection) connectStatic arg'1 arg'2 arg'3 arg'4 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M1.withStdStringPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> withQObjectPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> M1.withStdStringPtr arg'4 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'4' -> (HoppyFHR.decodeAndDelete . M86.ConnectionConst) =<< (connectStatic' arg'1' arg'2' arg'3' arg'4') disconnectStatic :: (QObjectValue arg'1, M1.StdStringValue arg'2, QObjectValue arg'3, M1.StdStringValue arg'4) => (arg'1) -> (arg'2) -> (arg'3) -> (arg'4) -> (HoppyP.IO HoppyP.Bool) disconnectStatic arg'1 arg'2 arg'3 arg'4 = withQObjectPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M1.withStdStringPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> withQObjectPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> M1.withStdStringPtr arg'4 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'4' -> ( (HoppyP.return . (/= 0)) ) =<< (disconnectStatic' arg'1' arg'2' arg'3' arg'4') disconnectWithMetaobject :: (M86.ConnectionValue arg'1) => (arg'1) -> (HoppyP.IO HoppyP.Bool) disconnectWithMetaobject arg'1 = M86.withConnectionPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( (HoppyP.return . (/= 0)) ) =<< (disconnectWithMetaobject' arg'1') data QObjectConst = QObjectConst (HoppyF.Ptr QObjectConst) | QObjectConstGc (HoppyF.ForeignPtr ()) (HoppyF.Ptr QObjectConst) deriving (HoppyP.Show) instance HoppyP.Eq QObjectConst where x == y = HoppyFHR.toPtr x == HoppyFHR.toPtr y instance HoppyP.Ord QObjectConst where compare x y = HoppyP.compare (HoppyFHR.toPtr x) (HoppyFHR.toPtr y) castQObjectToConst :: QObject -> QObjectConst castQObjectToConst (QObject ptr') = QObjectConst $ HoppyF.castPtr ptr' castQObjectToConst (QObjectGc fptr' ptr') = QObjectConstGc fptr' $ HoppyF.castPtr ptr' instance HoppyFHR.CppPtr QObjectConst where nullptr = QObjectConst HoppyF.nullPtr withCppPtr (QObjectConst ptr') f' = f' ptr' withCppPtr (QObjectConstGc fptr' ptr') f' = HoppyF.withForeignPtr fptr' $ \_ -> f' ptr' toPtr (QObjectConst ptr') = ptr' toPtr (QObjectConstGc _ ptr') = ptr' touchCppPtr (QObjectConst _) = HoppyP.return () touchCppPtr (QObjectConstGc fptr' _) = HoppyF.touchForeignPtr fptr' instance HoppyFHR.Deletable QObjectConst where delete (QObjectConst ptr') = delete'QObject ptr' delete (QObjectConstGc _ _) = HoppyP.fail $ HoppyP.concat ["Deletable.delete: Asked to delete a GC-managed ", "QObjectConst", " object."] toGc this'@(QObjectConst ptr') = if ptr' == HoppyF.nullPtr then HoppyP.return this' else HoppyP.fmap (HoppyP.flip QObjectConstGc ptr') $ HoppyF.newForeignPtr (HoppyF.castFunPtr deletePtr'QObject :: HoppyF.FunPtr (HoppyF.Ptr () -> HoppyP.IO ())) (HoppyF.castPtr ptr' :: HoppyF.Ptr ()) toGc this'@(QObjectConstGc {}) = HoppyP.return this' instance QObjectConstPtr QObjectConst where toQObjectConst = HoppyP.id data QObject = QObject (HoppyF.Ptr QObject) | QObjectGc (HoppyF.ForeignPtr ()) (HoppyF.Ptr QObject) deriving (HoppyP.Show) instance HoppyP.Eq QObject where x == y = HoppyFHR.toPtr x == HoppyFHR.toPtr y instance HoppyP.Ord QObject where compare x y = HoppyP.compare (HoppyFHR.toPtr x) (HoppyFHR.toPtr y) castQObjectToNonconst :: QObjectConst -> QObject castQObjectToNonconst (QObjectConst ptr') = QObject $ HoppyF.castPtr ptr' castQObjectToNonconst (QObjectConstGc fptr' ptr') = QObjectGc fptr' $ HoppyF.castPtr ptr' instance HoppyFHR.CppPtr QObject where nullptr = QObject HoppyF.nullPtr withCppPtr (QObject ptr') f' = f' ptr' withCppPtr (QObjectGc fptr' ptr') f' = HoppyF.withForeignPtr fptr' $ \_ -> f' ptr' toPtr (QObject ptr') = ptr' toPtr (QObjectGc _ ptr') = ptr' touchCppPtr (QObject _) = HoppyP.return () touchCppPtr (QObjectGc fptr' _) = HoppyF.touchForeignPtr fptr' instance HoppyFHR.Deletable QObject where delete (QObject ptr') = delete'QObject $ (HoppyF.castPtr ptr' :: HoppyF.Ptr QObjectConst) delete (QObjectGc _ _) = HoppyP.fail $ HoppyP.concat ["Deletable.delete: Asked to delete a GC-managed ", "QObject", " object."] toGc this'@(QObject ptr') = if ptr' == HoppyF.nullPtr then HoppyP.return this' else HoppyP.fmap (HoppyP.flip QObjectGc ptr') $ HoppyF.newForeignPtr (HoppyF.castFunPtr deletePtr'QObject :: HoppyF.FunPtr (HoppyF.Ptr () -> HoppyP.IO ())) (HoppyF.castPtr ptr' :: HoppyF.Ptr ()) toGc this'@(QObjectGc {}) = HoppyP.return this' instance QObjectConstPtr QObject where toQObjectConst (QObject ptr') = QObjectConst $ (HoppyF.castPtr :: HoppyF.Ptr QObject -> HoppyF.Ptr QObjectConst) ptr' toQObjectConst (QObjectGc fptr' ptr') = QObjectConstGc fptr' $ (HoppyF.castPtr :: HoppyF.Ptr QObject -> HoppyF.Ptr QObjectConst) ptr' instance QObjectPtr QObject where toQObject = HoppyP.id new :: (HoppyP.IO QObject) new = HoppyP.fmap QObject (new') newWithParent :: (QObjectPtr parent) => (parent) {- ^ parent -} -> (HoppyP.IO QObject) newWithParent arg'1 = HoppyFHR.withCppPtr (toQObject arg'1) $ \arg'1' -> HoppyP.fmap QObject (newWithParent' arg'1') class QObjectSuper a where downToQObject :: a -> QObject class QObjectSuperConst a where downToQObjectConst :: a -> QObjectConst instance HoppyFHR.Assignable (HoppyF.Ptr (HoppyF.Ptr QObject)) QObject where assign ptr' value' = HoppyF.poke ptr' $ HoppyFHR.toPtr value' instance HoppyFHR.Decodable (HoppyF.Ptr (HoppyF.Ptr QObject)) QObject where decode = HoppyP.fmap QObject . HoppyF.peek