{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An encoder for writing ancillary data to the
-- Vertical Blanking Interval lines of component signals.
-- 
-- /Since: 1.16/

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

module GI.GstVideo.Structs.VideoVBIEncoder
    ( 

-- * Exported types
    VideoVBIEncoder(..)                     ,
    noVideoVBIEncoder                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveVideoVBIEncoderMethod            ,
#endif


-- ** addAncillary #method:addAncillary#

#if defined(ENABLE_OVERLOADING)
    VideoVBIEncoderAddAncillaryMethodInfo   ,
#endif
    videoVBIEncoderAddAncillary             ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    VideoVBIEncoderCopyMethodInfo           ,
#endif
    videoVBIEncoderCopy                     ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    VideoVBIEncoderFreeMethodInfo           ,
#endif
    videoVBIEncoderFree                     ,


-- ** new #method:new#

    videoVBIEncoderNew                      ,


-- ** writeLine #method:writeLine#

#if defined(ENABLE_OVERLOADING)
    VideoVBIEncoderWriteLineMethodInfo      ,
#endif
    videoVBIEncoderWriteLine                ,




    ) 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.GstVideo.Enums as GstVideo.Enums

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

instance BoxedObject VideoVBIEncoder where
    boxedType :: VideoVBIEncoder -> IO GType
boxedType _ = IO GType
c_gst_video_vbi_encoder_get_type

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

-- | A convenience alias for `Nothing` :: `Maybe` `VideoVBIEncoder`.
noVideoVBIEncoder :: Maybe VideoVBIEncoder
noVideoVBIEncoder :: Maybe VideoVBIEncoder
noVideoVBIEncoder = Maybe VideoVBIEncoder
forall a. Maybe a
Nothing


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

-- method VideoVBIEncoder::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoFormat" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pixel_width"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The width in pixel to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "VideoVBIEncoder" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_vbi_encoder_new" gst_video_vbi_encoder_new :: 
    CUInt ->                                -- format : TInterface (Name {namespace = "GstVideo", name = "VideoFormat"})
    Word32 ->                               -- pixel_width : TBasicType TUInt32
    IO (Ptr VideoVBIEncoder)

-- | Create a new t'GI.GstVideo.Structs.VideoVBIEncoder.VideoVBIEncoder' for the specified /@format@/ and /@pixelWidth@/.
-- 
-- /Since: 1.16/
videoVBIEncoderNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GstVideo.Enums.VideoFormat
    -- ^ /@format@/: a t'GI.GstVideo.Enums.VideoFormat'
    -> Word32
    -- ^ /@pixelWidth@/: The width in pixel to use
    -> m VideoVBIEncoder
    -- ^ __Returns:__ The new t'GI.GstVideo.Structs.VideoVBIEncoder.VideoVBIEncoder' or 'P.Nothing' if the /@format@/ and\/or /@pixelWidth@/
    -- is not supported.
videoVBIEncoderNew :: VideoFormat -> Word32 -> m VideoVBIEncoder
videoVBIEncoderNew format :: VideoFormat
format pixelWidth :: Word32
pixelWidth = IO VideoVBIEncoder -> m VideoVBIEncoder
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoVBIEncoder -> m VideoVBIEncoder)
-> IO VideoVBIEncoder -> m VideoVBIEncoder
forall a b. (a -> b) -> a -> b
$ do
    let format' :: CUInt
format' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (VideoFormat -> Int) -> VideoFormat -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VideoFormat -> Int
forall a. Enum a => a -> Int
fromEnum) VideoFormat
format
    Ptr VideoVBIEncoder
result <- CUInt -> Word32 -> IO (Ptr VideoVBIEncoder)
gst_video_vbi_encoder_new CUInt
format' Word32
pixelWidth
    Text -> Ptr VideoVBIEncoder -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "videoVBIEncoderNew" Ptr VideoVBIEncoder
result
    VideoVBIEncoder
result' <- ((ManagedPtr VideoVBIEncoder -> VideoVBIEncoder)
-> Ptr VideoVBIEncoder -> IO VideoVBIEncoder
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoVBIEncoder -> VideoVBIEncoder
VideoVBIEncoder) Ptr VideoVBIEncoder
result
    VideoVBIEncoder -> IO VideoVBIEncoder
forall (m :: * -> *) a. Monad m => a -> m a
return VideoVBIEncoder
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method VideoVBIEncoder::add_ancillary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoVBIEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoVBIEncoder"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "composite"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%TRUE if composite ADF should be created, component otherwise"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "DID"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The Data Identifier"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "SDID_block_number"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The Secondary Data Identifier (if type 2) or the Data\n                    Block Number (if type 1)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 5 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The user data content of the Ancillary packet.\n   Does not contain the ADF, DID, SDID nor CS."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data_count"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The amount of data (in bytes) in @data (max 255 bytes)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "data_count"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just "The amount of data (in bytes) in @data (max 255 bytes)"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_vbi_encoder_add_ancillary" gst_video_vbi_encoder_add_ancillary :: 
    Ptr VideoVBIEncoder ->                  -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoVBIEncoder"})
    CInt ->                                 -- composite : TBasicType TBoolean
    Word8 ->                                -- DID : TBasicType TUInt8
    Word8 ->                                -- SDID_block_number : TBasicType TUInt8
    Ptr Word8 ->                            -- data : TCArray False (-1) 5 (TBasicType TUInt8)
    Word32 ->                               -- data_count : TBasicType TUInt
    IO CInt

-- | Stores Video Ancillary data, according to SMPTE-291M specification.
-- 
-- Note that the contents of the data are always read as 8bit data (i.e. do not contain
-- the parity check bits).
-- 
-- /Since: 1.16/
videoVBIEncoderAddAncillary ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoVBIEncoder
    -- ^ /@encoder@/: a t'GI.GstVideo.Structs.VideoVBIEncoder.VideoVBIEncoder'
    -> Bool
    -- ^ /@composite@/: 'P.True' if composite ADF should be created, component otherwise
    -> Word8
    -- ^ /@dID@/: The Data Identifier
    -> Word8
    -- ^ /@sDIDBlockNumber@/: The Secondary Data Identifier (if type 2) or the Data
    --                     Block Number (if type 1)
    -> ByteString
    -- ^ /@data@/: The user data content of the Ancillary packet.
    --    Does not contain the ADF, DID, SDID nor CS.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if enough space was left in the current line, 'P.False'
    --          otherwise.
videoVBIEncoderAddAncillary :: VideoVBIEncoder -> Bool -> Word8 -> Word8 -> ByteString -> m Bool
videoVBIEncoderAddAncillary encoder :: VideoVBIEncoder
encoder composite :: Bool
composite dID :: Word8
dID sDIDBlockNumber :: Word8
sDIDBlockNumber data_ :: ByteString
data_ = 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
    let dataCount :: Word32
dataCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr VideoVBIEncoder
encoder' <- VideoVBIEncoder -> IO (Ptr VideoVBIEncoder)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoVBIEncoder
encoder
    let composite' :: CInt
composite' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
composite
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    CInt
result <- Ptr VideoVBIEncoder
-> CInt -> Word8 -> Word8 -> Ptr Word8 -> Word32 -> IO CInt
gst_video_vbi_encoder_add_ancillary Ptr VideoVBIEncoder
encoder' CInt
composite' Word8
dID Word8
sDIDBlockNumber Ptr Word8
data_' Word32
dataCount
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    VideoVBIEncoder -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoVBIEncoder
encoder
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
data_'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoVBIEncoderAddAncillaryMethodInfo
instance (signature ~ (Bool -> Word8 -> Word8 -> ByteString -> m Bool), MonadIO m) => O.MethodInfo VideoVBIEncoderAddAncillaryMethodInfo VideoVBIEncoder signature where
    overloadedMethod = videoVBIEncoderAddAncillary

#endif

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

foreign import ccall "gst_video_vbi_encoder_copy" gst_video_vbi_encoder_copy :: 
    Ptr VideoVBIEncoder ->                  -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoVBIEncoder"})
    IO (Ptr VideoVBIEncoder)

-- | /No description available in the introspection data./
videoVBIEncoderCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoVBIEncoder
    -> m VideoVBIEncoder
videoVBIEncoderCopy :: VideoVBIEncoder -> m VideoVBIEncoder
videoVBIEncoderCopy encoder :: VideoVBIEncoder
encoder = IO VideoVBIEncoder -> m VideoVBIEncoder
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoVBIEncoder -> m VideoVBIEncoder)
-> IO VideoVBIEncoder -> m VideoVBIEncoder
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoVBIEncoder
encoder' <- VideoVBIEncoder -> IO (Ptr VideoVBIEncoder)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoVBIEncoder
encoder
    Ptr VideoVBIEncoder
result <- Ptr VideoVBIEncoder -> IO (Ptr VideoVBIEncoder)
gst_video_vbi_encoder_copy Ptr VideoVBIEncoder
encoder'
    Text -> Ptr VideoVBIEncoder -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "videoVBIEncoderCopy" Ptr VideoVBIEncoder
result
    VideoVBIEncoder
result' <- ((ManagedPtr VideoVBIEncoder -> VideoVBIEncoder)
-> Ptr VideoVBIEncoder -> IO VideoVBIEncoder
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoVBIEncoder -> VideoVBIEncoder
VideoVBIEncoder) Ptr VideoVBIEncoder
result
    VideoVBIEncoder -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoVBIEncoder
encoder
    VideoVBIEncoder -> IO VideoVBIEncoder
forall (m :: * -> *) a. Monad m => a -> m a
return VideoVBIEncoder
result'

#if defined(ENABLE_OVERLOADING)
data VideoVBIEncoderCopyMethodInfo
instance (signature ~ (m VideoVBIEncoder), MonadIO m) => O.MethodInfo VideoVBIEncoderCopyMethodInfo VideoVBIEncoder signature where
    overloadedMethod = videoVBIEncoderCopy

#endif

-- method VideoVBIEncoder::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoVBIEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoVBIEncoder"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_vbi_encoder_free" gst_video_vbi_encoder_free :: 
    Ptr VideoVBIEncoder ->                  -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoVBIEncoder"})
    IO ()

-- | Frees the /@encoder@/.
-- 
-- /Since: 1.16/
videoVBIEncoderFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoVBIEncoder
    -- ^ /@encoder@/: a t'GI.GstVideo.Structs.VideoVBIEncoder.VideoVBIEncoder'
    -> m ()
videoVBIEncoderFree :: VideoVBIEncoder -> m ()
videoVBIEncoderFree encoder :: VideoVBIEncoder
encoder = 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 VideoVBIEncoder
encoder' <- VideoVBIEncoder -> IO (Ptr VideoVBIEncoder)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoVBIEncoder
encoder
    Ptr VideoVBIEncoder -> IO ()
gst_video_vbi_encoder_free Ptr VideoVBIEncoder
encoder'
    VideoVBIEncoder -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoVBIEncoder
encoder
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoVBIEncoderFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo VideoVBIEncoderFreeMethodInfo VideoVBIEncoder signature where
    overloadedMethod = videoVBIEncoderFree

#endif

-- method VideoVBIEncoder::write_line
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "encoder"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoVBIEncoder" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_vbi_encoder_write_line" gst_video_vbi_encoder_write_line :: 
    Ptr VideoVBIEncoder ->                  -- encoder : TInterface (Name {namespace = "GstVideo", name = "VideoVBIEncoder"})
    Word8 ->                                -- data : TBasicType TUInt8
    IO ()

-- | /No description available in the introspection data./
videoVBIEncoderWriteLine ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoVBIEncoder
    -> Word8
    -> m ()
videoVBIEncoderWriteLine :: VideoVBIEncoder -> Word8 -> m ()
videoVBIEncoderWriteLine encoder :: VideoVBIEncoder
encoder data_ :: Word8
data_ = 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 VideoVBIEncoder
encoder' <- VideoVBIEncoder -> IO (Ptr VideoVBIEncoder)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoVBIEncoder
encoder
    Ptr VideoVBIEncoder -> Word8 -> IO ()
gst_video_vbi_encoder_write_line Ptr VideoVBIEncoder
encoder' Word8
data_
    VideoVBIEncoder -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoVBIEncoder
encoder
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoVBIEncoderWriteLineMethodInfo
instance (signature ~ (Word8 -> m ()), MonadIO m) => O.MethodInfo VideoVBIEncoderWriteLineMethodInfo VideoVBIEncoder signature where
    overloadedMethod = videoVBIEncoderWriteLine

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoVBIEncoderMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoVBIEncoderMethod "addAncillary" o = VideoVBIEncoderAddAncillaryMethodInfo
    ResolveVideoVBIEncoderMethod "copy" o = VideoVBIEncoderCopyMethodInfo
    ResolveVideoVBIEncoderMethod "free" o = VideoVBIEncoderFreeMethodInfo
    ResolveVideoVBIEncoderMethod "writeLine" o = VideoVBIEncoderWriteLineMethodInfo
    ResolveVideoVBIEncoderMethod l o = O.MethodResolutionFailed l o

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

#endif