{- | Copyright : Will Thompson, Iñaki García Etxebarria and Jonas Platte License : LGPL-2.1 Maintainer : Iñaki García Etxebarria (inaki@blueleaf.cc) /No description available in the introspection data./ -} #define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \ && !defined(__HADDOCK_VERSION__)) module GI.Gtk.Structs.TableRowCol ( -- * Exported types TableRowCol(..) , newZeroTableRowCol , noTableRowCol , -- * Properties -- ** allocation #attr:allocation# {- | /No description available in the introspection data./ -} getTableRowColAllocation , setTableRowColAllocation , #if ENABLE_OVERLOADING tableRowCol_allocation , #endif -- ** empty #attr:empty# {- | /No description available in the introspection data./ -} getTableRowColEmpty , setTableRowColEmpty , #if ENABLE_OVERLOADING tableRowCol_empty , #endif -- ** expand #attr:expand# {- | /No description available in the introspection data./ -} getTableRowColExpand , setTableRowColExpand , #if ENABLE_OVERLOADING tableRowCol_expand , #endif -- ** needExpand #attr:needExpand# {- | /No description available in the introspection data./ -} getTableRowColNeedExpand , setTableRowColNeedExpand , #if ENABLE_OVERLOADING tableRowCol_needExpand , #endif -- ** needShrink #attr:needShrink# {- | /No description available in the introspection data./ -} getTableRowColNeedShrink , setTableRowColNeedShrink , #if ENABLE_OVERLOADING tableRowCol_needShrink , #endif -- ** requisition #attr:requisition# {- | /No description available in the introspection data./ -} getTableRowColRequisition , setTableRowColRequisition , #if ENABLE_OVERLOADING tableRowCol_requisition , #endif -- ** shrink #attr:shrink# {- | /No description available in the introspection data./ -} getTableRowColShrink , setTableRowColShrink , #if ENABLE_OVERLOADING tableRowCol_shrink , #endif -- ** spacing #attr:spacing# {- | /No description available in the introspection data./ -} 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 -- | Memory-managed wrapper type. 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 -- | Construct a `TableRowCol` struct initialized to zero. 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 -- | A convenience alias for `Nothing` :: `Maybe` `TableRowCol`. noTableRowCol :: Maybe TableRowCol noTableRowCol = Nothing {- | Get the value of the “@requisition@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' tableRowCol #requisition @ -} getTableRowColRequisition :: MonadIO m => TableRowCol -> m Word16 getTableRowColRequisition s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 0) :: IO Word16 return val {- | Set the value of the “@requisition@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' tableRowCol [ #requisition 'Data.GI.Base.Attributes.:=' value ] @ -} 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 {- | Get the value of the “@allocation@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' tableRowCol #allocation @ -} getTableRowColAllocation :: MonadIO m => TableRowCol -> m Word16 getTableRowColAllocation s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 2) :: IO Word16 return val {- | Set the value of the “@allocation@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' tableRowCol [ #allocation 'Data.GI.Base.Attributes.:=' value ] @ -} 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 {- | Get the value of the “@spacing@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' tableRowCol #spacing @ -} getTableRowColSpacing :: MonadIO m => TableRowCol -> m Word16 getTableRowColSpacing s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 4) :: IO Word16 return val {- | Set the value of the “@spacing@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' tableRowCol [ #spacing 'Data.GI.Base.Attributes.:=' value ] @ -} 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 {- | Get the value of the “@need_expand@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' tableRowCol #needExpand @ -} getTableRowColNeedExpand :: MonadIO m => TableRowCol -> m Word32 getTableRowColNeedExpand s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 8) :: IO Word32 return val {- | Set the value of the “@need_expand@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' tableRowCol [ #needExpand 'Data.GI.Base.Attributes.:=' value ] @ -} 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 {- | Get the value of the “@need_shrink@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' tableRowCol #needShrink @ -} getTableRowColNeedShrink :: MonadIO m => TableRowCol -> m Word32 getTableRowColNeedShrink s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 12) :: IO Word32 return val {- | Set the value of the “@need_shrink@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' tableRowCol [ #needShrink 'Data.GI.Base.Attributes.:=' value ] @ -} 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 {- | Get the value of the “@expand@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' tableRowCol #expand @ -} getTableRowColExpand :: MonadIO m => TableRowCol -> m Word32 getTableRowColExpand s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 16) :: IO Word32 return val {- | Set the value of the “@expand@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' tableRowCol [ #expand 'Data.GI.Base.Attributes.:=' value ] @ -} 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 {- | Get the value of the “@shrink@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' tableRowCol #shrink @ -} getTableRowColShrink :: MonadIO m => TableRowCol -> m Word32 getTableRowColShrink s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 20) :: IO Word32 return val {- | Set the value of the “@shrink@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' tableRowCol [ #shrink 'Data.GI.Base.Attributes.:=' value ] @ -} 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 {- | Get the value of the “@empty@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.get' tableRowCol #empty @ -} getTableRowColEmpty :: MonadIO m => TableRowCol -> m Word32 getTableRowColEmpty s = liftIO $ withManagedPtr s $ \ptr -> do val <- peek (ptr `plusPtr` 24) :: IO Word32 return val {- | Set the value of the “@empty@” field. When is enabled, this is equivalent to @ 'Data.GI.Base.Attributes.set' tableRowCol [ #empty 'Data.GI.Base.Attributes.:=' value ] @ -} 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