{- |
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 input.
You generally pass in an array of @/GInputVectors/@
and the operation will store the read data starting in the
first buffer, switching to the next as needed.
-}

module GI.Gio.Structs.InputVector
    ( 

-- * Exported types
    InputVector(..)                         ,
    newZeroInputVector                      ,
    noInputVector                           ,


 -- * Properties
-- ** buffer #attr:buffer#
    clearInputVectorBuffer                  ,
    getInputVectorBuffer                    ,
    inputVector_buffer                      ,
    setInputVectorBuffer                    ,


-- ** size #attr:size#
    getInputVectorSize                      ,
    inputVector_size                        ,
    setInputVectorSize                      ,




    ) 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 InputVector = InputVector (ManagedPtr InputVector)
instance WrappedPtr InputVector where
    wrappedPtrCalloc = callocBytes 16
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 16 >=> wrapPtr InputVector)
    wrappedPtrFree = Just ptr_to_g_free

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

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


noInputVector :: Maybe InputVector
noInputVector = Nothing

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

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

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

data InputVectorBufferFieldInfo
instance AttrInfo InputVectorBufferFieldInfo where
    type AttrAllowedOps InputVectorBufferFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint InputVectorBufferFieldInfo = (~) (Ptr ())
    type AttrBaseTypeConstraint InputVectorBufferFieldInfo = (~) InputVector
    type AttrGetType InputVectorBufferFieldInfo = Ptr ()
    type AttrLabel InputVectorBufferFieldInfo = "buffer"
    type AttrOrigin InputVectorBufferFieldInfo = InputVector
    attrGet _ = getInputVectorBuffer
    attrSet _ = setInputVectorBuffer
    attrConstruct = undefined
    attrClear _ = clearInputVectorBuffer

inputVector_buffer :: AttrLabelProxy "buffer"
inputVector_buffer = AttrLabelProxy


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

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

data InputVectorSizeFieldInfo
instance AttrInfo InputVectorSizeFieldInfo where
    type AttrAllowedOps InputVectorSizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint InputVectorSizeFieldInfo = (~) Word64
    type AttrBaseTypeConstraint InputVectorSizeFieldInfo = (~) InputVector
    type AttrGetType InputVectorSizeFieldInfo = Word64
    type AttrLabel InputVectorSizeFieldInfo = "size"
    type AttrOrigin InputVectorSizeFieldInfo = InputVector
    attrGet _ = getInputVectorSize
    attrSet _ = setInputVectorSize
    attrConstruct = undefined
    attrClear _ = undefined

inputVector_size :: AttrLabelProxy "size"
inputVector_size = AttrLabelProxy



instance O.HasAttributeList InputVector
type instance O.AttributeList InputVector = InputVectorAttributeList
type InputVectorAttributeList = ('[ '("buffer", InputVectorBufferFieldInfo), '("size", InputVectorSizeFieldInfo)] :: [(Symbol, *)])

type family ResolveInputVectorMethod (t :: Symbol) (o :: *) :: * where
    ResolveInputVectorMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveInputVectorMethod t InputVector, O.MethodInfo info InputVector p) => O.IsLabel t (InputVector -> p) where
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif