{-# LANGUAGE FlexibleContexts, FlexibleInstances, ForeignFunctionInterface, MonoLocalBinds, MultiParamTypeClasses, ScopedTypeVariables, TypeSynonymInstances, UndecidableInstances #-} ---------- GENERATED FILE, EDITS WILL BE LOST ---------- module Graphics.UI.Qtah.Generated.Core.QItemSelectionModel ( castQItemSelectionModelToQObject, castQObjectToQItemSelectionModel, QItemSelectionModelValue (..), QItemSelectionModelConstPtr (..), columnIntersectsSelection, currentIndex, hasSelection, isColumnSelected, isRowSelected, isSelected, modelConst, rowIntersectsSelection, selectedColumns, selectedIndexes, selectedRows, selection, QItemSelectionModelPtr (..), clear, clearCurrentIndex, clearSelection, model, reset, selectIndex, selectSelection, setCurrentIndex, setModel, emitCurrentChanged, emitCurrentColumnChanged, emitCurrentRowChanged, emitModelChanged, emitSelectionChanged, QItemSelectionModelConst (..), castQItemSelectionModelToConst, QItemSelectionModel (..), castQItemSelectionModelToNonconst, new, newWithModel, newWithModelAndParent, QItemSelectionModelSuper (..), QItemSelectionModelSuperConst (..), QItemSelectionModelSelectionFlag (..), QItemSelectionModelSelectionFlags, IsQItemSelectionModelSelectionFlags (..), clearFlag, clearAndSelect, columns, current, deselect, noUpdate, rows, select, selectCurrent, toggle, toggleCurrent, ) where import Data.Bits ((.&.), (.|.)) import qualified Data.Bits as QtahDB import qualified Foreign as HoppyF import qualified Foreign.C as HoppyFC import qualified Foreign.Hoppy.Runtime as HoppyFHR import qualified Foreign.Hoppy.Runtime as QtahFHR import qualified Graphics.UI.Qtah.Flags as QtahFlags import qualified Graphics.UI.Qtah.Generated.Core.QAbstractItemModel as M4 import {-# SOURCE #-} qualified Graphics.UI.Qtah.Generated.Core.QItemSelection as M50 import qualified Graphics.UI.Qtah.Generated.Core.QItemSelectionRange as M54 import qualified Graphics.UI.Qtah.Generated.Core.QList.QModelIndex as M200 import qualified Graphics.UI.Qtah.Generated.Core.QModelIndex as M92 import qualified Graphics.UI.Qtah.Generated.Core.QObject as M94 import Prelude (($), (.), (/=), (=<<), (==), (>>=)) import qualified Prelude as HoppyP import qualified Prelude as QtahP foreign import ccall "genpop__QItemSelectionModel_new" new' :: HoppyP.IO (HoppyF.Ptr QItemSelectionModel) foreign import ccall "genpop__QItemSelectionModel_newWithModel" newWithModel' :: HoppyF.Ptr M4.QAbstractItemModel -> HoppyP.IO (HoppyF.Ptr QItemSelectionModel) foreign import ccall "genpop__QItemSelectionModel_newWithModelAndParent" newWithModelAndParent' :: HoppyF.Ptr M4.QAbstractItemModel -> HoppyF.Ptr M94.QObject -> HoppyP.IO (HoppyF.Ptr QItemSelectionModel) foreign import ccall "genpop__QItemSelectionModel_clear" clear' :: HoppyF.Ptr QItemSelectionModel -> HoppyP.IO () foreign import ccall "genpop__QItemSelectionModel_clearCurrentIndex" clearCurrentIndex' :: HoppyF.Ptr QItemSelectionModel -> HoppyP.IO () foreign import ccall "genpop__QItemSelectionModel_clearSelection" clearSelection' :: HoppyF.Ptr QItemSelectionModel -> HoppyP.IO () foreign import ccall "genpop__QItemSelectionModel_columnIntersectsSelection" columnIntersectsSelection' :: HoppyF.Ptr QItemSelectionModelConst -> HoppyFC.CInt -> HoppyF.Ptr M92.QModelIndexConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QItemSelectionModel_currentIndex" currentIndex' :: HoppyF.Ptr QItemSelectionModelConst -> HoppyP.IO (HoppyF.Ptr M92.QModelIndexConst) foreign import ccall "genpop__QItemSelectionModel_hasSelection" hasSelection' :: HoppyF.Ptr QItemSelectionModelConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QItemSelectionModel_isColumnSelected" isColumnSelected' :: HoppyF.Ptr QItemSelectionModelConst -> HoppyFC.CInt -> HoppyF.Ptr M92.QModelIndexConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QItemSelectionModel_isRowSelected" isRowSelected' :: HoppyF.Ptr QItemSelectionModelConst -> HoppyFC.CInt -> HoppyF.Ptr M92.QModelIndexConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QItemSelectionModel_isSelected" isSelected' :: HoppyF.Ptr QItemSelectionModelConst -> HoppyF.Ptr M92.QModelIndexConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QItemSelectionModel_model" model' :: HoppyF.Ptr QItemSelectionModel -> HoppyP.IO (HoppyF.Ptr M4.QAbstractItemModel) foreign import ccall "genpop__QItemSelectionModel_modelConst" modelConst' :: HoppyF.Ptr QItemSelectionModelConst -> HoppyP.IO (HoppyF.Ptr M4.QAbstractItemModelConst) foreign import ccall "genpop__QItemSelectionModel_reset" reset' :: HoppyF.Ptr QItemSelectionModel -> HoppyP.IO () foreign import ccall "genpop__QItemSelectionModel_rowIntersectsSelection" rowIntersectsSelection' :: HoppyF.Ptr QItemSelectionModelConst -> HoppyFC.CInt -> HoppyF.Ptr M92.QModelIndexConst -> HoppyP.IO HoppyFC.CBool foreign import ccall "genpop__QItemSelectionModel_selectIndex" selectIndex' :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr M92.QModelIndexConst -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QItemSelectionModel_selectSelection" selectSelection' :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr M50.QItemSelectionConst -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QItemSelectionModel_selectedColumns" selectedColumns' :: HoppyF.Ptr QItemSelectionModelConst -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M200.QListQModelIndexConst) foreign import ccall "genpop__QItemSelectionModel_selectedIndexes" selectedIndexes' :: HoppyF.Ptr QItemSelectionModelConst -> HoppyP.IO (HoppyF.Ptr M200.QListQModelIndexConst) foreign import ccall "genpop__QItemSelectionModel_selectedRows" selectedRows' :: HoppyF.Ptr QItemSelectionModelConst -> HoppyFC.CInt -> HoppyP.IO (HoppyF.Ptr M200.QListQModelIndexConst) foreign import ccall "genpop__QItemSelectionModel_selection" selection' :: HoppyF.Ptr QItemSelectionModelConst -> HoppyP.IO (HoppyF.Ptr M50.QItemSelectionConst) foreign import ccall "genpop__QItemSelectionModel_setCurrentIndex" setCurrentIndex' :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr M92.QModelIndexConst -> HoppyFC.CInt -> HoppyP.IO () foreign import ccall "genpop__QItemSelectionModel_setModel" setModel' :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr M4.QAbstractItemModel -> HoppyP.IO () foreign import ccall "genpop__QItemSelectionModel_emitCurrentChanged" emitCurrentChanged' :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr M92.QModelIndexConst -> HoppyF.Ptr M92.QModelIndexConst -> HoppyP.IO () foreign import ccall "genpop__QItemSelectionModel_emitCurrentColumnChanged" emitCurrentColumnChanged' :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr M92.QModelIndexConst -> HoppyF.Ptr M92.QModelIndexConst -> HoppyP.IO () foreign import ccall "genpop__QItemSelectionModel_emitCurrentRowChanged" emitCurrentRowChanged' :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr M92.QModelIndexConst -> HoppyF.Ptr M92.QModelIndexConst -> HoppyP.IO () foreign import ccall "genpop__QItemSelectionModel_emitModelChanged" emitModelChanged' :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr M4.QAbstractItemModel -> HoppyP.IO () foreign import ccall "genpop__QItemSelectionModel_emitSelectionChanged" emitSelectionChanged' :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr M50.QItemSelectionConst -> HoppyF.Ptr M50.QItemSelectionConst -> HoppyP.IO () foreign import ccall "gencast__QItemSelectionModel__QObject" castQItemSelectionModelToQObject :: HoppyF.Ptr QItemSelectionModelConst -> HoppyF.Ptr M94.QObjectConst foreign import ccall "gencast__QObject__QItemSelectionModel" castQObjectToQItemSelectionModel :: HoppyF.Ptr M94.QObjectConst -> HoppyF.Ptr QItemSelectionModelConst foreign import ccall "gendel__QItemSelectionModel" delete'QItemSelectionModel :: HoppyF.Ptr QItemSelectionModelConst -> HoppyP.IO () foreign import ccall "&gendel__QItemSelectionModel" deletePtr'QItemSelectionModel :: HoppyF.FunPtr (HoppyF.Ptr QItemSelectionModelConst -> HoppyP.IO ()) class QItemSelectionModelValue a where withQItemSelectionModelPtr :: a -> (QItemSelectionModelConst -> HoppyP.IO b) -> HoppyP.IO b instance {-# OVERLAPPABLE #-} QItemSelectionModelConstPtr a => QItemSelectionModelValue a where withQItemSelectionModelPtr = HoppyP.flip ($) . toQItemSelectionModelConst class (M94.QObjectConstPtr this) => QItemSelectionModelConstPtr this where toQItemSelectionModelConst :: this -> QItemSelectionModelConst columnIntersectsSelection :: (QItemSelectionModelValue this, M92.QModelIndexValue arg'3) => (this) {- ^ this -} -> (HoppyP.Int) -> (arg'3) -> (HoppyP.IO HoppyP.Bool) columnIntersectsSelection arg'1 arg'2 arg'3 = withQItemSelectionModelPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> M92.withQModelIndexPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> ( (HoppyP.return . (/= 0)) ) =<< (columnIntersectsSelection' arg'1' arg'2' arg'3') currentIndex :: (QItemSelectionModelValue this) => (this) {- ^ this -} -> (HoppyP.IO M92.QModelIndex) currentIndex arg'1 = withQItemSelectionModelPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M92.QModelIndexConst) =<< (currentIndex' arg'1') hasSelection :: (QItemSelectionModelValue this) => (this) {- ^ this -} -> (HoppyP.IO HoppyP.Bool) hasSelection arg'1 = withQItemSelectionModelPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( (HoppyP.return . (/= 0)) ) =<< (hasSelection' arg'1') isColumnSelected :: (QItemSelectionModelValue this, M92.QModelIndexValue arg'3) => (this) {- ^ this -} -> (HoppyP.Int) -> (arg'3) -> (HoppyP.IO HoppyP.Bool) isColumnSelected arg'1 arg'2 arg'3 = withQItemSelectionModelPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> M92.withQModelIndexPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> ( (HoppyP.return . (/= 0)) ) =<< (isColumnSelected' arg'1' arg'2' arg'3') isRowSelected :: (QItemSelectionModelValue this, M92.QModelIndexValue arg'3) => (this) {- ^ this -} -> (HoppyP.Int) -> (arg'3) -> (HoppyP.IO HoppyP.Bool) isRowSelected arg'1 arg'2 arg'3 = withQItemSelectionModelPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> M92.withQModelIndexPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> ( (HoppyP.return . (/= 0)) ) =<< (isRowSelected' arg'1' arg'2' arg'3') isSelected :: (QItemSelectionModelValue this, M92.QModelIndexValue arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO HoppyP.Bool) isSelected arg'1 arg'2 = withQItemSelectionModelPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> M92.withQModelIndexPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( (HoppyP.return . (/= 0)) ) =<< (isSelected' arg'1' arg'2') modelConst :: (QItemSelectionModelValue this) => (this) {- ^ this -} -> (HoppyP.IO M4.QAbstractItemModelConst) modelConst arg'1 = withQItemSelectionModelPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> HoppyP.fmap M4.QAbstractItemModelConst (modelConst' arg'1') rowIntersectsSelection :: (QItemSelectionModelValue this, M92.QModelIndexValue arg'3) => (this) {- ^ this -} -> (HoppyP.Int) -> (arg'3) -> (HoppyP.IO HoppyP.Bool) rowIntersectsSelection arg'1 arg'2 arg'3 = withQItemSelectionModelPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> M92.withQModelIndexPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> ( (HoppyP.return . (/= 0)) ) =<< (rowIntersectsSelection' arg'1' arg'2' arg'3') selectedColumns :: (QItemSelectionModelValue this) => (this) {- ^ this -} -> (HoppyP.Int) -> (HoppyP.IO [M92.QModelIndex]) selectedColumns arg'1 arg'2 = withQItemSelectionModelPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> (HoppyFHR.decodeAndDelete . M200.QListQModelIndexConst) =<< (selectedColumns' arg'1' arg'2') selectedIndexes :: (QItemSelectionModelValue this) => (this) {- ^ this -} -> (HoppyP.IO [M92.QModelIndex]) selectedIndexes arg'1 = withQItemSelectionModelPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M200.QListQModelIndexConst) =<< (selectedIndexes' arg'1') selectedRows :: (QItemSelectionModelValue this) => (this) {- ^ this -} -> (HoppyP.Int) -> (HoppyP.IO [M92.QModelIndex]) selectedRows arg'1 arg'2 = withQItemSelectionModelPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> ( HoppyP.return . HoppyFHR.coerceIntegral ) arg'2 >>= \arg'2' -> (HoppyFHR.decodeAndDelete . M200.QListQModelIndexConst) =<< (selectedRows' arg'1' arg'2') selection :: (QItemSelectionModelValue this) => (this) {- ^ this -} -> (HoppyP.IO [M54.QItemSelectionRange]) selection arg'1 = withQItemSelectionModelPtr arg'1 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'1' -> (HoppyFHR.decodeAndDelete . M50.QItemSelectionConst) =<< (selection' arg'1') class (QItemSelectionModelConstPtr this, M94.QObjectPtr this) => QItemSelectionModelPtr this where toQItemSelectionModel :: this -> QItemSelectionModel clear :: (QItemSelectionModelPtr this) => (this) {- ^ this -} -> (HoppyP.IO ()) clear arg'1 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> (clear' arg'1') clearCurrentIndex :: (QItemSelectionModelPtr this) => (this) {- ^ this -} -> (HoppyP.IO ()) clearCurrentIndex arg'1 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> (clearCurrentIndex' arg'1') clearSelection :: (QItemSelectionModelPtr this) => (this) {- ^ this -} -> (HoppyP.IO ()) clearSelection arg'1 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> (clearSelection' arg'1') model :: (QItemSelectionModelPtr this) => (this) {- ^ this -} -> (HoppyP.IO M4.QAbstractItemModel) model arg'1 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> HoppyP.fmap M4.QAbstractItemModel (model' arg'1') reset :: (QItemSelectionModelPtr this) => (this) {- ^ this -} -> (HoppyP.IO ()) reset arg'1 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> (reset' arg'1') selectIndex :: (QItemSelectionModelPtr this, M92.QModelIndexValue arg'2, IsQItemSelectionModelSelectionFlags arg'3) => (this) {- ^ this -} -> (arg'2) -> (arg'3) -> (HoppyP.IO ()) selectIndex arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> M92.withQModelIndexPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( QtahP.return . QtahFlags.flagsToNum . toQItemSelectionModelSelectionFlags ) arg'3 >>= \arg'3' -> (selectIndex' arg'1' arg'2' arg'3') selectSelection :: (QItemSelectionModelPtr this, M50.QItemSelectionValue arg'2, IsQItemSelectionModelSelectionFlags arg'3) => (this) {- ^ this -} -> (arg'2) -> (arg'3) -> (HoppyP.IO ()) selectSelection arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> M50.withQItemSelectionPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( QtahP.return . QtahFlags.flagsToNum . toQItemSelectionModelSelectionFlags ) arg'3 >>= \arg'3' -> (selectSelection' arg'1' arg'2' arg'3') setCurrentIndex :: (QItemSelectionModelPtr this, M92.QModelIndexValue arg'2, IsQItemSelectionModelSelectionFlags arg'3) => (this) {- ^ this -} -> (arg'2) -> (arg'3) -> (HoppyP.IO ()) setCurrentIndex arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> M92.withQModelIndexPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> ( QtahP.return . QtahFlags.flagsToNum . toQItemSelectionModelSelectionFlags ) arg'3 >>= \arg'3' -> (setCurrentIndex' arg'1' arg'2' arg'3') setModel :: (QItemSelectionModelPtr this, M4.QAbstractItemModelPtr arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) setModel arg'1 arg'2 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (M4.toQAbstractItemModel arg'2) $ \arg'2' -> (setModel' arg'1' arg'2') emitCurrentChanged :: (QItemSelectionModelPtr this, M92.QModelIndexValue arg'2, M92.QModelIndexValue arg'3) => (this) {- ^ this -} -> (arg'2) -> (arg'3) -> (HoppyP.IO ()) emitCurrentChanged arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> M92.withQModelIndexPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> M92.withQModelIndexPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> (emitCurrentChanged' arg'1' arg'2' arg'3') emitCurrentColumnChanged :: (QItemSelectionModelPtr this, M92.QModelIndexValue arg'2, M92.QModelIndexValue arg'3) => (this) {- ^ this -} -> (arg'2) -> (arg'3) -> (HoppyP.IO ()) emitCurrentColumnChanged arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> M92.withQModelIndexPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> M92.withQModelIndexPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> (emitCurrentColumnChanged' arg'1' arg'2' arg'3') emitCurrentRowChanged :: (QItemSelectionModelPtr this, M92.QModelIndexValue arg'2, M92.QModelIndexValue arg'3) => (this) {- ^ this -} -> (arg'2) -> (arg'3) -> (HoppyP.IO ()) emitCurrentRowChanged arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> M92.withQModelIndexPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> M92.withQModelIndexPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> (emitCurrentRowChanged' arg'1' arg'2' arg'3') emitModelChanged :: (QItemSelectionModelPtr this, M4.QAbstractItemModelPtr arg'2) => (this) {- ^ this -} -> (arg'2) -> (HoppyP.IO ()) emitModelChanged arg'1 arg'2 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (M4.toQAbstractItemModel arg'2) $ \arg'2' -> (emitModelChanged' arg'1' arg'2') emitSelectionChanged :: (QItemSelectionModelPtr this, M50.QItemSelectionValue arg'2, M50.QItemSelectionValue arg'3) => (this) {- ^ this -} -> (arg'2) -> (arg'3) -> (HoppyP.IO ()) emitSelectionChanged arg'1 arg'2 arg'3 = HoppyFHR.withCppPtr (toQItemSelectionModel arg'1) $ \arg'1' -> M50.withQItemSelectionPtr arg'2 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'2' -> M50.withQItemSelectionPtr arg'3 $ HoppyP.flip HoppyFHR.withCppPtr $ \arg'3' -> (emitSelectionChanged' arg'1' arg'2' arg'3') data QItemSelectionModelConst = QItemSelectionModelConst (HoppyF.Ptr QItemSelectionModelConst) | QItemSelectionModelConstGc (HoppyF.ForeignPtr ()) (HoppyF.Ptr QItemSelectionModelConst) deriving (HoppyP.Show) instance HoppyP.Eq QItemSelectionModelConst where x == y = HoppyFHR.toPtr x == HoppyFHR.toPtr y instance HoppyP.Ord QItemSelectionModelConst where compare x y = HoppyP.compare (HoppyFHR.toPtr x) (HoppyFHR.toPtr y) castQItemSelectionModelToConst :: QItemSelectionModel -> QItemSelectionModelConst castQItemSelectionModelToConst (QItemSelectionModel ptr') = QItemSelectionModelConst $ HoppyF.castPtr ptr' castQItemSelectionModelToConst (QItemSelectionModelGc fptr' ptr') = QItemSelectionModelConstGc fptr' $ HoppyF.castPtr ptr' instance HoppyFHR.CppPtr QItemSelectionModelConst where nullptr = QItemSelectionModelConst HoppyF.nullPtr withCppPtr (QItemSelectionModelConst ptr') f' = f' ptr' withCppPtr (QItemSelectionModelConstGc fptr' ptr') f' = HoppyF.withForeignPtr fptr' $ \_ -> f' ptr' toPtr (QItemSelectionModelConst ptr') = ptr' toPtr (QItemSelectionModelConstGc _ ptr') = ptr' touchCppPtr (QItemSelectionModelConst _) = HoppyP.return () touchCppPtr (QItemSelectionModelConstGc fptr' _) = HoppyF.touchForeignPtr fptr' instance HoppyFHR.Deletable QItemSelectionModelConst where delete (QItemSelectionModelConst ptr') = delete'QItemSelectionModel ptr' delete (QItemSelectionModelConstGc _ _) = HoppyP.fail $ HoppyP.concat ["Deletable.delete: Asked to delete a GC-managed ", "QItemSelectionModelConst", " object."] toGc this'@(QItemSelectionModelConst ptr') = if ptr' == HoppyF.nullPtr then HoppyP.return this' else HoppyP.fmap (HoppyP.flip QItemSelectionModelConstGc ptr') $ HoppyF.newForeignPtr (HoppyF.castFunPtr deletePtr'QItemSelectionModel :: HoppyF.FunPtr (HoppyF.Ptr () -> HoppyP.IO ())) (HoppyF.castPtr ptr' :: HoppyF.Ptr ()) toGc this'@(QItemSelectionModelConstGc {}) = HoppyP.return this' instance QItemSelectionModelConstPtr QItemSelectionModelConst where toQItemSelectionModelConst = HoppyP.id instance M94.QObjectConstPtr QItemSelectionModelConst where toQObjectConst (QItemSelectionModelConst ptr') = M94.QObjectConst $ castQItemSelectionModelToQObject ptr' toQObjectConst (QItemSelectionModelConstGc fptr' ptr') = M94.QObjectConstGc fptr' $ castQItemSelectionModelToQObject ptr' data QItemSelectionModel = QItemSelectionModel (HoppyF.Ptr QItemSelectionModel) | QItemSelectionModelGc (HoppyF.ForeignPtr ()) (HoppyF.Ptr QItemSelectionModel) deriving (HoppyP.Show) instance HoppyP.Eq QItemSelectionModel where x == y = HoppyFHR.toPtr x == HoppyFHR.toPtr y instance HoppyP.Ord QItemSelectionModel where compare x y = HoppyP.compare (HoppyFHR.toPtr x) (HoppyFHR.toPtr y) castQItemSelectionModelToNonconst :: QItemSelectionModelConst -> QItemSelectionModel castQItemSelectionModelToNonconst (QItemSelectionModelConst ptr') = QItemSelectionModel $ HoppyF.castPtr ptr' castQItemSelectionModelToNonconst (QItemSelectionModelConstGc fptr' ptr') = QItemSelectionModelGc fptr' $ HoppyF.castPtr ptr' instance HoppyFHR.CppPtr QItemSelectionModel where nullptr = QItemSelectionModel HoppyF.nullPtr withCppPtr (QItemSelectionModel ptr') f' = f' ptr' withCppPtr (QItemSelectionModelGc fptr' ptr') f' = HoppyF.withForeignPtr fptr' $ \_ -> f' ptr' toPtr (QItemSelectionModel ptr') = ptr' toPtr (QItemSelectionModelGc _ ptr') = ptr' touchCppPtr (QItemSelectionModel _) = HoppyP.return () touchCppPtr (QItemSelectionModelGc fptr' _) = HoppyF.touchForeignPtr fptr' instance HoppyFHR.Deletable QItemSelectionModel where delete (QItemSelectionModel ptr') = delete'QItemSelectionModel $ (HoppyF.castPtr ptr' :: HoppyF.Ptr QItemSelectionModelConst) delete (QItemSelectionModelGc _ _) = HoppyP.fail $ HoppyP.concat ["Deletable.delete: Asked to delete a GC-managed ", "QItemSelectionModel", " object."] toGc this'@(QItemSelectionModel ptr') = if ptr' == HoppyF.nullPtr then HoppyP.return this' else HoppyP.fmap (HoppyP.flip QItemSelectionModelGc ptr') $ HoppyF.newForeignPtr (HoppyF.castFunPtr deletePtr'QItemSelectionModel :: HoppyF.FunPtr (HoppyF.Ptr () -> HoppyP.IO ())) (HoppyF.castPtr ptr' :: HoppyF.Ptr ()) toGc this'@(QItemSelectionModelGc {}) = HoppyP.return this' instance QItemSelectionModelConstPtr QItemSelectionModel where toQItemSelectionModelConst (QItemSelectionModel ptr') = QItemSelectionModelConst $ (HoppyF.castPtr :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr QItemSelectionModelConst) ptr' toQItemSelectionModelConst (QItemSelectionModelGc fptr' ptr') = QItemSelectionModelConstGc fptr' $ (HoppyF.castPtr :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr QItemSelectionModelConst) ptr' instance QItemSelectionModelPtr QItemSelectionModel where toQItemSelectionModel = HoppyP.id instance M94.QObjectConstPtr QItemSelectionModel where toQObjectConst (QItemSelectionModel ptr') = M94.QObjectConst $ castQItemSelectionModelToQObject $ (HoppyF.castPtr :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr QItemSelectionModelConst) ptr' toQObjectConst (QItemSelectionModelGc fptr' ptr') = M94.QObjectConstGc fptr' $ castQItemSelectionModelToQObject $ (HoppyF.castPtr :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr QItemSelectionModelConst) ptr' instance M94.QObjectPtr QItemSelectionModel where toQObject (QItemSelectionModel ptr') = M94.QObject $ (HoppyF.castPtr :: HoppyF.Ptr M94.QObjectConst -> HoppyF.Ptr M94.QObject) $ castQItemSelectionModelToQObject $ (HoppyF.castPtr :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr QItemSelectionModelConst) ptr' toQObject (QItemSelectionModelGc fptr' ptr') = M94.QObjectGc fptr' $ (HoppyF.castPtr :: HoppyF.Ptr M94.QObjectConst -> HoppyF.Ptr M94.QObject) $ castQItemSelectionModelToQObject $ (HoppyF.castPtr :: HoppyF.Ptr QItemSelectionModel -> HoppyF.Ptr QItemSelectionModelConst) ptr' new :: (HoppyP.IO QItemSelectionModel) new = HoppyP.fmap QItemSelectionModel (new') newWithModel :: (M4.QAbstractItemModelPtr arg'1) => (arg'1) -> (HoppyP.IO QItemSelectionModel) newWithModel arg'1 = HoppyFHR.withCppPtr (M4.toQAbstractItemModel arg'1) $ \arg'1' -> HoppyP.fmap QItemSelectionModel (newWithModel' arg'1') newWithModelAndParent :: (M4.QAbstractItemModelPtr arg'1, M94.QObjectPtr arg'2) => (arg'1) -> (arg'2) -> (HoppyP.IO QItemSelectionModel) newWithModelAndParent arg'1 arg'2 = HoppyFHR.withCppPtr (M4.toQAbstractItemModel arg'1) $ \arg'1' -> HoppyFHR.withCppPtr (M94.toQObject arg'2) $ \arg'2' -> HoppyP.fmap QItemSelectionModel (newWithModelAndParent' arg'1' arg'2') class QItemSelectionModelSuper a where downToQItemSelectionModel :: a -> QItemSelectionModel instance QItemSelectionModelSuper M94.QObject where downToQItemSelectionModel = castQItemSelectionModelToNonconst . cast' . M94.castQObjectToConst where cast' (M94.QObjectConst ptr') = QItemSelectionModelConst $ castQObjectToQItemSelectionModel ptr' cast' (M94.QObjectConstGc fptr' ptr') = QItemSelectionModelConstGc fptr' $ castQObjectToQItemSelectionModel ptr' class QItemSelectionModelSuperConst a where downToQItemSelectionModelConst :: a -> QItemSelectionModelConst instance QItemSelectionModelSuperConst M94.QObjectConst where downToQItemSelectionModelConst = cast' where cast' (M94.QObjectConst ptr') = QItemSelectionModelConst $ castQObjectToQItemSelectionModel ptr' cast' (M94.QObjectConstGc fptr' ptr') = QItemSelectionModelConstGc fptr' $ castQObjectToQItemSelectionModel ptr' instance HoppyFHR.Assignable (HoppyF.Ptr (HoppyF.Ptr QItemSelectionModel)) QItemSelectionModel where assign ptr' value' = HoppyF.poke ptr' $ HoppyFHR.toPtr value' instance HoppyFHR.Decodable (HoppyF.Ptr (HoppyF.Ptr QItemSelectionModel)) QItemSelectionModel where decode = HoppyP.fmap QItemSelectionModel . HoppyF.peek data QItemSelectionModelSelectionFlag = NoUpdate | ClearFlag | Select | Deselect | Toggle | Current | Rows | Columns | SelectCurrent | ToggleCurrent | ClearAndSelect | UnknownQItemSelectionModelSelectionFlag (HoppyFC.CInt) deriving (HoppyP.Show) instance HoppyFHR.CppEnum (HoppyFC.CInt) QItemSelectionModelSelectionFlag where fromCppEnum NoUpdate = 0 fromCppEnum ClearFlag = 1 fromCppEnum Select = 2 fromCppEnum Deselect = 4 fromCppEnum Toggle = 8 fromCppEnum Current = 16 fromCppEnum Rows = 32 fromCppEnum Columns = 64 fromCppEnum SelectCurrent = 18 fromCppEnum ToggleCurrent = 24 fromCppEnum ClearAndSelect = 3 fromCppEnum (UnknownQItemSelectionModelSelectionFlag n) = n toCppEnum (0) = NoUpdate toCppEnum (1) = ClearFlag toCppEnum (2) = Select toCppEnum (3) = ClearAndSelect toCppEnum (4) = Deselect toCppEnum (8) = Toggle toCppEnum (16) = Current toCppEnum (18) = SelectCurrent toCppEnum (24) = ToggleCurrent toCppEnum (32) = Rows toCppEnum (64) = Columns toCppEnum n = UnknownQItemSelectionModelSelectionFlag n instance HoppyP.Eq QItemSelectionModelSelectionFlag where x == y = HoppyFHR.fromCppEnum x == HoppyFHR.fromCppEnum y instance HoppyP.Ord QItemSelectionModelSelectionFlag where compare x y = HoppyP.compare (HoppyFHR.fromCppEnum x) (HoppyFHR.fromCppEnum y) newtype QItemSelectionModelSelectionFlags = QItemSelectionModelSelectionFlags (HoppyFC.CInt) deriving (QtahP.Eq, QtahP.Ord, QtahP.Show) instance QtahFlags.Flags (HoppyFC.CInt) QItemSelectionModelSelectionFlag QItemSelectionModelSelectionFlags where enumToFlags = QItemSelectionModelSelectionFlags . QtahFHR.fromCppEnum flagsToEnum (QItemSelectionModelSelectionFlags x') = QtahFHR.toCppEnum x' class IsQItemSelectionModelSelectionFlags a where toQItemSelectionModelSelectionFlags :: a -> QItemSelectionModelSelectionFlags instance IsQItemSelectionModelSelectionFlags QItemSelectionModelSelectionFlags where toQItemSelectionModelSelectionFlags = QtahP.id instance IsQItemSelectionModelSelectionFlags QItemSelectionModelSelectionFlag where toQItemSelectionModelSelectionFlags = QtahFlags.enumToFlags instance IsQItemSelectionModelSelectionFlags (HoppyFC.CInt) where toQItemSelectionModelSelectionFlags = QtahFlags.numToFlags clearFlag :: QItemSelectionModelSelectionFlags clearFlag = QItemSelectionModelSelectionFlags (1) clearAndSelect :: QItemSelectionModelSelectionFlags clearAndSelect = QItemSelectionModelSelectionFlags (3) columns :: QItemSelectionModelSelectionFlags columns = QItemSelectionModelSelectionFlags (64) current :: QItemSelectionModelSelectionFlags current = QItemSelectionModelSelectionFlags (16) deselect :: QItemSelectionModelSelectionFlags deselect = QItemSelectionModelSelectionFlags (4) noUpdate :: QItemSelectionModelSelectionFlags noUpdate = QItemSelectionModelSelectionFlags (0) rows :: QItemSelectionModelSelectionFlags rows = QItemSelectionModelSelectionFlags (32) select :: QItemSelectionModelSelectionFlags select = QItemSelectionModelSelectionFlags (2) selectCurrent :: QItemSelectionModelSelectionFlags selectCurrent = QItemSelectionModelSelectionFlags (18) toggle :: QItemSelectionModelSelectionFlags toggle = QItemSelectionModelSelectionFlags (8) toggleCurrent :: QItemSelectionModelSelectionFlags toggleCurrent = QItemSelectionModelSelectionFlags (24) instance QtahDB.Bits QItemSelectionModelSelectionFlags where x .&. y = QtahFlags.numToFlags (QtahFlags.flagsToNum x .&. QtahFlags.flagsToNum y) x .|. y = QtahFlags.numToFlags (QtahFlags.flagsToNum x .|. QtahFlags.flagsToNum y) xor x y = QtahFlags.numToFlags $ QtahDB.xor (QtahFlags.flagsToNum x) (QtahFlags.flagsToNum y) complement x = QtahFlags.numToFlags $ QtahDB.complement $ QtahFlags.flagsToNum x shift x i = QtahFlags.numToFlags $ QtahDB.shift (QtahFlags.flagsToNum x) i rotate x i = QtahFlags.numToFlags $ QtahDB.rotate (QtahFlags.flagsToNum x) i bitSize x = case QtahDB.bitSizeMaybe x of QtahP.Just n -> n QtahP.Nothing -> QtahP.error "bitSize is undefined" bitSizeMaybe = QtahDB.bitSizeMaybe . QtahFlags.flagsToNum isSigned = QtahDB.isSigned . QtahFlags.flagsToNum testBit x i = QtahDB.testBit (QtahFlags.flagsToNum x) i bit = QtahFlags.numToFlags . QtahDB.bit popCount = QtahDB.popCount . QtahFlags.flagsToNum