{- |
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 'GI.GObject.Structs.TypeValueTable.TypeValueTable' provides the functions required by the 'GI.GObject.Structs.Value.Value'
implementation, to serve as a container for values of a type.
-}

module GI.GObject.Structs.TypeValueTable
    ( 

-- * Exported types
    TypeValueTable(..)                      ,
    newZeroTypeValueTable                   ,
    noTypeValueTable                        ,


 -- * Properties
-- ** collectFormat #attr:collectFormat#
    clearTypeValueTableCollectFormat        ,
    getTypeValueTableCollectFormat          ,
    setTypeValueTableCollectFormat          ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeValueTable_collectFormat            ,
#endif


-- ** collectValue #attr:collectValue#
    clearTypeValueTableCollectValue         ,
    getTypeValueTableCollectValue           ,
    setTypeValueTableCollectValue           ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeValueTable_collectValue             ,
#endif


-- ** lcopyFormat #attr:lcopyFormat#
    clearTypeValueTableLcopyFormat          ,
    getTypeValueTableLcopyFormat            ,
    setTypeValueTableLcopyFormat            ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeValueTable_lcopyFormat              ,
#endif


-- ** lcopyValue #attr:lcopyValue#
    clearTypeValueTableLcopyValue           ,
    getTypeValueTableLcopyValue             ,
    setTypeValueTableLcopyValue             ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeValueTable_lcopyValue               ,
#endif


-- ** valueCopy #attr:valueCopy#
    clearTypeValueTableValueCopy            ,
    getTypeValueTableValueCopy              ,
    setTypeValueTableValueCopy              ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeValueTable_valueCopy                ,
#endif


-- ** valueFree #attr:valueFree#
    clearTypeValueTableValueFree            ,
    getTypeValueTableValueFree              ,
    setTypeValueTableValueFree              ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeValueTable_valueFree                ,
#endif


-- ** valueInit #attr:valueInit#
    clearTypeValueTableValueInit            ,
    getTypeValueTableValueInit              ,
    setTypeValueTableValueInit              ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeValueTable_valueInit                ,
#endif


-- ** valuePeekPointer #attr:valuePeekPointer#
    clearTypeValueTableValuePeekPointer     ,
    getTypeValueTableValuePeekPointer       ,
    setTypeValueTableValuePeekPointer       ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeValueTable_valuePeekPointer         ,
#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.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 GI.GObject.Callbacks as GObject.Callbacks

newtype TypeValueTable = TypeValueTable (ManagedPtr TypeValueTable)
instance WrappedPtr TypeValueTable where
    wrappedPtrCalloc = callocBytes 64
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 64 >=> wrapPtr TypeValueTable)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `TypeValueTable` struct initialized to zero.
newZeroTypeValueTable :: MonadIO m => m TypeValueTable
newZeroTypeValueTable = liftIO $ wrappedPtrCalloc >>= wrapPtr TypeValueTable

instance tag ~ 'AttrSet => Constructible TypeValueTable tag where
    new _ attrs = do
        o <- newZeroTypeValueTable
        GI.Attributes.set o attrs
        return o


noTypeValueTable :: Maybe TypeValueTable
noTypeValueTable = Nothing

getTypeValueTableValueInit :: MonadIO m => TypeValueTable -> m (Maybe GObject.Callbacks.TypeValueTableValueInitFieldCallback)
getTypeValueTableValueInit s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO (FunPtr GObject.Callbacks.C_TypeValueTableValueInitFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GObject.Callbacks.dynamic_TypeValueTableValueInitFieldCallback val'
        return val''
    return result

setTypeValueTableValueInit :: MonadIO m => TypeValueTable -> FunPtr GObject.Callbacks.C_TypeValueTableValueInitFieldCallback -> m ()
setTypeValueTableValueInit s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: FunPtr GObject.Callbacks.C_TypeValueTableValueInitFieldCallback)

clearTypeValueTableValueInit :: MonadIO m => TypeValueTable -> m ()
clearTypeValueTableValueInit s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullFunPtr :: FunPtr GObject.Callbacks.C_TypeValueTableValueInitFieldCallback)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeValueTableValueInitFieldInfo
instance AttrInfo TypeValueTableValueInitFieldInfo where
    type AttrAllowedOps TypeValueTableValueInitFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeValueTableValueInitFieldInfo = (~) (FunPtr GObject.Callbacks.C_TypeValueTableValueInitFieldCallback)
    type AttrBaseTypeConstraint TypeValueTableValueInitFieldInfo = (~) TypeValueTable
    type AttrGetType TypeValueTableValueInitFieldInfo = Maybe GObject.Callbacks.TypeValueTableValueInitFieldCallback
    type AttrLabel TypeValueTableValueInitFieldInfo = "value_init"
    type AttrOrigin TypeValueTableValueInitFieldInfo = TypeValueTable
    attrGet _ = getTypeValueTableValueInit
    attrSet _ = setTypeValueTableValueInit
    attrConstruct = undefined
    attrClear _ = clearTypeValueTableValueInit

typeValueTable_valueInit :: AttrLabelProxy "valueInit"
typeValueTable_valueInit = AttrLabelProxy

#endif


getTypeValueTableValueFree :: MonadIO m => TypeValueTable -> m (Maybe GObject.Callbacks.TypeValueTableValueFreeFieldCallback)
getTypeValueTableValueFree s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO (FunPtr GObject.Callbacks.C_TypeValueTableValueFreeFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GObject.Callbacks.dynamic_TypeValueTableValueFreeFieldCallback val'
        return val''
    return result

setTypeValueTableValueFree :: MonadIO m => TypeValueTable -> FunPtr GObject.Callbacks.C_TypeValueTableValueFreeFieldCallback -> m ()
setTypeValueTableValueFree s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: FunPtr GObject.Callbacks.C_TypeValueTableValueFreeFieldCallback)

clearTypeValueTableValueFree :: MonadIO m => TypeValueTable -> m ()
clearTypeValueTableValueFree s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (FP.nullFunPtr :: FunPtr GObject.Callbacks.C_TypeValueTableValueFreeFieldCallback)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeValueTableValueFreeFieldInfo
instance AttrInfo TypeValueTableValueFreeFieldInfo where
    type AttrAllowedOps TypeValueTableValueFreeFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeValueTableValueFreeFieldInfo = (~) (FunPtr GObject.Callbacks.C_TypeValueTableValueFreeFieldCallback)
    type AttrBaseTypeConstraint TypeValueTableValueFreeFieldInfo = (~) TypeValueTable
    type AttrGetType TypeValueTableValueFreeFieldInfo = Maybe GObject.Callbacks.TypeValueTableValueFreeFieldCallback
    type AttrLabel TypeValueTableValueFreeFieldInfo = "value_free"
    type AttrOrigin TypeValueTableValueFreeFieldInfo = TypeValueTable
    attrGet _ = getTypeValueTableValueFree
    attrSet _ = setTypeValueTableValueFree
    attrConstruct = undefined
    attrClear _ = clearTypeValueTableValueFree

typeValueTable_valueFree :: AttrLabelProxy "valueFree"
typeValueTable_valueFree = AttrLabelProxy

#endif


getTypeValueTableValueCopy :: MonadIO m => TypeValueTable -> m (Maybe GObject.Callbacks.TypeValueTableValueCopyFieldCallback)
getTypeValueTableValueCopy s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO (FunPtr GObject.Callbacks.C_TypeValueTableValueCopyFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GObject.Callbacks.dynamic_TypeValueTableValueCopyFieldCallback val'
        return val''
    return result

setTypeValueTableValueCopy :: MonadIO m => TypeValueTable -> FunPtr GObject.Callbacks.C_TypeValueTableValueCopyFieldCallback -> m ()
setTypeValueTableValueCopy s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: FunPtr GObject.Callbacks.C_TypeValueTableValueCopyFieldCallback)

clearTypeValueTableValueCopy :: MonadIO m => TypeValueTable -> m ()
clearTypeValueTableValueCopy s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (FP.nullFunPtr :: FunPtr GObject.Callbacks.C_TypeValueTableValueCopyFieldCallback)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeValueTableValueCopyFieldInfo
instance AttrInfo TypeValueTableValueCopyFieldInfo where
    type AttrAllowedOps TypeValueTableValueCopyFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeValueTableValueCopyFieldInfo = (~) (FunPtr GObject.Callbacks.C_TypeValueTableValueCopyFieldCallback)
    type AttrBaseTypeConstraint TypeValueTableValueCopyFieldInfo = (~) TypeValueTable
    type AttrGetType TypeValueTableValueCopyFieldInfo = Maybe GObject.Callbacks.TypeValueTableValueCopyFieldCallback
    type AttrLabel TypeValueTableValueCopyFieldInfo = "value_copy"
    type AttrOrigin TypeValueTableValueCopyFieldInfo = TypeValueTable
    attrGet _ = getTypeValueTableValueCopy
    attrSet _ = setTypeValueTableValueCopy
    attrConstruct = undefined
    attrClear _ = clearTypeValueTableValueCopy

typeValueTable_valueCopy :: AttrLabelProxy "valueCopy"
typeValueTable_valueCopy = AttrLabelProxy

#endif


getTypeValueTableValuePeekPointer :: MonadIO m => TypeValueTable -> m (Maybe GObject.Callbacks.TypeValueTableValuePeekPointerFieldCallback)
getTypeValueTableValuePeekPointer s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO (FunPtr GObject.Callbacks.C_TypeValueTableValuePeekPointerFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GObject.Callbacks.dynamic_TypeValueTableValuePeekPointerFieldCallback val'
        return val''
    return result

setTypeValueTableValuePeekPointer :: MonadIO m => TypeValueTable -> FunPtr GObject.Callbacks.C_TypeValueTableValuePeekPointerFieldCallback -> m ()
setTypeValueTableValuePeekPointer s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (val :: FunPtr GObject.Callbacks.C_TypeValueTableValuePeekPointerFieldCallback)

clearTypeValueTableValuePeekPointer :: MonadIO m => TypeValueTable -> m ()
clearTypeValueTableValuePeekPointer s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (FP.nullFunPtr :: FunPtr GObject.Callbacks.C_TypeValueTableValuePeekPointerFieldCallback)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeValueTableValuePeekPointerFieldInfo
instance AttrInfo TypeValueTableValuePeekPointerFieldInfo where
    type AttrAllowedOps TypeValueTableValuePeekPointerFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeValueTableValuePeekPointerFieldInfo = (~) (FunPtr GObject.Callbacks.C_TypeValueTableValuePeekPointerFieldCallback)
    type AttrBaseTypeConstraint TypeValueTableValuePeekPointerFieldInfo = (~) TypeValueTable
    type AttrGetType TypeValueTableValuePeekPointerFieldInfo = Maybe GObject.Callbacks.TypeValueTableValuePeekPointerFieldCallback
    type AttrLabel TypeValueTableValuePeekPointerFieldInfo = "value_peek_pointer"
    type AttrOrigin TypeValueTableValuePeekPointerFieldInfo = TypeValueTable
    attrGet _ = getTypeValueTableValuePeekPointer
    attrSet _ = setTypeValueTableValuePeekPointer
    attrConstruct = undefined
    attrClear _ = clearTypeValueTableValuePeekPointer

typeValueTable_valuePeekPointer :: AttrLabelProxy "valuePeekPointer"
typeValueTable_valuePeekPointer = AttrLabelProxy

#endif


getTypeValueTableCollectFormat :: MonadIO m => TypeValueTable -> m (Maybe T.Text)
getTypeValueTableCollectFormat s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 32) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setTypeValueTableCollectFormat :: MonadIO m => TypeValueTable -> CString -> m ()
setTypeValueTableCollectFormat s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 32) (val :: CString)

clearTypeValueTableCollectFormat :: MonadIO m => TypeValueTable -> m ()
clearTypeValueTableCollectFormat s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 32) (FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeValueTableCollectFormatFieldInfo
instance AttrInfo TypeValueTableCollectFormatFieldInfo where
    type AttrAllowedOps TypeValueTableCollectFormatFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeValueTableCollectFormatFieldInfo = (~) CString
    type AttrBaseTypeConstraint TypeValueTableCollectFormatFieldInfo = (~) TypeValueTable
    type AttrGetType TypeValueTableCollectFormatFieldInfo = Maybe T.Text
    type AttrLabel TypeValueTableCollectFormatFieldInfo = "collect_format"
    type AttrOrigin TypeValueTableCollectFormatFieldInfo = TypeValueTable
    attrGet _ = getTypeValueTableCollectFormat
    attrSet _ = setTypeValueTableCollectFormat
    attrConstruct = undefined
    attrClear _ = clearTypeValueTableCollectFormat

typeValueTable_collectFormat :: AttrLabelProxy "collectFormat"
typeValueTable_collectFormat = AttrLabelProxy

#endif


getTypeValueTableCollectValue :: MonadIO m => TypeValueTable -> m (Maybe GObject.Callbacks.TypeValueTableCollectValueFieldCallback)
getTypeValueTableCollectValue s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 40) :: IO (FunPtr GObject.Callbacks.C_TypeValueTableCollectValueFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GObject.Callbacks.dynamic_TypeValueTableCollectValueFieldCallback val'
        return val''
    return result

setTypeValueTableCollectValue :: MonadIO m => TypeValueTable -> FunPtr GObject.Callbacks.C_TypeValueTableCollectValueFieldCallback -> m ()
setTypeValueTableCollectValue s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 40) (val :: FunPtr GObject.Callbacks.C_TypeValueTableCollectValueFieldCallback)

clearTypeValueTableCollectValue :: MonadIO m => TypeValueTable -> m ()
clearTypeValueTableCollectValue s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 40) (FP.nullFunPtr :: FunPtr GObject.Callbacks.C_TypeValueTableCollectValueFieldCallback)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeValueTableCollectValueFieldInfo
instance AttrInfo TypeValueTableCollectValueFieldInfo where
    type AttrAllowedOps TypeValueTableCollectValueFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeValueTableCollectValueFieldInfo = (~) (FunPtr GObject.Callbacks.C_TypeValueTableCollectValueFieldCallback)
    type AttrBaseTypeConstraint TypeValueTableCollectValueFieldInfo = (~) TypeValueTable
    type AttrGetType TypeValueTableCollectValueFieldInfo = Maybe GObject.Callbacks.TypeValueTableCollectValueFieldCallback
    type AttrLabel TypeValueTableCollectValueFieldInfo = "collect_value"
    type AttrOrigin TypeValueTableCollectValueFieldInfo = TypeValueTable
    attrGet _ = getTypeValueTableCollectValue
    attrSet _ = setTypeValueTableCollectValue
    attrConstruct = undefined
    attrClear _ = clearTypeValueTableCollectValue

typeValueTable_collectValue :: AttrLabelProxy "collectValue"
typeValueTable_collectValue = AttrLabelProxy

#endif


getTypeValueTableLcopyFormat :: MonadIO m => TypeValueTable -> m (Maybe T.Text)
getTypeValueTableLcopyFormat s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 48) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setTypeValueTableLcopyFormat :: MonadIO m => TypeValueTable -> CString -> m ()
setTypeValueTableLcopyFormat s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 48) (val :: CString)

clearTypeValueTableLcopyFormat :: MonadIO m => TypeValueTable -> m ()
clearTypeValueTableLcopyFormat s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 48) (FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeValueTableLcopyFormatFieldInfo
instance AttrInfo TypeValueTableLcopyFormatFieldInfo where
    type AttrAllowedOps TypeValueTableLcopyFormatFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeValueTableLcopyFormatFieldInfo = (~) CString
    type AttrBaseTypeConstraint TypeValueTableLcopyFormatFieldInfo = (~) TypeValueTable
    type AttrGetType TypeValueTableLcopyFormatFieldInfo = Maybe T.Text
    type AttrLabel TypeValueTableLcopyFormatFieldInfo = "lcopy_format"
    type AttrOrigin TypeValueTableLcopyFormatFieldInfo = TypeValueTable
    attrGet _ = getTypeValueTableLcopyFormat
    attrSet _ = setTypeValueTableLcopyFormat
    attrConstruct = undefined
    attrClear _ = clearTypeValueTableLcopyFormat

typeValueTable_lcopyFormat :: AttrLabelProxy "lcopyFormat"
typeValueTable_lcopyFormat = AttrLabelProxy

#endif


getTypeValueTableLcopyValue :: MonadIO m => TypeValueTable -> m (Maybe GObject.Callbacks.TypeValueTableLcopyValueFieldCallback)
getTypeValueTableLcopyValue s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 56) :: IO (FunPtr GObject.Callbacks.C_TypeValueTableLcopyValueFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GObject.Callbacks.dynamic_TypeValueTableLcopyValueFieldCallback val'
        return val''
    return result

setTypeValueTableLcopyValue :: MonadIO m => TypeValueTable -> FunPtr GObject.Callbacks.C_TypeValueTableLcopyValueFieldCallback -> m ()
setTypeValueTableLcopyValue s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 56) (val :: FunPtr GObject.Callbacks.C_TypeValueTableLcopyValueFieldCallback)

clearTypeValueTableLcopyValue :: MonadIO m => TypeValueTable -> m ()
clearTypeValueTableLcopyValue s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 56) (FP.nullFunPtr :: FunPtr GObject.Callbacks.C_TypeValueTableLcopyValueFieldCallback)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeValueTableLcopyValueFieldInfo
instance AttrInfo TypeValueTableLcopyValueFieldInfo where
    type AttrAllowedOps TypeValueTableLcopyValueFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeValueTableLcopyValueFieldInfo = (~) (FunPtr GObject.Callbacks.C_TypeValueTableLcopyValueFieldCallback)
    type AttrBaseTypeConstraint TypeValueTableLcopyValueFieldInfo = (~) TypeValueTable
    type AttrGetType TypeValueTableLcopyValueFieldInfo = Maybe GObject.Callbacks.TypeValueTableLcopyValueFieldCallback
    type AttrLabel TypeValueTableLcopyValueFieldInfo = "lcopy_value"
    type AttrOrigin TypeValueTableLcopyValueFieldInfo = TypeValueTable
    attrGet _ = getTypeValueTableLcopyValue
    attrSet _ = setTypeValueTableLcopyValue
    attrConstruct = undefined
    attrClear _ = clearTypeValueTableLcopyValue

typeValueTable_lcopyValue :: AttrLabelProxy "lcopyValue"
typeValueTable_lcopyValue = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList TypeValueTable
type instance O.AttributeList TypeValueTable = TypeValueTableAttributeList
type TypeValueTableAttributeList = ('[ '("valueInit", TypeValueTableValueInitFieldInfo), '("valueFree", TypeValueTableValueFreeFieldInfo), '("valueCopy", TypeValueTableValueCopyFieldInfo), '("valuePeekPointer", TypeValueTableValuePeekPointerFieldInfo), '("collectFormat", TypeValueTableCollectFormatFieldInfo), '("collectValue", TypeValueTableCollectValueFieldInfo), '("lcopyFormat", TypeValueTableLcopyFormatFieldInfo), '("lcopyValue", TypeValueTableLcopyValueFieldInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
type family ResolveTypeValueTableMethod (t :: Symbol) (o :: *) :: * where
    ResolveTypeValueTableMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveTypeValueTableMethod t TypeValueTable, O.MethodInfo info TypeValueTable p) => O.IsLabelProxy t (TypeValueTable -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveTypeValueTableMethod t TypeValueTable, O.MethodInfo info TypeValueTable p) => O.IsLabel t (TypeValueTable -> 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

#endif