{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Gst.Structs.Sample.Sample' is a small object containing data, a type, timing and
-- extra arbitrary information.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Gst.Structs.Sample
    ( 

-- * Exported types
    Sample(..)                              ,
    noSample                                ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveSampleMethod                     ,
#endif


-- ** getBuffer #method:getBuffer#

#if defined(ENABLE_OVERLOADING)
    SampleGetBufferMethodInfo               ,
#endif
    sampleGetBuffer                         ,


-- ** getBufferList #method:getBufferList#

#if defined(ENABLE_OVERLOADING)
    SampleGetBufferListMethodInfo           ,
#endif
    sampleGetBufferList                     ,


-- ** getCaps #method:getCaps#

#if defined(ENABLE_OVERLOADING)
    SampleGetCapsMethodInfo                 ,
#endif
    sampleGetCaps                           ,


-- ** getInfo #method:getInfo#

#if defined(ENABLE_OVERLOADING)
    SampleGetInfoMethodInfo                 ,
#endif
    sampleGetInfo                           ,


-- ** getSegment #method:getSegment#

#if defined(ENABLE_OVERLOADING)
    SampleGetSegmentMethodInfo              ,
#endif
    sampleGetSegment                        ,


-- ** new #method:new#

    sampleNew                               ,


-- ** setBuffer #method:setBuffer#

#if defined(ENABLE_OVERLOADING)
    SampleSetBufferMethodInfo               ,
#endif
    sampleSetBuffer                         ,


-- ** setBufferList #method:setBufferList#

#if defined(ENABLE_OVERLOADING)
    SampleSetBufferListMethodInfo           ,
#endif
    sampleSetBufferList                     ,


-- ** setCaps #method:setCaps#

#if defined(ENABLE_OVERLOADING)
    SampleSetCapsMethodInfo                 ,
#endif
    sampleSetCaps                           ,


-- ** setInfo #method:setInfo#

#if defined(ENABLE_OVERLOADING)
    SampleSetInfoMethodInfo                 ,
#endif
    sampleSetInfo                           ,


-- ** setSegment #method:setSegment#

#if defined(ENABLE_OVERLOADING)
    SampleSetSegmentMethodInfo              ,
#endif
    sampleSetSegment                        ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
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 GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.Gst.Structs.Buffer as Gst.Buffer
import {-# SOURCE #-} qualified GI.Gst.Structs.BufferList as Gst.BufferList
import {-# SOURCE #-} qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.Gst.Structs.Segment as Gst.Segment
import {-# SOURCE #-} qualified GI.Gst.Structs.Structure as Gst.Structure

-- | Memory-managed wrapper type.
newtype Sample = Sample (ManagedPtr Sample)
    deriving (Sample -> Sample -> Bool
(Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool) -> Eq Sample
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sample -> Sample -> Bool
$c/= :: Sample -> Sample -> Bool
== :: Sample -> Sample -> Bool
$c== :: Sample -> Sample -> Bool
Eq)
foreign import ccall "gst_sample_get_type" c_gst_sample_get_type :: 
    IO GType

instance BoxedObject Sample where
    boxedType :: Sample -> IO GType
boxedType _ = IO GType
c_gst_sample_get_type

-- | Convert 'Sample' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Sample where
    toGValue :: Sample -> IO GValue
toGValue o :: Sample
o = do
        GType
gtype <- IO GType
c_gst_sample_get_type
        Sample -> (Ptr Sample -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Sample
o (GType -> (GValue -> Ptr Sample -> IO ()) -> Ptr Sample -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Sample -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO Sample
fromGValue gv :: GValue
gv = do
        Ptr Sample
ptr <- GValue -> IO (Ptr Sample)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr Sample)
        (ManagedPtr Sample -> Sample) -> Ptr Sample -> IO Sample
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Sample -> Sample
Sample Ptr Sample
ptr
        
    

-- | A convenience alias for `Nothing` :: `Maybe` `Sample`.
noSample :: Maybe Sample
noSample :: Maybe Sample
noSample = Maybe Sample
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Sample
type instance O.AttributeList Sample = SampleAttributeList
type SampleAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method Sample::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "Gst" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstBuffer, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstCaps, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSegment, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstStructure, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Sample" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_sample_new" gst_sample_new :: 
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    Ptr Gst.Segment.Segment ->              -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    Ptr Gst.Structure.Structure ->          -- info : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO (Ptr Sample)

-- | Create a new t'GI.Gst.Structs.Sample.Sample' with the provided details.
-- 
-- Free-function: gst_sample_unref
sampleNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (Gst.Buffer.Buffer)
    -- ^ /@buffer@/: a t'GI.Gst.Structs.Buffer.Buffer', or 'P.Nothing'
    -> Maybe (Gst.Caps.Caps)
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps', or 'P.Nothing'
    -> Maybe (Gst.Segment.Segment)
    -- ^ /@segment@/: a t'GI.Gst.Structs.Segment.Segment', or 'P.Nothing'
    -> Maybe (Gst.Structure.Structure)
    -- ^ /@info@/: a t'GI.Gst.Structs.Structure.Structure', or 'P.Nothing'
    -> m Sample
    -- ^ __Returns:__ the new t'GI.Gst.Structs.Sample.Sample'. @/gst_sample_unref()/@
    --     after usage.
sampleNew :: Maybe Buffer
-> Maybe Caps -> Maybe Segment -> Maybe Structure -> m Sample
sampleNew buffer :: Maybe Buffer
buffer caps :: Maybe Caps
caps segment :: Maybe Segment
segment info :: Maybe Structure
info = IO Sample -> m Sample
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Sample -> m Sample) -> IO Sample -> m Sample
forall a b. (a -> b) -> a -> b
$ do
    Ptr Buffer
maybeBuffer <- case Maybe Buffer
buffer of
        Nothing -> Ptr Buffer -> IO (Ptr Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Buffer
forall a. Ptr a
nullPtr
        Just jBuffer :: Buffer
jBuffer -> do
            Ptr Buffer
jBuffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
jBuffer
            Ptr Buffer -> IO (Ptr Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Buffer
jBuffer'
    Ptr Caps
maybeCaps <- case Maybe Caps
caps of
        Nothing -> Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
forall a. Ptr a
nullPtr
        Just jCaps :: Caps
jCaps -> do
            Ptr Caps
jCaps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
jCaps
            Ptr Caps -> IO (Ptr Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Caps
jCaps'
    Ptr Segment
maybeSegment <- case Maybe Segment
segment of
        Nothing -> Ptr Segment -> IO (Ptr Segment)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Segment
forall a. Ptr a
nullPtr
        Just jSegment :: Segment
jSegment -> do
            Ptr Segment
jSegment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
jSegment
            Ptr Segment -> IO (Ptr Segment)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Segment
jSegment'
    Ptr Structure
maybeInfo <- case Maybe Structure
info of
        Nothing -> Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
forall a. Ptr a
nullPtr
        Just jInfo :: Structure
jInfo -> do
            Ptr Structure
jInfo' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
jInfo
            Ptr Structure -> IO (Ptr Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Structure
jInfo'
    Ptr Sample
result <- Ptr Buffer
-> Ptr Caps -> Ptr Segment -> Ptr Structure -> IO (Ptr Sample)
gst_sample_new Ptr Buffer
maybeBuffer Ptr Caps
maybeCaps Ptr Segment
maybeSegment Ptr Structure
maybeInfo
    Text -> Ptr Sample -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "sampleNew" Ptr Sample
result
    Sample
result' <- ((ManagedPtr Sample -> Sample) -> Ptr Sample -> IO Sample
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Sample -> Sample
Sample) Ptr Sample
result
    Maybe Buffer -> (Buffer -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Buffer
buffer Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Caps -> (Caps -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Caps
caps Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Segment -> (Segment -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Segment
segment Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe Structure -> (Structure -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Structure
info Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Sample -> IO Sample
forall (m :: * -> *) a. Monad m => a -> m a
return Sample
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Sample::get_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sample"
--           , argType = TInterface Name { namespace = "Gst" , name = "Sample" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSample" , 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_sample_get_buffer" gst_sample_get_buffer :: 
    Ptr Sample ->                           -- sample : TInterface (Name {namespace = "Gst", name = "Sample"})
    IO (Ptr Gst.Buffer.Buffer)

-- | Get the buffer associated with /@sample@/
sampleGetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Sample
    -- ^ /@sample@/: a t'GI.Gst.Structs.Sample.Sample'
    -> m (Maybe Gst.Buffer.Buffer)
    -- ^ __Returns:__ the buffer of /@sample@/ or 'P.Nothing'
    --  when there is no buffer. The buffer remains valid as long as
    --  /@sample@/ is valid.  If you need to hold on to it for longer than
    --  that, take a ref to the buffer with @/gst_buffer_ref()/@.
sampleGetBuffer :: Sample -> m (Maybe Buffer)
sampleGetBuffer sample :: Sample
sample = IO (Maybe Buffer) -> m (Maybe Buffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Buffer) -> m (Maybe Buffer))
-> IO (Maybe Buffer) -> m (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sample
sample' <- Sample -> IO (Ptr Sample)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Sample
sample
    Ptr Buffer
result <- Ptr Sample -> IO (Ptr Buffer)
gst_sample_get_buffer Ptr Sample
sample'
    Maybe Buffer
maybeResult <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Buffer
result ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Buffer
result' -> do
        Buffer
result'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Buffer -> Buffer
Gst.Buffer.Buffer) Ptr Buffer
result'
        Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result''
    Sample -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Sample
sample
    Maybe Buffer -> IO (Maybe Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
maybeResult

#if defined(ENABLE_OVERLOADING)
data SampleGetBufferMethodInfo
instance (signature ~ (m (Maybe Gst.Buffer.Buffer)), MonadIO m) => O.MethodInfo SampleGetBufferMethodInfo Sample signature where
    overloadedMethod = sampleGetBuffer

#endif

-- method Sample::get_buffer_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sample"
--           , argType = TInterface Name { namespace = "Gst" , name = "Sample" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSample" , 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_sample_get_buffer_list" gst_sample_get_buffer_list :: 
    Ptr Sample ->                           -- sample : TInterface (Name {namespace = "Gst", name = "Sample"})
    IO (Ptr Gst.BufferList.BufferList)

-- | Get the buffer list associated with /@sample@/
-- 
-- /Since: 1.6/
sampleGetBufferList ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Sample
    -- ^ /@sample@/: a t'GI.Gst.Structs.Sample.Sample'
    -> m (Maybe Gst.BufferList.BufferList)
    -- ^ __Returns:__ the buffer list of /@sample@/ or 'P.Nothing'
    --  when there is no buffer list. The buffer list remains valid as long as
    --  /@sample@/ is valid.  If you need to hold on to it for longer than
    --  that, take a ref to the buffer list with gst_mini_object_ref ().
sampleGetBufferList :: Sample -> m (Maybe BufferList)
sampleGetBufferList sample :: Sample
sample = IO (Maybe BufferList) -> m (Maybe BufferList)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe BufferList) -> m (Maybe BufferList))
-> IO (Maybe BufferList) -> m (Maybe BufferList)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sample
sample' <- Sample -> IO (Ptr Sample)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Sample
sample
    Ptr BufferList
result <- Ptr Sample -> IO (Ptr BufferList)
gst_sample_get_buffer_list Ptr Sample
sample'
    Maybe BufferList
maybeResult <- Ptr BufferList
-> (Ptr BufferList -> IO BufferList) -> IO (Maybe BufferList)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr BufferList
result ((Ptr BufferList -> IO BufferList) -> IO (Maybe BufferList))
-> (Ptr BufferList -> IO BufferList) -> IO (Maybe BufferList)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr BufferList
result' -> do
        BufferList
result'' <- ((ManagedPtr BufferList -> BufferList)
-> Ptr BufferList -> IO BufferList
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr BufferList -> BufferList
Gst.BufferList.BufferList) Ptr BufferList
result'
        BufferList -> IO BufferList
forall (m :: * -> *) a. Monad m => a -> m a
return BufferList
result''
    Sample -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Sample
sample
    Maybe BufferList -> IO (Maybe BufferList)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BufferList
maybeResult

#if defined(ENABLE_OVERLOADING)
data SampleGetBufferListMethodInfo
instance (signature ~ (m (Maybe Gst.BufferList.BufferList)), MonadIO m) => O.MethodInfo SampleGetBufferListMethodInfo Sample signature where
    overloadedMethod = sampleGetBufferList

#endif

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

foreign import ccall "gst_sample_get_caps" gst_sample_get_caps :: 
    Ptr Sample ->                           -- sample : TInterface (Name {namespace = "Gst", name = "Sample"})
    IO (Ptr Gst.Caps.Caps)

-- | Get the caps associated with /@sample@/
sampleGetCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Sample
    -- ^ /@sample@/: a t'GI.Gst.Structs.Sample.Sample'
    -> m (Maybe Gst.Caps.Caps)
    -- ^ __Returns:__ the caps of /@sample@/ or 'P.Nothing'
    --  when there is no caps. The caps remain valid as long as /@sample@/ is
    --  valid.  If you need to hold on to the caps for longer than that,
    --  take a ref to the caps with @/gst_caps_ref()/@.
sampleGetCaps :: Sample -> m (Maybe Caps)
sampleGetCaps sample :: Sample
sample = IO (Maybe Caps) -> m (Maybe Caps)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Caps) -> m (Maybe Caps))
-> IO (Maybe Caps) -> m (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sample
sample' <- Sample -> IO (Ptr Sample)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Sample
sample
    Ptr Caps
result <- Ptr Sample -> IO (Ptr Caps)
gst_sample_get_caps Ptr Sample
sample'
    Maybe Caps
maybeResult <- Ptr Caps -> (Ptr Caps -> IO Caps) -> IO (Maybe Caps)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Caps
result ((Ptr Caps -> IO Caps) -> IO (Maybe Caps))
-> (Ptr Caps -> IO Caps) -> IO (Maybe Caps)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Caps
result' -> do
        Caps
result'' <- ((ManagedPtr Caps -> Caps) -> Ptr Caps -> IO Caps
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Caps -> Caps
Gst.Caps.Caps) Ptr Caps
result'
        Caps -> IO Caps
forall (m :: * -> *) a. Monad m => a -> m a
return Caps
result''
    Sample -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Sample
sample
    Maybe Caps -> IO (Maybe Caps)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Caps
maybeResult

#if defined(ENABLE_OVERLOADING)
data SampleGetCapsMethodInfo
instance (signature ~ (m (Maybe Gst.Caps.Caps)), MonadIO m) => O.MethodInfo SampleGetCapsMethodInfo Sample signature where
    overloadedMethod = sampleGetCaps

#endif

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

foreign import ccall "gst_sample_get_info" gst_sample_get_info :: 
    Ptr Sample ->                           -- sample : TInterface (Name {namespace = "Gst", name = "Sample"})
    IO (Ptr Gst.Structure.Structure)

-- | Get extra information associated with /@sample@/.
sampleGetInfo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Sample
    -- ^ /@sample@/: a t'GI.Gst.Structs.Sample.Sample'
    -> m (Maybe Gst.Structure.Structure)
    -- ^ __Returns:__ the extra info of /@sample@/.
    --  The info remains valid as long as /@sample@/ is valid.
sampleGetInfo :: Sample -> m (Maybe Structure)
sampleGetInfo sample :: Sample
sample = IO (Maybe Structure) -> m (Maybe Structure)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Structure) -> m (Maybe Structure))
-> IO (Maybe Structure) -> m (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sample
sample' <- Sample -> IO (Ptr Sample)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Sample
sample
    Ptr Structure
result <- Ptr Sample -> IO (Ptr Structure)
gst_sample_get_info Ptr Sample
sample'
    Maybe Structure
maybeResult <- Ptr Structure
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Structure
result ((Ptr Structure -> IO Structure) -> IO (Maybe Structure))
-> (Ptr Structure -> IO Structure) -> IO (Maybe Structure)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Structure
result' -> do
        Structure
result'' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result'
        Structure -> IO Structure
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result''
    Sample -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Sample
sample
    Maybe Structure -> IO (Maybe Structure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Structure
maybeResult

#if defined(ENABLE_OVERLOADING)
data SampleGetInfoMethodInfo
instance (signature ~ (m (Maybe Gst.Structure.Structure)), MonadIO m) => O.MethodInfo SampleGetInfoMethodInfo Sample signature where
    overloadedMethod = sampleGetInfo

#endif

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

foreign import ccall "gst_sample_get_segment" gst_sample_get_segment :: 
    Ptr Sample ->                           -- sample : TInterface (Name {namespace = "Gst", name = "Sample"})
    IO (Ptr Gst.Segment.Segment)

-- | Get the segment associated with /@sample@/
sampleGetSegment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Sample
    -- ^ /@sample@/: a t'GI.Gst.Structs.Sample.Sample'
    -> m Gst.Segment.Segment
    -- ^ __Returns:__ the segment of /@sample@/.
    --  The segment remains valid as long as /@sample@/ is valid.
sampleGetSegment :: Sample -> m Segment
sampleGetSegment sample :: Sample
sample = IO Segment -> m Segment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Segment -> m Segment) -> IO Segment -> m Segment
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sample
sample' <- Sample -> IO (Ptr Sample)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Sample
sample
    Ptr Segment
result <- Ptr Sample -> IO (Ptr Segment)
gst_sample_get_segment Ptr Sample
sample'
    Text -> Ptr Segment -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "sampleGetSegment" Ptr Segment
result
    Segment
result' <- ((ManagedPtr Segment -> Segment) -> Ptr Segment -> IO Segment
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Segment -> Segment
Gst.Segment.Segment) Ptr Segment
result
    Sample -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Sample
sample
    Segment -> IO Segment
forall (m :: * -> *) a. Monad m => a -> m a
return Segment
result'

#if defined(ENABLE_OVERLOADING)
data SampleGetSegmentMethodInfo
instance (signature ~ (m Gst.Segment.Segment), MonadIO m) => O.MethodInfo SampleGetSegmentMethodInfo Sample signature where
    overloadedMethod = sampleGetSegment

#endif

-- method Sample::set_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sample"
--           , argType = TInterface Name { namespace = "Gst" , name = "Sample" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstSample" , 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 = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_sample_set_buffer" gst_sample_set_buffer :: 
    Ptr Sample ->                           -- sample : TInterface (Name {namespace = "Gst", name = "Sample"})
    Ptr Gst.Buffer.Buffer ->                -- buffer : TInterface (Name {namespace = "Gst", name = "Buffer"})
    IO ()

-- | Set the buffer associated with /@sample@/. /@sample@/ must be writable.
-- 
-- /Since: 1.16/
sampleSetBuffer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Sample
    -- ^ /@sample@/: A t'GI.Gst.Structs.Sample.Sample'
    -> Gst.Buffer.Buffer
    -- ^ /@buffer@/: A t'GI.Gst.Structs.Buffer.Buffer'
    -> m ()
sampleSetBuffer :: Sample -> Buffer -> m ()
sampleSetBuffer sample :: Sample
sample buffer :: Buffer
buffer = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sample
sample' <- Sample -> IO (Ptr Sample)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Sample
sample
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr Sample -> Ptr Buffer -> IO ()
gst_sample_set_buffer Ptr Sample
sample' Ptr Buffer
buffer'
    Sample -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Sample
sample
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SampleSetBufferMethodInfo
instance (signature ~ (Gst.Buffer.Buffer -> m ()), MonadIO m) => O.MethodInfo SampleSetBufferMethodInfo Sample signature where
    overloadedMethod = sampleSetBuffer

#endif

-- method Sample::set_buffer_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sample"
--           , argType = TInterface Name { namespace = "Gst" , name = "Sample" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstSample" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer_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: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_sample_set_buffer_list" gst_sample_set_buffer_list :: 
    Ptr Sample ->                           -- sample : TInterface (Name {namespace = "Gst", name = "Sample"})
    Ptr Gst.BufferList.BufferList ->        -- buffer_list : TInterface (Name {namespace = "Gst", name = "BufferList"})
    IO ()

-- | Set the buffer list associated with /@sample@/. /@sample@/ must be writable.
-- 
-- /Since: 1.6/
sampleSetBufferList ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Sample
    -- ^ /@sample@/: a t'GI.Gst.Structs.Sample.Sample'
    -> Gst.BufferList.BufferList
    -- ^ /@bufferList@/: a t'GI.Gst.Structs.BufferList.BufferList'
    -> m ()
sampleSetBufferList :: Sample -> BufferList -> m ()
sampleSetBufferList sample :: Sample
sample bufferList :: BufferList
bufferList = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sample
sample' <- Sample -> IO (Ptr Sample)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Sample
sample
    Ptr BufferList
bufferList' <- BufferList -> IO (Ptr BufferList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BufferList
bufferList
    Ptr Sample -> Ptr BufferList -> IO ()
gst_sample_set_buffer_list Ptr Sample
sample' Ptr BufferList
bufferList'
    Sample -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Sample
sample
    BufferList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BufferList
bufferList
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SampleSetBufferListMethodInfo
instance (signature ~ (Gst.BufferList.BufferList -> m ()), MonadIO m) => O.MethodInfo SampleSetBufferListMethodInfo Sample signature where
    overloadedMethod = sampleSetBufferList

#endif

-- method Sample::set_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sample"
--           , argType = TInterface Name { namespace = "Gst" , name = "Sample" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstSample" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caps"
--           , argType = TInterface Name { namespace = "Gst" , name = "Caps" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstCaps" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_sample_set_caps" gst_sample_set_caps :: 
    Ptr Sample ->                           -- sample : TInterface (Name {namespace = "Gst", name = "Sample"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO ()

-- | Set the caps associated with /@sample@/. /@sample@/ must be writable.
-- 
-- /Since: 1.16/
sampleSetCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Sample
    -- ^ /@sample@/: A t'GI.Gst.Structs.Sample.Sample'
    -> Gst.Caps.Caps
    -- ^ /@caps@/: A t'GI.Gst.Structs.Caps.Caps'
    -> m ()
sampleSetCaps :: Sample -> Caps -> m ()
sampleSetCaps sample :: Sample
sample caps :: Caps
caps = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sample
sample' <- Sample -> IO (Ptr Sample)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Sample
sample
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    Ptr Sample -> Ptr Caps -> IO ()
gst_sample_set_caps Ptr Sample
sample' Ptr Caps
caps'
    Sample -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Sample
sample
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SampleSetCapsMethodInfo
instance (signature ~ (Gst.Caps.Caps -> m ()), MonadIO m) => O.MethodInfo SampleSetCapsMethodInfo Sample signature where
    overloadedMethod = sampleSetCaps

#endif

-- method Sample::set_info
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sample"
--           , argType = TInterface Name { namespace = "Gst" , name = "Sample" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstSample" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Structure" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstStructure" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_sample_set_info" gst_sample_set_info :: 
    Ptr Sample ->                           -- sample : TInterface (Name {namespace = "Gst", name = "Sample"})
    Ptr Gst.Structure.Structure ->          -- info : TInterface (Name {namespace = "Gst", name = "Structure"})
    IO CInt

-- | Set the info structure associated with /@sample@/. /@sample@/ must be writable,
-- and /@info@/ must not have a parent set already.
-- 
-- /Since: 1.16/
sampleSetInfo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Sample
    -- ^ /@sample@/: A t'GI.Gst.Structs.Sample.Sample'
    -> Gst.Structure.Structure
    -- ^ /@info@/: A t'GI.Gst.Structs.Structure.Structure'
    -> m Bool
sampleSetInfo :: Sample -> Structure -> m Bool
sampleSetInfo sample :: Sample
sample info :: Structure
info = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sample
sample' <- Sample -> IO (Ptr Sample)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Sample
sample
    Ptr Structure
info' <- Structure -> IO (Ptr Structure)
forall a. (HasCallStack, BoxedObject a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Structure
info
    CInt
result <- Ptr Sample -> Ptr Structure -> IO CInt
gst_sample_set_info Ptr Sample
sample' Ptr Structure
info'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Sample -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Sample
sample
    Structure -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Structure
info
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SampleSetInfoMethodInfo
instance (signature ~ (Gst.Structure.Structure -> m Bool), MonadIO m) => O.MethodInfo SampleSetInfoMethodInfo Sample signature where
    overloadedMethod = sampleSetInfo

#endif

-- method Sample::set_segment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sample"
--           , argType = TInterface Name { namespace = "Gst" , name = "Sample" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstSample" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "segment"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Segment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstSegment" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_sample_set_segment" gst_sample_set_segment :: 
    Ptr Sample ->                           -- sample : TInterface (Name {namespace = "Gst", name = "Sample"})
    Ptr Gst.Segment.Segment ->              -- segment : TInterface (Name {namespace = "Gst", name = "Segment"})
    IO ()

-- | Set the segment associated with /@sample@/. /@sample@/ must be writable.
-- 
-- /Since: 1.16/
sampleSetSegment ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Sample
    -- ^ /@sample@/: A t'GI.Gst.Structs.Sample.Sample'
    -> Gst.Segment.Segment
    -- ^ /@segment@/: A t'GI.Gst.Structs.Segment.Segment'
    -> m ()
sampleSetSegment :: Sample -> Segment -> m ()
sampleSetSegment sample :: Sample
sample segment :: Segment
segment = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sample
sample' <- Sample -> IO (Ptr Sample)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Sample
sample
    Ptr Segment
segment' <- Segment -> IO (Ptr Segment)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Segment
segment
    Ptr Sample -> Ptr Segment -> IO ()
gst_sample_set_segment Ptr Sample
sample' Ptr Segment
segment'
    Sample -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Sample
sample
    Segment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Segment
segment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SampleSetSegmentMethodInfo
instance (signature ~ (Gst.Segment.Segment -> m ()), MonadIO m) => O.MethodInfo SampleSetSegmentMethodInfo Sample signature where
    overloadedMethod = sampleSetSegment

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSampleMethod (t :: Symbol) (o :: *) :: * where
    ResolveSampleMethod "getBuffer" o = SampleGetBufferMethodInfo
    ResolveSampleMethod "getBufferList" o = SampleGetBufferListMethodInfo
    ResolveSampleMethod "getCaps" o = SampleGetCapsMethodInfo
    ResolveSampleMethod "getInfo" o = SampleGetInfoMethodInfo
    ResolveSampleMethod "getSegment" o = SampleGetSegmentMethodInfo
    ResolveSampleMethod "setBuffer" o = SampleSetBufferMethodInfo
    ResolveSampleMethod "setBufferList" o = SampleSetBufferListMethodInfo
    ResolveSampleMethod "setCaps" o = SampleSetCapsMethodInfo
    ResolveSampleMethod "setInfo" o = SampleSetInfoMethodInfo
    ResolveSampleMethod "setSegment" o = SampleSetSegmentMethodInfo
    ResolveSampleMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveSampleMethod t Sample, O.MethodInfo info Sample p) => OL.IsLabel t (Sample -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif