{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

A table of functions used to handle different types of 'GI.GLib.Structs.IOChannel.IOChannel'
in a generic way.
-}

module GI.GLib.Structs.IOFuncs
    ( 

-- * Exported types
    IOFuncs(..)                             ,
    newZeroIOFuncs                          ,
    noIOFuncs                               ,


 -- * Properties
-- ** ioClose #attr:ioClose#
    clearIOFuncsIoClose                     ,
    getIOFuncsIoClose                       ,
#ifdef ENABLE_OVERLOADING
    iOFuncs_ioClose                         ,
#endif
    setIOFuncsIoClose                       ,


-- ** ioCreateWatch #attr:ioCreateWatch#
    clearIOFuncsIoCreateWatch               ,
    getIOFuncsIoCreateWatch                 ,
#ifdef ENABLE_OVERLOADING
    iOFuncs_ioCreateWatch                   ,
#endif
    setIOFuncsIoCreateWatch                 ,


-- ** ioFree #attr:ioFree#
    clearIOFuncsIoFree                      ,
    getIOFuncsIoFree                        ,
#ifdef ENABLE_OVERLOADING
    iOFuncs_ioFree                          ,
#endif
    setIOFuncsIoFree                        ,


-- ** ioGetFlags #attr:ioGetFlags#
    clearIOFuncsIoGetFlags                  ,
    getIOFuncsIoGetFlags                    ,
#ifdef ENABLE_OVERLOADING
    iOFuncs_ioGetFlags                      ,
#endif
    setIOFuncsIoGetFlags                    ,


-- ** ioRead #attr:ioRead#
    clearIOFuncsIoRead                      ,
    getIOFuncsIoRead                        ,
#ifdef ENABLE_OVERLOADING
    iOFuncs_ioRead                          ,
#endif
    setIOFuncsIoRead                        ,


-- ** ioSeek #attr:ioSeek#
    clearIOFuncsIoSeek                      ,
    getIOFuncsIoSeek                        ,
#ifdef ENABLE_OVERLOADING
    iOFuncs_ioSeek                          ,
#endif
    setIOFuncsIoSeek                        ,


-- ** ioSetFlags #attr:ioSetFlags#
    clearIOFuncsIoSetFlags                  ,
    getIOFuncsIoSetFlags                    ,
#ifdef ENABLE_OVERLOADING
    iOFuncs_ioSetFlags                      ,
#endif
    setIOFuncsIoSetFlags                    ,


-- ** ioWrite #attr:ioWrite#
    clearIOFuncsIoWrite                     ,
    getIOFuncsIoWrite                       ,
#ifdef ENABLE_OVERLOADING
    iOFuncs_ioWrite                         ,
#endif
    setIOFuncsIoWrite                       ,




    ) 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.GLib.Callbacks as GLib.Callbacks

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

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

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


noIOFuncs :: Maybe IOFuncs
noIOFuncs = Nothing

getIOFuncsIoRead :: MonadIO m => IOFuncs -> m (Maybe GLib.Callbacks.IOFuncsIoReadFieldCallback)
getIOFuncsIoRead s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO (FunPtr GLib.Callbacks.C_IOFuncsIoReadFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GLib.Callbacks.dynamic_IOFuncsIoReadFieldCallback val'
        return val''
    return result

setIOFuncsIoRead :: MonadIO m => IOFuncs -> FunPtr GLib.Callbacks.C_IOFuncsIoReadFieldCallback -> m ()
setIOFuncsIoRead s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: FunPtr GLib.Callbacks.C_IOFuncsIoReadFieldCallback)

clearIOFuncsIoRead :: MonadIO m => IOFuncs -> m ()
clearIOFuncsIoRead s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullFunPtr :: FunPtr GLib.Callbacks.C_IOFuncsIoReadFieldCallback)

#ifdef ENABLE_OVERLOADING
data IOFuncsIoReadFieldInfo
instance AttrInfo IOFuncsIoReadFieldInfo where
    type AttrAllowedOps IOFuncsIoReadFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IOFuncsIoReadFieldInfo = (~) (FunPtr GLib.Callbacks.C_IOFuncsIoReadFieldCallback)
    type AttrBaseTypeConstraint IOFuncsIoReadFieldInfo = (~) IOFuncs
    type AttrGetType IOFuncsIoReadFieldInfo = Maybe GLib.Callbacks.IOFuncsIoReadFieldCallback
    type AttrLabel IOFuncsIoReadFieldInfo = "io_read"
    type AttrOrigin IOFuncsIoReadFieldInfo = IOFuncs
    attrGet _ = getIOFuncsIoRead
    attrSet _ = setIOFuncsIoRead
    attrConstruct = undefined
    attrClear _ = clearIOFuncsIoRead

iOFuncs_ioRead :: AttrLabelProxy "ioRead"
iOFuncs_ioRead = AttrLabelProxy

#endif


getIOFuncsIoWrite :: MonadIO m => IOFuncs -> m (Maybe GLib.Callbacks.IOFuncsIoWriteFieldCallback)
getIOFuncsIoWrite s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO (FunPtr GLib.Callbacks.C_IOFuncsIoWriteFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GLib.Callbacks.dynamic_IOFuncsIoWriteFieldCallback val'
        return val''
    return result

setIOFuncsIoWrite :: MonadIO m => IOFuncs -> FunPtr GLib.Callbacks.C_IOFuncsIoWriteFieldCallback -> m ()
setIOFuncsIoWrite s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: FunPtr GLib.Callbacks.C_IOFuncsIoWriteFieldCallback)

clearIOFuncsIoWrite :: MonadIO m => IOFuncs -> m ()
clearIOFuncsIoWrite s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (FP.nullFunPtr :: FunPtr GLib.Callbacks.C_IOFuncsIoWriteFieldCallback)

#ifdef ENABLE_OVERLOADING
data IOFuncsIoWriteFieldInfo
instance AttrInfo IOFuncsIoWriteFieldInfo where
    type AttrAllowedOps IOFuncsIoWriteFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IOFuncsIoWriteFieldInfo = (~) (FunPtr GLib.Callbacks.C_IOFuncsIoWriteFieldCallback)
    type AttrBaseTypeConstraint IOFuncsIoWriteFieldInfo = (~) IOFuncs
    type AttrGetType IOFuncsIoWriteFieldInfo = Maybe GLib.Callbacks.IOFuncsIoWriteFieldCallback
    type AttrLabel IOFuncsIoWriteFieldInfo = "io_write"
    type AttrOrigin IOFuncsIoWriteFieldInfo = IOFuncs
    attrGet _ = getIOFuncsIoWrite
    attrSet _ = setIOFuncsIoWrite
    attrConstruct = undefined
    attrClear _ = clearIOFuncsIoWrite

iOFuncs_ioWrite :: AttrLabelProxy "ioWrite"
iOFuncs_ioWrite = AttrLabelProxy

#endif


getIOFuncsIoSeek :: MonadIO m => IOFuncs -> m (Maybe GLib.Callbacks.IOFuncsIoSeekFieldCallback)
getIOFuncsIoSeek s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO (FunPtr GLib.Callbacks.C_IOFuncsIoSeekFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GLib.Callbacks.dynamic_IOFuncsIoSeekFieldCallback val'
        return val''
    return result

setIOFuncsIoSeek :: MonadIO m => IOFuncs -> FunPtr GLib.Callbacks.C_IOFuncsIoSeekFieldCallback -> m ()
setIOFuncsIoSeek s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: FunPtr GLib.Callbacks.C_IOFuncsIoSeekFieldCallback)

clearIOFuncsIoSeek :: MonadIO m => IOFuncs -> m ()
clearIOFuncsIoSeek s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (FP.nullFunPtr :: FunPtr GLib.Callbacks.C_IOFuncsIoSeekFieldCallback)

#ifdef ENABLE_OVERLOADING
data IOFuncsIoSeekFieldInfo
instance AttrInfo IOFuncsIoSeekFieldInfo where
    type AttrAllowedOps IOFuncsIoSeekFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IOFuncsIoSeekFieldInfo = (~) (FunPtr GLib.Callbacks.C_IOFuncsIoSeekFieldCallback)
    type AttrBaseTypeConstraint IOFuncsIoSeekFieldInfo = (~) IOFuncs
    type AttrGetType IOFuncsIoSeekFieldInfo = Maybe GLib.Callbacks.IOFuncsIoSeekFieldCallback
    type AttrLabel IOFuncsIoSeekFieldInfo = "io_seek"
    type AttrOrigin IOFuncsIoSeekFieldInfo = IOFuncs
    attrGet _ = getIOFuncsIoSeek
    attrSet _ = setIOFuncsIoSeek
    attrConstruct = undefined
    attrClear _ = clearIOFuncsIoSeek

iOFuncs_ioSeek :: AttrLabelProxy "ioSeek"
iOFuncs_ioSeek = AttrLabelProxy

#endif


getIOFuncsIoClose :: MonadIO m => IOFuncs -> m (Maybe GLib.Callbacks.IOFuncsIoCloseFieldCallback)
getIOFuncsIoClose s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO (FunPtr GLib.Callbacks.C_IOFuncsIoCloseFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GLib.Callbacks.dynamic_IOFuncsIoCloseFieldCallback val'
        return val''
    return result

setIOFuncsIoClose :: MonadIO m => IOFuncs -> FunPtr GLib.Callbacks.C_IOFuncsIoCloseFieldCallback -> m ()
setIOFuncsIoClose s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (val :: FunPtr GLib.Callbacks.C_IOFuncsIoCloseFieldCallback)

clearIOFuncsIoClose :: MonadIO m => IOFuncs -> m ()
clearIOFuncsIoClose s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (FP.nullFunPtr :: FunPtr GLib.Callbacks.C_IOFuncsIoCloseFieldCallback)

#ifdef ENABLE_OVERLOADING
data IOFuncsIoCloseFieldInfo
instance AttrInfo IOFuncsIoCloseFieldInfo where
    type AttrAllowedOps IOFuncsIoCloseFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IOFuncsIoCloseFieldInfo = (~) (FunPtr GLib.Callbacks.C_IOFuncsIoCloseFieldCallback)
    type AttrBaseTypeConstraint IOFuncsIoCloseFieldInfo = (~) IOFuncs
    type AttrGetType IOFuncsIoCloseFieldInfo = Maybe GLib.Callbacks.IOFuncsIoCloseFieldCallback
    type AttrLabel IOFuncsIoCloseFieldInfo = "io_close"
    type AttrOrigin IOFuncsIoCloseFieldInfo = IOFuncs
    attrGet _ = getIOFuncsIoClose
    attrSet _ = setIOFuncsIoClose
    attrConstruct = undefined
    attrClear _ = clearIOFuncsIoClose

iOFuncs_ioClose :: AttrLabelProxy "ioClose"
iOFuncs_ioClose = AttrLabelProxy

#endif


getIOFuncsIoCreateWatch :: MonadIO m => IOFuncs -> m (Maybe GLib.Callbacks.IOFuncsIoCreateWatchFieldCallback)
getIOFuncsIoCreateWatch s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 32) :: IO (FunPtr GLib.Callbacks.C_IOFuncsIoCreateWatchFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GLib.Callbacks.dynamic_IOFuncsIoCreateWatchFieldCallback val'
        return val''
    return result

setIOFuncsIoCreateWatch :: MonadIO m => IOFuncs -> FunPtr GLib.Callbacks.C_IOFuncsIoCreateWatchFieldCallback -> m ()
setIOFuncsIoCreateWatch s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 32) (val :: FunPtr GLib.Callbacks.C_IOFuncsIoCreateWatchFieldCallback)

clearIOFuncsIoCreateWatch :: MonadIO m => IOFuncs -> m ()
clearIOFuncsIoCreateWatch s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 32) (FP.nullFunPtr :: FunPtr GLib.Callbacks.C_IOFuncsIoCreateWatchFieldCallback)

#ifdef ENABLE_OVERLOADING
data IOFuncsIoCreateWatchFieldInfo
instance AttrInfo IOFuncsIoCreateWatchFieldInfo where
    type AttrAllowedOps IOFuncsIoCreateWatchFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IOFuncsIoCreateWatchFieldInfo = (~) (FunPtr GLib.Callbacks.C_IOFuncsIoCreateWatchFieldCallback)
    type AttrBaseTypeConstraint IOFuncsIoCreateWatchFieldInfo = (~) IOFuncs
    type AttrGetType IOFuncsIoCreateWatchFieldInfo = Maybe GLib.Callbacks.IOFuncsIoCreateWatchFieldCallback
    type AttrLabel IOFuncsIoCreateWatchFieldInfo = "io_create_watch"
    type AttrOrigin IOFuncsIoCreateWatchFieldInfo = IOFuncs
    attrGet _ = getIOFuncsIoCreateWatch
    attrSet _ = setIOFuncsIoCreateWatch
    attrConstruct = undefined
    attrClear _ = clearIOFuncsIoCreateWatch

iOFuncs_ioCreateWatch :: AttrLabelProxy "ioCreateWatch"
iOFuncs_ioCreateWatch = AttrLabelProxy

#endif


getIOFuncsIoFree :: MonadIO m => IOFuncs -> m (Maybe GLib.Callbacks.IOFuncsIoFreeFieldCallback)
getIOFuncsIoFree s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 40) :: IO (FunPtr GLib.Callbacks.C_IOFuncsIoFreeFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GLib.Callbacks.dynamic_IOFuncsIoFreeFieldCallback val'
        return val''
    return result

setIOFuncsIoFree :: MonadIO m => IOFuncs -> FunPtr GLib.Callbacks.C_IOFuncsIoFreeFieldCallback -> m ()
setIOFuncsIoFree s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 40) (val :: FunPtr GLib.Callbacks.C_IOFuncsIoFreeFieldCallback)

clearIOFuncsIoFree :: MonadIO m => IOFuncs -> m ()
clearIOFuncsIoFree s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 40) (FP.nullFunPtr :: FunPtr GLib.Callbacks.C_IOFuncsIoFreeFieldCallback)

#ifdef ENABLE_OVERLOADING
data IOFuncsIoFreeFieldInfo
instance AttrInfo IOFuncsIoFreeFieldInfo where
    type AttrAllowedOps IOFuncsIoFreeFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IOFuncsIoFreeFieldInfo = (~) (FunPtr GLib.Callbacks.C_IOFuncsIoFreeFieldCallback)
    type AttrBaseTypeConstraint IOFuncsIoFreeFieldInfo = (~) IOFuncs
    type AttrGetType IOFuncsIoFreeFieldInfo = Maybe GLib.Callbacks.IOFuncsIoFreeFieldCallback
    type AttrLabel IOFuncsIoFreeFieldInfo = "io_free"
    type AttrOrigin IOFuncsIoFreeFieldInfo = IOFuncs
    attrGet _ = getIOFuncsIoFree
    attrSet _ = setIOFuncsIoFree
    attrConstruct = undefined
    attrClear _ = clearIOFuncsIoFree

iOFuncs_ioFree :: AttrLabelProxy "ioFree"
iOFuncs_ioFree = AttrLabelProxy

#endif


getIOFuncsIoSetFlags :: MonadIO m => IOFuncs -> m (Maybe GLib.Callbacks.IOFuncsIoSetFlagsFieldCallback)
getIOFuncsIoSetFlags s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 48) :: IO (FunPtr GLib.Callbacks.C_IOFuncsIoSetFlagsFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GLib.Callbacks.dynamic_IOFuncsIoSetFlagsFieldCallback val'
        return val''
    return result

setIOFuncsIoSetFlags :: MonadIO m => IOFuncs -> FunPtr GLib.Callbacks.C_IOFuncsIoSetFlagsFieldCallback -> m ()
setIOFuncsIoSetFlags s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 48) (val :: FunPtr GLib.Callbacks.C_IOFuncsIoSetFlagsFieldCallback)

clearIOFuncsIoSetFlags :: MonadIO m => IOFuncs -> m ()
clearIOFuncsIoSetFlags s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 48) (FP.nullFunPtr :: FunPtr GLib.Callbacks.C_IOFuncsIoSetFlagsFieldCallback)

#ifdef ENABLE_OVERLOADING
data IOFuncsIoSetFlagsFieldInfo
instance AttrInfo IOFuncsIoSetFlagsFieldInfo where
    type AttrAllowedOps IOFuncsIoSetFlagsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IOFuncsIoSetFlagsFieldInfo = (~) (FunPtr GLib.Callbacks.C_IOFuncsIoSetFlagsFieldCallback)
    type AttrBaseTypeConstraint IOFuncsIoSetFlagsFieldInfo = (~) IOFuncs
    type AttrGetType IOFuncsIoSetFlagsFieldInfo = Maybe GLib.Callbacks.IOFuncsIoSetFlagsFieldCallback
    type AttrLabel IOFuncsIoSetFlagsFieldInfo = "io_set_flags"
    type AttrOrigin IOFuncsIoSetFlagsFieldInfo = IOFuncs
    attrGet _ = getIOFuncsIoSetFlags
    attrSet _ = setIOFuncsIoSetFlags
    attrConstruct = undefined
    attrClear _ = clearIOFuncsIoSetFlags

iOFuncs_ioSetFlags :: AttrLabelProxy "ioSetFlags"
iOFuncs_ioSetFlags = AttrLabelProxy

#endif


getIOFuncsIoGetFlags :: MonadIO m => IOFuncs -> m (Maybe GLib.Callbacks.IOFuncsIoGetFlagsFieldCallback)
getIOFuncsIoGetFlags s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 56) :: IO (FunPtr GLib.Callbacks.C_IOFuncsIoGetFlagsFieldCallback)
    result <- SP.convertFunPtrIfNonNull val $ \val' -> do
        let val'' = GLib.Callbacks.dynamic_IOFuncsIoGetFlagsFieldCallback val'
        return val''
    return result

setIOFuncsIoGetFlags :: MonadIO m => IOFuncs -> FunPtr GLib.Callbacks.C_IOFuncsIoGetFlagsFieldCallback -> m ()
setIOFuncsIoGetFlags s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 56) (val :: FunPtr GLib.Callbacks.C_IOFuncsIoGetFlagsFieldCallback)

clearIOFuncsIoGetFlags :: MonadIO m => IOFuncs -> m ()
clearIOFuncsIoGetFlags s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 56) (FP.nullFunPtr :: FunPtr GLib.Callbacks.C_IOFuncsIoGetFlagsFieldCallback)

#ifdef ENABLE_OVERLOADING
data IOFuncsIoGetFlagsFieldInfo
instance AttrInfo IOFuncsIoGetFlagsFieldInfo where
    type AttrAllowedOps IOFuncsIoGetFlagsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint IOFuncsIoGetFlagsFieldInfo = (~) (FunPtr GLib.Callbacks.C_IOFuncsIoGetFlagsFieldCallback)
    type AttrBaseTypeConstraint IOFuncsIoGetFlagsFieldInfo = (~) IOFuncs
    type AttrGetType IOFuncsIoGetFlagsFieldInfo = Maybe GLib.Callbacks.IOFuncsIoGetFlagsFieldCallback
    type AttrLabel IOFuncsIoGetFlagsFieldInfo = "io_get_flags"
    type AttrOrigin IOFuncsIoGetFlagsFieldInfo = IOFuncs
    attrGet _ = getIOFuncsIoGetFlags
    attrSet _ = setIOFuncsIoGetFlags
    attrConstruct = undefined
    attrClear _ = clearIOFuncsIoGetFlags

iOFuncs_ioGetFlags :: AttrLabelProxy "ioGetFlags"
iOFuncs_ioGetFlags = AttrLabelProxy

#endif



#ifdef ENABLE_OVERLOADING
instance O.HasAttributeList IOFuncs
type instance O.AttributeList IOFuncs = IOFuncsAttributeList
type IOFuncsAttributeList = ('[ '("ioRead", IOFuncsIoReadFieldInfo), '("ioWrite", IOFuncsIoWriteFieldInfo), '("ioSeek", IOFuncsIoSeekFieldInfo), '("ioClose", IOFuncsIoCloseFieldInfo), '("ioCreateWatch", IOFuncsIoCreateWatchFieldInfo), '("ioFree", IOFuncsIoFreeFieldInfo), '("ioSetFlags", IOFuncsIoSetFlagsFieldInfo), '("ioGetFlags", IOFuncsIoGetFlagsFieldInfo)] :: [(Symbol, *)])
#endif

#ifdef ENABLE_OVERLOADING
type family ResolveIOFuncsMethod (t :: Symbol) (o :: *) :: * where
    ResolveIOFuncsMethod l o = O.MethodResolutionFailed l o

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

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