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

Structure used for scatter\/gather data output.
You generally pass in an array of @/GOutputVectors/@
and the operation will use all the buffers as if they were
one buffer.
-}

module GI.Gio.Structs.OutputVector
    ( 

-- * Exported types
    OutputVector(..)                        ,
    newZeroOutputVector                     ,
    noOutputVector                          ,


 -- * Properties
-- ** buffer #attr:buffer#
    clearOutputVectorBuffer                 ,
    getOutputVectorBuffer                   ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    outputVector_buffer                     ,
#endif
    setOutputVectorBuffer                   ,


-- ** size #attr:size#
    getOutputVectorSize                     ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    outputVector_size                       ,
#endif
    setOutputVectorSize                     ,




    ) 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


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

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

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


noOutputVector :: Maybe OutputVector
noOutputVector = Nothing

getOutputVectorBuffer :: MonadIO m => OutputVector -> m (Ptr ())
getOutputVectorBuffer s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO (Ptr ())
    return val

setOutputVectorBuffer :: MonadIO m => OutputVector -> Ptr () -> m ()
setOutputVectorBuffer s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Ptr ())

clearOutputVectorBuffer :: MonadIO m => OutputVector -> m ()
clearOutputVectorBuffer s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullPtr :: Ptr ())

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data OutputVectorBufferFieldInfo
instance AttrInfo OutputVectorBufferFieldInfo where
    type AttrAllowedOps OutputVectorBufferFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint OutputVectorBufferFieldInfo = (~) (Ptr ())
    type AttrBaseTypeConstraint OutputVectorBufferFieldInfo = (~) OutputVector
    type AttrGetType OutputVectorBufferFieldInfo = Ptr ()
    type AttrLabel OutputVectorBufferFieldInfo = "buffer"
    type AttrOrigin OutputVectorBufferFieldInfo = OutputVector
    attrGet _ = getOutputVectorBuffer
    attrSet _ = setOutputVectorBuffer
    attrConstruct = undefined
    attrClear _ = clearOutputVectorBuffer

outputVector_buffer :: AttrLabelProxy "buffer"
outputVector_buffer = AttrLabelProxy

#endif


getOutputVectorSize :: MonadIO m => OutputVector -> m Word64
getOutputVectorSize s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO Word64
    return val

setOutputVectorSize :: MonadIO m => OutputVector -> Word64 -> m ()
setOutputVectorSize s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: Word64)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data OutputVectorSizeFieldInfo
instance AttrInfo OutputVectorSizeFieldInfo where
    type AttrAllowedOps OutputVectorSizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint OutputVectorSizeFieldInfo = (~) Word64
    type AttrBaseTypeConstraint OutputVectorSizeFieldInfo = (~) OutputVector
    type AttrGetType OutputVectorSizeFieldInfo = Word64
    type AttrLabel OutputVectorSizeFieldInfo = "size"
    type AttrOrigin OutputVectorSizeFieldInfo = OutputVector
    attrGet _ = getOutputVectorSize
    attrSet _ = setOutputVectorSize
    attrConstruct = undefined
    attrClear _ = undefined

outputVector_size :: AttrLabelProxy "size"
outputVector_size = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList OutputVector
type instance O.AttributeList OutputVector = OutputVectorAttributeList
type OutputVectorAttributeList = ('[ '("buffer", OutputVectorBufferFieldInfo), '("size", OutputVectorSizeFieldInfo)] :: [(Symbol, *)])
#endif

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

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

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