#define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \
&& !defined(__HADDOCK_VERSION__))
module GI.Gtk.Structs.TableRowCol
(
TableRowCol(..) ,
newZeroTableRowCol ,
noTableRowCol ,
getTableRowColAllocation ,
setTableRowColAllocation ,
#if ENABLE_OVERLOADING
tableRowCol_allocation ,
#endif
getTableRowColEmpty ,
setTableRowColEmpty ,
#if ENABLE_OVERLOADING
tableRowCol_empty ,
#endif
getTableRowColExpand ,
setTableRowColExpand ,
#if ENABLE_OVERLOADING
tableRowCol_expand ,
#endif
getTableRowColNeedExpand ,
setTableRowColNeedExpand ,
#if ENABLE_OVERLOADING
tableRowCol_needExpand ,
#endif
getTableRowColNeedShrink ,
setTableRowColNeedShrink ,
#if ENABLE_OVERLOADING
tableRowCol_needShrink ,
#endif
getTableRowColRequisition ,
setTableRowColRequisition ,
#if ENABLE_OVERLOADING
tableRowCol_requisition ,
#endif
getTableRowColShrink ,
setTableRowColShrink ,
#if ENABLE_OVERLOADING
tableRowCol_shrink ,
#endif
getTableRowColSpacing ,
setTableRowColSpacing ,
#if ENABLE_OVERLOADING
tableRowCol_spacing ,
#endif
) where
import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P
import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
newtype TableRowCol = TableRowCol (ManagedPtr TableRowCol)
instance WrappedPtr TableRowCol where
wrappedPtrCalloc = callocBytes 28
wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 28 >=> wrapPtr TableRowCol)
wrappedPtrFree = Just ptr_to_g_free
newZeroTableRowCol :: MonadIO m => m TableRowCol
newZeroTableRowCol = liftIO $ wrappedPtrCalloc >>= wrapPtr TableRowCol
instance tag ~ 'AttrSet => Constructible TableRowCol tag where
new _ attrs = do
o <- newZeroTableRowCol
GI.Attributes.set o attrs
return o
noTableRowCol :: Maybe TableRowCol
noTableRowCol = Nothing
getTableRowColRequisition :: MonadIO m => TableRowCol -> m Word16
getTableRowColRequisition s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 0) :: IO Word16
return val
setTableRowColRequisition :: MonadIO m => TableRowCol -> Word16 -> m ()
setTableRowColRequisition s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 0) (val :: Word16)
#if ENABLE_OVERLOADING
data TableRowColRequisitionFieldInfo
instance AttrInfo TableRowColRequisitionFieldInfo where
type AttrAllowedOps TableRowColRequisitionFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint TableRowColRequisitionFieldInfo = (~) Word16
type AttrBaseTypeConstraint TableRowColRequisitionFieldInfo = (~) TableRowCol
type AttrGetType TableRowColRequisitionFieldInfo = Word16
type AttrLabel TableRowColRequisitionFieldInfo = "requisition"
type AttrOrigin TableRowColRequisitionFieldInfo = TableRowCol
attrGet _ = getTableRowColRequisition
attrSet _ = setTableRowColRequisition
attrConstruct = undefined
attrClear _ = undefined
tableRowCol_requisition :: AttrLabelProxy "requisition"
tableRowCol_requisition = AttrLabelProxy
#endif
getTableRowColAllocation :: MonadIO m => TableRowCol -> m Word16
getTableRowColAllocation s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 2) :: IO Word16
return val
setTableRowColAllocation :: MonadIO m => TableRowCol -> Word16 -> m ()
setTableRowColAllocation s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 2) (val :: Word16)
#if ENABLE_OVERLOADING
data TableRowColAllocationFieldInfo
instance AttrInfo TableRowColAllocationFieldInfo where
type AttrAllowedOps TableRowColAllocationFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint TableRowColAllocationFieldInfo = (~) Word16
type AttrBaseTypeConstraint TableRowColAllocationFieldInfo = (~) TableRowCol
type AttrGetType TableRowColAllocationFieldInfo = Word16
type AttrLabel TableRowColAllocationFieldInfo = "allocation"
type AttrOrigin TableRowColAllocationFieldInfo = TableRowCol
attrGet _ = getTableRowColAllocation
attrSet _ = setTableRowColAllocation
attrConstruct = undefined
attrClear _ = undefined
tableRowCol_allocation :: AttrLabelProxy "allocation"
tableRowCol_allocation = AttrLabelProxy
#endif
getTableRowColSpacing :: MonadIO m => TableRowCol -> m Word16
getTableRowColSpacing s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 4) :: IO Word16
return val
setTableRowColSpacing :: MonadIO m => TableRowCol -> Word16 -> m ()
setTableRowColSpacing s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 4) (val :: Word16)
#if ENABLE_OVERLOADING
data TableRowColSpacingFieldInfo
instance AttrInfo TableRowColSpacingFieldInfo where
type AttrAllowedOps TableRowColSpacingFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint TableRowColSpacingFieldInfo = (~) Word16
type AttrBaseTypeConstraint TableRowColSpacingFieldInfo = (~) TableRowCol
type AttrGetType TableRowColSpacingFieldInfo = Word16
type AttrLabel TableRowColSpacingFieldInfo = "spacing"
type AttrOrigin TableRowColSpacingFieldInfo = TableRowCol
attrGet _ = getTableRowColSpacing
attrSet _ = setTableRowColSpacing
attrConstruct = undefined
attrClear _ = undefined
tableRowCol_spacing :: AttrLabelProxy "spacing"
tableRowCol_spacing = AttrLabelProxy
#endif
getTableRowColNeedExpand :: MonadIO m => TableRowCol -> m Word32
getTableRowColNeedExpand s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 8) :: IO Word32
return val
setTableRowColNeedExpand :: MonadIO m => TableRowCol -> Word32 -> m ()
setTableRowColNeedExpand s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 8) (val :: Word32)
#if ENABLE_OVERLOADING
data TableRowColNeedExpandFieldInfo
instance AttrInfo TableRowColNeedExpandFieldInfo where
type AttrAllowedOps TableRowColNeedExpandFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint TableRowColNeedExpandFieldInfo = (~) Word32
type AttrBaseTypeConstraint TableRowColNeedExpandFieldInfo = (~) TableRowCol
type AttrGetType TableRowColNeedExpandFieldInfo = Word32
type AttrLabel TableRowColNeedExpandFieldInfo = "need_expand"
type AttrOrigin TableRowColNeedExpandFieldInfo = TableRowCol
attrGet _ = getTableRowColNeedExpand
attrSet _ = setTableRowColNeedExpand
attrConstruct = undefined
attrClear _ = undefined
tableRowCol_needExpand :: AttrLabelProxy "needExpand"
tableRowCol_needExpand = AttrLabelProxy
#endif
getTableRowColNeedShrink :: MonadIO m => TableRowCol -> m Word32
getTableRowColNeedShrink s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 12) :: IO Word32
return val
setTableRowColNeedShrink :: MonadIO m => TableRowCol -> Word32 -> m ()
setTableRowColNeedShrink s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 12) (val :: Word32)
#if ENABLE_OVERLOADING
data TableRowColNeedShrinkFieldInfo
instance AttrInfo TableRowColNeedShrinkFieldInfo where
type AttrAllowedOps TableRowColNeedShrinkFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint TableRowColNeedShrinkFieldInfo = (~) Word32
type AttrBaseTypeConstraint TableRowColNeedShrinkFieldInfo = (~) TableRowCol
type AttrGetType TableRowColNeedShrinkFieldInfo = Word32
type AttrLabel TableRowColNeedShrinkFieldInfo = "need_shrink"
type AttrOrigin TableRowColNeedShrinkFieldInfo = TableRowCol
attrGet _ = getTableRowColNeedShrink
attrSet _ = setTableRowColNeedShrink
attrConstruct = undefined
attrClear _ = undefined
tableRowCol_needShrink :: AttrLabelProxy "needShrink"
tableRowCol_needShrink = AttrLabelProxy
#endif
getTableRowColExpand :: MonadIO m => TableRowCol -> m Word32
getTableRowColExpand s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 16) :: IO Word32
return val
setTableRowColExpand :: MonadIO m => TableRowCol -> Word32 -> m ()
setTableRowColExpand s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 16) (val :: Word32)
#if ENABLE_OVERLOADING
data TableRowColExpandFieldInfo
instance AttrInfo TableRowColExpandFieldInfo where
type AttrAllowedOps TableRowColExpandFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint TableRowColExpandFieldInfo = (~) Word32
type AttrBaseTypeConstraint TableRowColExpandFieldInfo = (~) TableRowCol
type AttrGetType TableRowColExpandFieldInfo = Word32
type AttrLabel TableRowColExpandFieldInfo = "expand"
type AttrOrigin TableRowColExpandFieldInfo = TableRowCol
attrGet _ = getTableRowColExpand
attrSet _ = setTableRowColExpand
attrConstruct = undefined
attrClear _ = undefined
tableRowCol_expand :: AttrLabelProxy "expand"
tableRowCol_expand = AttrLabelProxy
#endif
getTableRowColShrink :: MonadIO m => TableRowCol -> m Word32
getTableRowColShrink s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 20) :: IO Word32
return val
setTableRowColShrink :: MonadIO m => TableRowCol -> Word32 -> m ()
setTableRowColShrink s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 20) (val :: Word32)
#if ENABLE_OVERLOADING
data TableRowColShrinkFieldInfo
instance AttrInfo TableRowColShrinkFieldInfo where
type AttrAllowedOps TableRowColShrinkFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint TableRowColShrinkFieldInfo = (~) Word32
type AttrBaseTypeConstraint TableRowColShrinkFieldInfo = (~) TableRowCol
type AttrGetType TableRowColShrinkFieldInfo = Word32
type AttrLabel TableRowColShrinkFieldInfo = "shrink"
type AttrOrigin TableRowColShrinkFieldInfo = TableRowCol
attrGet _ = getTableRowColShrink
attrSet _ = setTableRowColShrink
attrConstruct = undefined
attrClear _ = undefined
tableRowCol_shrink :: AttrLabelProxy "shrink"
tableRowCol_shrink = AttrLabelProxy
#endif
getTableRowColEmpty :: MonadIO m => TableRowCol -> m Word32
getTableRowColEmpty s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 24) :: IO Word32
return val
setTableRowColEmpty :: MonadIO m => TableRowCol -> Word32 -> m ()
setTableRowColEmpty s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 24) (val :: Word32)
#if ENABLE_OVERLOADING
data TableRowColEmptyFieldInfo
instance AttrInfo TableRowColEmptyFieldInfo where
type AttrAllowedOps TableRowColEmptyFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint TableRowColEmptyFieldInfo = (~) Word32
type AttrBaseTypeConstraint TableRowColEmptyFieldInfo = (~) TableRowCol
type AttrGetType TableRowColEmptyFieldInfo = Word32
type AttrLabel TableRowColEmptyFieldInfo = "empty"
type AttrOrigin TableRowColEmptyFieldInfo = TableRowCol
attrGet _ = getTableRowColEmpty
attrSet _ = setTableRowColEmpty
attrConstruct = undefined
attrClear _ = undefined
tableRowCol_empty :: AttrLabelProxy "empty"
tableRowCol_empty = AttrLabelProxy
#endif
#if ENABLE_OVERLOADING
instance O.HasAttributeList TableRowCol
type instance O.AttributeList TableRowCol = TableRowColAttributeList
type TableRowColAttributeList = ('[ '("requisition", TableRowColRequisitionFieldInfo), '("allocation", TableRowColAllocationFieldInfo), '("spacing", TableRowColSpacingFieldInfo), '("needExpand", TableRowColNeedExpandFieldInfo), '("needShrink", TableRowColNeedShrinkFieldInfo), '("expand", TableRowColExpandFieldInfo), '("shrink", TableRowColShrinkFieldInfo), '("empty", TableRowColEmptyFieldInfo)] :: [(Symbol, *)])
#endif
#if ENABLE_OVERLOADING
type family ResolveTableRowColMethod (t :: Symbol) (o :: *) :: * where
ResolveTableRowColMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveTableRowColMethod t TableRowCol, O.MethodInfo info TableRowCol p) => OL.IsLabel t (TableRowCol -> p) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#else
fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif
#endif