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

Buffer lists are an object containing a list of buffers.

Buffer lists are created with 'GI.Gst.Structs.BufferList.bufferListNew' and filled with data
using a 'GI.Gst.Structs.BufferList.bufferListInsert'.

Buffer lists can be pushed on a srcpad with 'GI.Gst.Objects.Pad.padPushList'. This is
interesting when multiple buffers need to be pushed in one go because it
can reduce the amount of overhead for pushing each buffer individually.
-}

module GI.Gst.Structs.BufferList
    ( 

-- * Exported types
    BufferList(..)                          ,
    noBufferList                            ,


 -- * Methods
-- ** copyDeep #method:copyDeep#
    BufferListCopyDeepMethodInfo            ,
    bufferListCopyDeep                      ,


-- ** foreach #method:foreach#
    BufferListForeachMethodInfo             ,
    bufferListForeach                       ,


-- ** get #method:get#
    BufferListGetMethodInfo                 ,
    bufferListGet                           ,


-- ** insert #method:insert#
    BufferListInsertMethodInfo              ,
    bufferListInsert                        ,


-- ** length #method:length#
    BufferListLengthMethodInfo              ,
    bufferListLength                        ,


-- ** new #method:new#
    bufferListNew                           ,


-- ** newSized #method:newSized#
    bufferListNewSized                      ,


-- ** remove #method:remove#
    BufferListRemoveMethodInfo              ,
    bufferListRemove                        ,




    ) 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.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Structs.Buffer as Gst.Buffer

newtype BufferList = BufferList (ManagedPtr BufferList)
foreign import ccall "gst_buffer_list_get_type" c_gst_buffer_list_get_type :: 
    IO GType

instance BoxedObject BufferList where
    boxedType _ = c_gst_buffer_list_get_type

noBufferList :: Maybe BufferList
noBufferList = Nothing


instance O.HasAttributeList BufferList
type instance O.AttributeList BufferList = BufferListAttributeList
type BufferListAttributeList = ('[ ] :: [(Symbol, *)])

-- method BufferList::new
-- method type : Constructor
-- Args : []
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "BufferList"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_list_new" gst_buffer_list_new :: 
    IO (Ptr BufferList)

{- |
Creates a new, empty 'GI.Gst.Structs.BufferList.BufferList'. The caller is responsible for unreffing
the returned 'GI.Gst.Structs.BufferList.BufferList'.

Free-function: gst_buffer_list_unref
-}
bufferListNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m BufferList
    {- ^ __Returns:__ the new 'GI.Gst.Structs.BufferList.BufferList'. @/gst_buffer_list_unref()/@
    after usage. -}
bufferListNew  = liftIO $ do
    result <- gst_buffer_list_new
    checkUnexpectedReturnNULL "bufferListNew" result
    result' <- (wrapBoxed BufferList) result
    return result'

-- method BufferList::new_sized
-- method type : Constructor
-- Args : [Arg {argCName = "size", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "an initial reserved size", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "BufferList"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_list_new_sized" gst_buffer_list_new_sized :: 
    Word32 ->                               -- size : TBasicType TUInt
    IO (Ptr BufferList)

{- |
Creates a new, empty 'GI.Gst.Structs.BufferList.BufferList'. The caller is responsible for unreffing
the returned 'GI.Gst.Structs.BufferList.BufferList'. The list will have /@size@/ space preallocated so
that memory reallocations can be avoided.

Free-function: gst_buffer_list_unref
-}
bufferListNewSized ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    {- ^ /@size@/: an initial reserved size -}
    -> m BufferList
    {- ^ __Returns:__ the new 'GI.Gst.Structs.BufferList.BufferList'. @/gst_buffer_list_unref()/@
    after usage. -}
bufferListNewSized size = liftIO $ do
    result <- gst_buffer_list_new_sized size
    checkUnexpectedReturnNULL "bufferListNewSized" result
    result' <- (wrapBoxed BufferList) result
    return result'

-- method BufferList::copy_deep
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "list", argType = TInterface (Name {namespace = "Gst", name = "BufferList"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstBufferList", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "BufferList"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_list_copy_deep" gst_buffer_list_copy_deep :: 
    Ptr BufferList ->                       -- list : TInterface (Name {namespace = "Gst", name = "BufferList"})
    IO (Ptr BufferList)

{- |
Create a copy of the given buffer list. This will make a newly allocated
copy of the buffer that the source buffer list contains.

@since 1.6
-}
bufferListCopyDeep ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BufferList
    {- ^ /@list@/: a 'GI.Gst.Structs.BufferList.BufferList' -}
    -> m BufferList
    {- ^ __Returns:__ a new copy of /@list@/. -}
bufferListCopyDeep list = liftIO $ do
    list' <- unsafeManagedPtrGetPtr list
    result <- gst_buffer_list_copy_deep list'
    checkUnexpectedReturnNULL "bufferListCopyDeep" result
    result' <- (wrapBoxed BufferList) result
    touchManagedPtr list
    return result'

data BufferListCopyDeepMethodInfo
instance (signature ~ (m BufferList), MonadIO m) => O.MethodInfo BufferListCopyDeepMethodInfo BufferList signature where
    overloadedMethod _ = bufferListCopyDeep

-- method BufferList::foreach
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "list", argType = TInterface (Name {namespace = "Gst", name = "BufferList"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstBufferList", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "func", argType = TInterface (Name {namespace = "Gst", name = "BufferListFunc"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstBufferListFunc to call", sinceVersion = Nothing}, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "user_data", argType = TBasicType TPtr, direction = DirectionIn, mayBeNull = True, argDoc = Documentation {rawDocText = Just "user data passed to @func", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_list_foreach" gst_buffer_list_foreach :: 
    Ptr BufferList ->                       -- list : TInterface (Name {namespace = "Gst", name = "BufferList"})
    FunPtr Gst.Callbacks.C_BufferListFunc -> -- func : TInterface (Name {namespace = "Gst", name = "BufferListFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO CInt

{- |
Call /@func@/ with /@data@/ for each buffer in /@list@/.

/@func@/ can modify the passed buffer pointer or its contents. The return value
of /@func@/ define if this function returns or if the remaining buffers in
the list should be skipped.
-}
bufferListForeach ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BufferList
    {- ^ /@list@/: a 'GI.Gst.Structs.BufferList.BufferList' -}
    -> Gst.Callbacks.BufferListFunc
    {- ^ /@func@/: a 'GI.Gst.Callbacks.BufferListFunc' to call -}
    -> m Bool
    {- ^ __Returns:__ 'True' when /@func@/ returned 'True' for each buffer in /@list@/ or when
/@list@/ is empty. -}
bufferListForeach list func = liftIO $ do
    list' <- unsafeManagedPtrGetPtr list
    func' <- Gst.Callbacks.mk_BufferListFunc (Gst.Callbacks.wrap_BufferListFunc Nothing (Gst.Callbacks.drop_closures_BufferListFunc func))
    let userData = nullPtr
    result <- gst_buffer_list_foreach list' func' userData
    let result' = (/= 0) result
    safeFreeFunPtr $ castFunPtrToPtr func'
    touchManagedPtr list
    return result'

data BufferListForeachMethodInfo
instance (signature ~ (Gst.Callbacks.BufferListFunc -> m Bool), MonadIO m) => O.MethodInfo BufferListForeachMethodInfo BufferList signature where
    overloadedMethod _ = bufferListForeach

-- method BufferList::get
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "list", argType = TInterface (Name {namespace = "Gst", name = "BufferList"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstBufferList", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "idx", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the index", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Buffer"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_list_get" gst_buffer_list_get :: 
    Ptr BufferList ->                       -- list : TInterface (Name {namespace = "Gst", name = "BufferList"})
    Word32 ->                               -- idx : TBasicType TUInt
    IO (Ptr Gst.Buffer.Buffer)

{- |
Get the buffer at /@idx@/.
-}
bufferListGet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BufferList
    {- ^ /@list@/: a 'GI.Gst.Structs.BufferList.BufferList' -}
    -> Word32
    {- ^ /@idx@/: the index -}
    -> m (Maybe Gst.Buffer.Buffer)
    {- ^ __Returns:__ the buffer at /@idx@/ in /@group@/
    or 'Nothing' when there is no buffer. The buffer remains valid as
    long as /@list@/ is valid and buffer is not removed from the list. -}
bufferListGet list idx = liftIO $ do
    list' <- unsafeManagedPtrGetPtr list
    result <- gst_buffer_list_get list' idx
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (newBoxed Gst.Buffer.Buffer) result'
        return result''
    touchManagedPtr list
    return maybeResult

data BufferListGetMethodInfo
instance (signature ~ (Word32 -> m (Maybe Gst.Buffer.Buffer)), MonadIO m) => O.MethodInfo BufferListGetMethodInfo BufferList signature where
    overloadedMethod _ = bufferListGet

-- method BufferList::insert
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "list", argType = TInterface (Name {namespace = "Gst", name = "BufferList"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstBufferList", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "idx", argType = TBasicType TInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the index", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "buffer", argType = TInterface (Name {namespace = "Gst", name = "Buffer"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstBuffer", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferEverything}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_list_insert" gst_buffer_list_insert :: 
    Ptr BufferList ->                       -- list : TInterface (Name {namespace = "Gst", name = "BufferList"})
    Int32 ->                                -- idx : TBasicType TInt
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO ()

{- |
Insert /@buffer@/ at /@idx@/ in /@list@/. Other buffers are moved to make room for
this new buffer.

A -1 value for /@idx@/ will append the buffer at the end.
-}
bufferListInsert ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BufferList
    {- ^ /@list@/: a 'GI.Gst.Structs.BufferList.BufferList' -}
    -> Int32
    {- ^ /@idx@/: the index -}
    -> Gst.Buffer.Buffer
    {- ^ /@buffer@/: a 'GI.Gst.Structs.Buffer.Buffer' -}
    -> m ()
bufferListInsert list idx buffer = liftIO $ do
    list' <- unsafeManagedPtrGetPtr list
    buffer' <- B.ManagedPtr.disownBoxed buffer
    gst_buffer_list_insert list' idx buffer'
    touchManagedPtr list
    touchManagedPtr buffer
    return ()

data BufferListInsertMethodInfo
instance (signature ~ (Int32 -> Gst.Buffer.Buffer -> m ()), MonadIO m) => O.MethodInfo BufferListInsertMethodInfo BufferList signature where
    overloadedMethod _ = bufferListInsert

-- method BufferList::length
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "list", argType = TInterface (Name {namespace = "Gst", name = "BufferList"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstBufferList", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_list_length" gst_buffer_list_length :: 
    Ptr BufferList ->                       -- list : TInterface (Name {namespace = "Gst", name = "BufferList"})
    IO Word32

{- |
Returns the number of buffers in /@list@/.
-}
bufferListLength ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BufferList
    {- ^ /@list@/: a 'GI.Gst.Structs.BufferList.BufferList' -}
    -> m Word32
    {- ^ __Returns:__ the number of buffers in the buffer list -}
bufferListLength list = liftIO $ do
    list' <- unsafeManagedPtrGetPtr list
    result <- gst_buffer_list_length list'
    touchManagedPtr list
    return result

data BufferListLengthMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo BufferListLengthMethodInfo BufferList signature where
    overloadedMethod _ = bufferListLength

-- method BufferList::remove
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "list", argType = TInterface (Name {namespace = "Gst", name = "BufferList"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstBufferList", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "idx", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the index", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "length", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the amount to remove", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_buffer_list_remove" gst_buffer_list_remove :: 
    Ptr BufferList ->                       -- list : TInterface (Name {namespace = "Gst", name = "BufferList"})
    Word32 ->                               -- idx : TBasicType TUInt
    Word32 ->                               -- length : TBasicType TUInt
    IO ()

{- |
Remove /@length@/ buffers starting from /@idx@/ in /@list@/. The following buffers
are moved to close the gap.
-}
bufferListRemove ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BufferList
    {- ^ /@list@/: a 'GI.Gst.Structs.BufferList.BufferList' -}
    -> Word32
    {- ^ /@idx@/: the index -}
    -> Word32
    {- ^ /@length@/: the amount to remove -}
    -> m ()
bufferListRemove list idx length_ = liftIO $ do
    list' <- unsafeManagedPtrGetPtr list
    gst_buffer_list_remove list' idx length_
    touchManagedPtr list
    return ()

data BufferListRemoveMethodInfo
instance (signature ~ (Word32 -> Word32 -> m ()), MonadIO m) => O.MethodInfo BufferListRemoveMethodInfo BufferList signature where
    overloadedMethod _ = bufferListRemove

type family ResolveBufferListMethod (t :: Symbol) (o :: *) :: * where
    ResolveBufferListMethod "copyDeep" o = BufferListCopyDeepMethodInfo
    ResolveBufferListMethod "foreach" o = BufferListForeachMethodInfo
    ResolveBufferListMethod "get" o = BufferListGetMethodInfo
    ResolveBufferListMethod "insert" o = BufferListInsertMethodInfo
    ResolveBufferListMethod "length" o = BufferListLengthMethodInfo
    ResolveBufferListMethod "remove" o = BufferListRemoveMethodInfo
    ResolveBufferListMethod l o = O.MethodResolutionFailed l o

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

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