{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A parser for detecting and extracting /@gstVideoAncillary@/ data from
-- 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.VideoVBIParser
    ( 

-- * Exported types
    VideoVBIParser(..)                      ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addLine]("GI.GstVideo.Structs.VideoVBIParser#g:method:addLine"), [copy]("GI.GstVideo.Structs.VideoVBIParser#g:method:copy"), [free]("GI.GstVideo.Structs.VideoVBIParser#g:method:free").
-- 
-- ==== Getters
-- [getAncillary]("GI.GstVideo.Structs.VideoVBIParser#g:method:getAncillary").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveVideoVBIParserMethod             ,
#endif

-- ** addLine #method:addLine#

#if defined(ENABLE_OVERLOADING)
    VideoVBIParserAddLineMethodInfo         ,
#endif
    videoVBIParserAddLine                   ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    VideoVBIParserCopyMethodInfo            ,
#endif
    videoVBIParserCopy                      ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    VideoVBIParserFreeMethodInfo            ,
#endif
    videoVBIParserFree                      ,


-- ** getAncillary #method:getAncillary#

#if defined(ENABLE_OVERLOADING)
    VideoVBIParserGetAncillaryMethodInfo    ,
#endif
    videoVBIParserGetAncillary              ,


-- ** new #method:new#

    videoVBIParserNew                       ,




    ) 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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
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 Control.Monad.IO.Class as MIO
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 qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoAncillary as GstVideo.VideoAncillary

-- | Memory-managed wrapper type.
newtype VideoVBIParser = VideoVBIParser (SP.ManagedPtr VideoVBIParser)
    deriving (VideoVBIParser -> VideoVBIParser -> Bool
(VideoVBIParser -> VideoVBIParser -> Bool)
-> (VideoVBIParser -> VideoVBIParser -> Bool) -> Eq VideoVBIParser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VideoVBIParser -> VideoVBIParser -> Bool
$c/= :: VideoVBIParser -> VideoVBIParser -> Bool
== :: VideoVBIParser -> VideoVBIParser -> Bool
$c== :: VideoVBIParser -> VideoVBIParser -> Bool
Eq)

instance SP.ManagedPtrNewtype VideoVBIParser where
    toManagedPtr :: VideoVBIParser -> ManagedPtr VideoVBIParser
toManagedPtr (VideoVBIParser ManagedPtr VideoVBIParser
p) = ManagedPtr VideoVBIParser
p

foreign import ccall "gst_video_vbi_parser_get_type" c_gst_video_vbi_parser_get_type :: 
    IO GType

type instance O.ParentTypes VideoVBIParser = '[]
instance O.HasParentTypes VideoVBIParser

instance B.Types.TypedObject VideoVBIParser where
    glibType :: IO GType
glibType = IO GType
c_gst_video_vbi_parser_get_type

instance B.Types.GBoxed VideoVBIParser

-- | Convert 'VideoVBIParser' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe VideoVBIParser) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_video_vbi_parser_get_type
    gvalueSet_ :: Ptr GValue -> Maybe VideoVBIParser -> IO ()
gvalueSet_ Ptr GValue
gv Maybe VideoVBIParser
P.Nothing = Ptr GValue -> Ptr VideoVBIParser -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr VideoVBIParser
forall a. Ptr a
FP.nullPtr :: FP.Ptr VideoVBIParser)
    gvalueSet_ Ptr GValue
gv (P.Just VideoVBIParser
obj) = VideoVBIParser -> (Ptr VideoVBIParser -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VideoVBIParser
obj (Ptr GValue -> Ptr VideoVBIParser -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe VideoVBIParser)
gvalueGet_ Ptr GValue
gv = do
        Ptr VideoVBIParser
ptr <- Ptr GValue -> IO (Ptr VideoVBIParser)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr VideoVBIParser)
        if Ptr VideoVBIParser
ptr Ptr VideoVBIParser -> Ptr VideoVBIParser -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr VideoVBIParser
forall a. Ptr a
FP.nullPtr
        then VideoVBIParser -> Maybe VideoVBIParser
forall a. a -> Maybe a
P.Just (VideoVBIParser -> Maybe VideoVBIParser)
-> IO VideoVBIParser -> IO (Maybe VideoVBIParser)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr VideoVBIParser -> VideoVBIParser)
-> Ptr VideoVBIParser -> IO VideoVBIParser
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr VideoVBIParser -> VideoVBIParser
VideoVBIParser Ptr VideoVBIParser
ptr
        else Maybe VideoVBIParser -> IO (Maybe VideoVBIParser)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoVBIParser
forall a. Maybe a
P.Nothing
        
    


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

-- method VideoVBIParser::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 = "VideoVBIParser" })
-- throws : False
-- Skip return : False

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

-- | Create a new t'GI.GstVideo.Structs.VideoVBIParser.VideoVBIParser' for the specified /@format@/ and /@pixelWidth@/.
-- 
-- /Since: 1.16/
videoVBIParserNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GstVideo.Enums.VideoFormat
    -- ^ /@format@/: a t'GI.GstVideo.Enums.VideoFormat'
    -> Word32
    -- ^ /@pixelWidth@/: The width in pixel to use
    -> m VideoVBIParser
    -- ^ __Returns:__ The new t'GI.GstVideo.Structs.VideoVBIParser.VideoVBIParser' or 'P.Nothing' if the /@format@/ and\/or /@pixelWidth@/
    -- is not supported.
videoVBIParserNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoFormat -> Word32 -> m VideoVBIParser
videoVBIParserNew VideoFormat
format Word32
pixelWidth = IO VideoVBIParser -> m VideoVBIParser
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoVBIParser -> m VideoVBIParser)
-> IO VideoVBIParser -> m VideoVBIParser
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 VideoVBIParser
result <- CUInt -> Word32 -> IO (Ptr VideoVBIParser)
gst_video_vbi_parser_new CUInt
format' Word32
pixelWidth
    Text -> Ptr VideoVBIParser -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoVBIParserNew" Ptr VideoVBIParser
result
    VideoVBIParser
result' <- ((ManagedPtr VideoVBIParser -> VideoVBIParser)
-> Ptr VideoVBIParser -> IO VideoVBIParser
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoVBIParser -> VideoVBIParser
VideoVBIParser) Ptr VideoVBIParser
result
    VideoVBIParser -> IO VideoVBIParser
forall (m :: * -> *) a. Monad m => a -> m a
return VideoVBIParser
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method VideoVBIParser::add_line
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parser"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoVBIParser" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoVBIParser"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) (-1) (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The line of data to parse"
--                 , 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_parser_add_line" gst_video_vbi_parser_add_line :: 
    Ptr VideoVBIParser ->                   -- parser : TInterface (Name {namespace = "GstVideo", name = "VideoVBIParser"})
    Ptr Word8 ->                            -- data : TCArray False (-1) (-1) (TBasicType TUInt8)
    IO ()

-- | Provide a new line of data to the /@parser@/. Call 'GI.GstVideo.Structs.VideoVBIParser.videoVBIParserGetAncillary'
-- to get the Ancillary data that might be present on that line.
-- 
-- /Since: 1.16/
videoVBIParserAddLine ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoVBIParser
    -- ^ /@parser@/: a t'GI.GstVideo.Structs.VideoVBIParser.VideoVBIParser'
    -> Ptr Word8
    -- ^ /@data@/: The line of data to parse
    -> m ()
videoVBIParserAddLine :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoVBIParser -> Ptr Word8 -> m ()
videoVBIParserAddLine VideoVBIParser
parser Ptr 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 VideoVBIParser
parser' <- VideoVBIParser -> IO (Ptr VideoVBIParser)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoVBIParser
parser
    Ptr VideoVBIParser -> Ptr Word8 -> IO ()
gst_video_vbi_parser_add_line Ptr VideoVBIParser
parser' Ptr Word8
data_
    VideoVBIParser -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoVBIParser
parser
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoVBIParserAddLineMethodInfo
instance (signature ~ (Ptr Word8 -> m ()), MonadIO m) => O.OverloadedMethod VideoVBIParserAddLineMethodInfo VideoVBIParser signature where
    overloadedMethod = videoVBIParserAddLine

instance O.OverloadedMethodInfo VideoVBIParserAddLineMethodInfo VideoVBIParser where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoVBIParser.videoVBIParserAddLine",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoVBIParser.html#v:videoVBIParserAddLine"
        }


#endif

-- method VideoVBIParser::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parser"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoVBIParser" }
--           , 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 = "VideoVBIParser" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_vbi_parser_copy" gst_video_vbi_parser_copy :: 
    Ptr VideoVBIParser ->                   -- parser : TInterface (Name {namespace = "GstVideo", name = "VideoVBIParser"})
    IO (Ptr VideoVBIParser)

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

#if defined(ENABLE_OVERLOADING)
data VideoVBIParserCopyMethodInfo
instance (signature ~ (m VideoVBIParser), MonadIO m) => O.OverloadedMethod VideoVBIParserCopyMethodInfo VideoVBIParser signature where
    overloadedMethod = videoVBIParserCopy

instance O.OverloadedMethodInfo VideoVBIParserCopyMethodInfo VideoVBIParser where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoVBIParser.videoVBIParserCopy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoVBIParser.html#v:videoVBIParserCopy"
        }


#endif

-- method VideoVBIParser::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parser"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoVBIParser" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoVBIParser"
--                 , 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_parser_free" gst_video_vbi_parser_free :: 
    Ptr VideoVBIParser ->                   -- parser : TInterface (Name {namespace = "GstVideo", name = "VideoVBIParser"})
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data VideoVBIParserFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod VideoVBIParserFreeMethodInfo VideoVBIParser signature where
    overloadedMethod = videoVBIParserFree

instance O.OverloadedMethodInfo VideoVBIParserFreeMethodInfo VideoVBIParser where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoVBIParser.videoVBIParserFree",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoVBIParser.html#v:videoVBIParserFree"
        }


#endif

-- method VideoVBIParser::get_ancillary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parser"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoVBIParser" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoVBIParser"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "anc"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoAncillary" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstVideoAncillary to start the eventual ancillary data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "VideoVBIParserResult" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_vbi_parser_get_ancillary" gst_video_vbi_parser_get_ancillary :: 
    Ptr VideoVBIParser ->                   -- parser : TInterface (Name {namespace = "GstVideo", name = "VideoVBIParser"})
    Ptr GstVideo.VideoAncillary.VideoAncillary -> -- anc : TInterface (Name {namespace = "GstVideo", name = "VideoAncillary"})
    IO CUInt

-- | Parse the line provided previously by 'GI.GstVideo.Structs.VideoVBIParser.videoVBIParserAddLine'.
-- 
-- /Since: 1.16/
videoVBIParserGetAncillary ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoVBIParser
    -- ^ /@parser@/: a t'GI.GstVideo.Structs.VideoVBIParser.VideoVBIParser'
    -> m ((GstVideo.Enums.VideoVBIParserResult, GstVideo.VideoAncillary.VideoAncillary))
    -- ^ __Returns:__ 'GI.GstVideo.Enums.VideoVBIParserResultOk' if ancillary data was found and
    -- /@anc@/ was filled. 'GI.GstVideo.Enums.VideoVBIParserResultDone' if there wasn\'t any
    -- data.
videoVBIParserGetAncillary :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoVBIParser -> m (VideoVBIParserResult, VideoAncillary)
videoVBIParserGetAncillary VideoVBIParser
parser = IO (VideoVBIParserResult, VideoAncillary)
-> m (VideoVBIParserResult, VideoAncillary)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (VideoVBIParserResult, VideoAncillary)
 -> m (VideoVBIParserResult, VideoAncillary))
-> IO (VideoVBIParserResult, VideoAncillary)
-> m (VideoVBIParserResult, VideoAncillary)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoVBIParser
parser' <- VideoVBIParser -> IO (Ptr VideoVBIParser)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoVBIParser
parser
    Ptr VideoAncillary
anc <- Int -> IO (Ptr VideoAncillary)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
48 :: IO (Ptr GstVideo.VideoAncillary.VideoAncillary)
    CUInt
result <- Ptr VideoVBIParser -> Ptr VideoAncillary -> IO CUInt
gst_video_vbi_parser_get_ancillary Ptr VideoVBIParser
parser' Ptr VideoAncillary
anc
    let result' :: VideoVBIParserResult
result' = (Int -> VideoVBIParserResult
forall a. Enum a => Int -> a
toEnum (Int -> VideoVBIParserResult)
-> (CUInt -> Int) -> CUInt -> VideoVBIParserResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    VideoAncillary
anc' <- ((ManagedPtr VideoAncillary -> VideoAncillary)
-> Ptr VideoAncillary -> IO VideoAncillary
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr VideoAncillary -> VideoAncillary
GstVideo.VideoAncillary.VideoAncillary) Ptr VideoAncillary
anc
    VideoVBIParser -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoVBIParser
parser
    (VideoVBIParserResult, VideoAncillary)
-> IO (VideoVBIParserResult, VideoAncillary)
forall (m :: * -> *) a. Monad m => a -> m a
return (VideoVBIParserResult
result', VideoAncillary
anc')

#if defined(ENABLE_OVERLOADING)
data VideoVBIParserGetAncillaryMethodInfo
instance (signature ~ (m ((GstVideo.Enums.VideoVBIParserResult, GstVideo.VideoAncillary.VideoAncillary))), MonadIO m) => O.OverloadedMethod VideoVBIParserGetAncillaryMethodInfo VideoVBIParser signature where
    overloadedMethod = videoVBIParserGetAncillary

instance O.OverloadedMethodInfo VideoVBIParserGetAncillaryMethodInfo VideoVBIParser where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GstVideo.Structs.VideoVBIParser.videoVBIParserGetAncillary",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.24/docs/GI-GstVideo-Structs-VideoVBIParser.html#v:videoVBIParserGetAncillary"
        }


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoVBIParserMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoVBIParserMethod "addLine" o = VideoVBIParserAddLineMethodInfo
    ResolveVideoVBIParserMethod "copy" o = VideoVBIParserCopyMethodInfo
    ResolveVideoVBIParserMethod "free" o = VideoVBIParserFreeMethodInfo
    ResolveVideoVBIParserMethod "getAncillary" o = VideoVBIParserGetAncillaryMethodInfo
    ResolveVideoVBIParserMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveVideoVBIParserMethod t VideoVBIParser, O.OverloadedMethod info VideoVBIParser p, R.HasField t VideoVBIParser p) => R.HasField t VideoVBIParser p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveVideoVBIParserMethod t VideoVBIParser, O.OverloadedMethodInfo info VideoVBIParser) => OL.IsLabel t (O.MethodProxy info VideoVBIParser) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif