{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Video Ancillary data, according to SMPTE-291M specification.
-- 
-- Note that the contents of the data are always stored as 8bit data (i.e. do not contain
-- the parity check bits).
-- 
-- /Since: 1.16/

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

module GI.GstVideo.Structs.VideoAncillary
    ( 

-- * Exported types
    VideoAncillary(..)                      ,
    newZeroVideoAncillary                   ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveVideoAncillaryMethod             ,
#endif



 -- * Properties


-- ** dID #attr:dID#
-- | The Data Identifier

    getVideoAncillaryDID                    ,
    setVideoAncillaryDID                    ,
#if defined(ENABLE_OVERLOADING)
    videoAncillary_dID                      ,
#endif


-- ** dataCount #attr:dataCount#
-- | The amount of data (in bytes) in /@data@/ (max 255 bytes)

    getVideoAncillaryDataCount              ,
    setVideoAncillaryDataCount              ,
#if defined(ENABLE_OVERLOADING)
    videoAncillary_dataCount                ,
#endif


-- ** sDIDBlockNumber #attr:sDIDBlockNumber#
-- | The Secondary Data Identifier (if type 2) or the Data
--                     Block Number (if type 1)

    getVideoAncillarySDIDBlockNumber        ,
    setVideoAncillarySDIDBlockNumber        ,
#if defined(ENABLE_OVERLOADING)
    videoAncillary_sDIDBlockNumber          ,
#endif




    ) 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.Coerce as Coerce
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


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

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

instance BoxedPtr VideoAncillary where
    boxedPtrCopy :: VideoAncillary -> IO VideoAncillary
boxedPtrCopy = \VideoAncillary
p -> VideoAncillary
-> (Ptr VideoAncillary -> IO VideoAncillary) -> IO VideoAncillary
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VideoAncillary
p (Int -> Ptr VideoAncillary -> IO (Ptr VideoAncillary)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
48 (Ptr VideoAncillary -> IO (Ptr VideoAncillary))
-> (Ptr VideoAncillary -> IO VideoAncillary)
-> Ptr VideoAncillary
-> IO VideoAncillary
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr VideoAncillary -> VideoAncillary)
-> Ptr VideoAncillary -> IO VideoAncillary
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr VideoAncillary -> VideoAncillary
VideoAncillary)
    boxedPtrFree :: VideoAncillary -> IO ()
boxedPtrFree = \VideoAncillary
x -> VideoAncillary -> (Ptr VideoAncillary -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr VideoAncillary
x Ptr VideoAncillary -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr VideoAncillary where
    boxedPtrCalloc :: IO (Ptr VideoAncillary)
boxedPtrCalloc = Int -> IO (Ptr VideoAncillary)
forall a. Int -> IO (Ptr a)
callocBytes Int
48


-- | Construct a `VideoAncillary` struct initialized to zero.
newZeroVideoAncillary :: MonadIO m => m VideoAncillary
newZeroVideoAncillary :: forall (m :: * -> *). MonadIO m => m VideoAncillary
newZeroVideoAncillary = IO VideoAncillary -> m VideoAncillary
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoAncillary -> m VideoAncillary)
-> IO VideoAncillary -> m VideoAncillary
forall a b. (a -> b) -> a -> b
$ IO (Ptr VideoAncillary)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr VideoAncillary)
-> (Ptr VideoAncillary -> IO VideoAncillary) -> IO VideoAncillary
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr VideoAncillary -> VideoAncillary)
-> Ptr VideoAncillary -> IO VideoAncillary
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr VideoAncillary -> VideoAncillary
VideoAncillary

instance tag ~ 'AttrSet => Constructible VideoAncillary tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr VideoAncillary -> VideoAncillary)
-> [AttrOp VideoAncillary tag] -> m VideoAncillary
new ManagedPtr VideoAncillary -> VideoAncillary
_ [AttrOp VideoAncillary tag]
attrs = do
        VideoAncillary
o <- m VideoAncillary
forall (m :: * -> *). MonadIO m => m VideoAncillary
newZeroVideoAncillary
        VideoAncillary -> [AttrOp VideoAncillary 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set VideoAncillary
o [AttrOp VideoAncillary tag]
[AttrOp VideoAncillary 'AttrSet]
attrs
        VideoAncillary -> m VideoAncillary
forall (m :: * -> *) a. Monad m => a -> m a
return VideoAncillary
o


-- | Get the value of the “@DID@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoAncillary #dID
-- @
getVideoAncillaryDID :: MonadIO m => VideoAncillary -> m Word8
getVideoAncillaryDID :: forall (m :: * -> *). MonadIO m => VideoAncillary -> m Word8
getVideoAncillaryDID VideoAncillary
s = IO Word8 -> m Word8
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ VideoAncillary -> (Ptr VideoAncillary -> IO Word8) -> IO Word8
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoAncillary
s ((Ptr VideoAncillary -> IO Word8) -> IO Word8)
-> (Ptr VideoAncillary -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr VideoAncillary
ptr -> do
    Word8
val <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoAncillary
ptr Ptr VideoAncillary -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO Word8
    Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
val

-- | Set the value of the “@DID@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoAncillary [ #dID 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoAncillaryDID :: MonadIO m => VideoAncillary -> Word8 -> m ()
setVideoAncillaryDID :: forall (m :: * -> *). MonadIO m => VideoAncillary -> Word8 -> m ()
setVideoAncillaryDID VideoAncillary
s Word8
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoAncillary -> (Ptr VideoAncillary -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoAncillary
s ((Ptr VideoAncillary -> IO ()) -> IO ())
-> (Ptr VideoAncillary -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoAncillary
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoAncillary
ptr Ptr VideoAncillary -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Word8
val :: Word8)

#if defined(ENABLE_OVERLOADING)
data VideoAncillaryDIDFieldInfo
instance AttrInfo VideoAncillaryDIDFieldInfo where
    type AttrBaseTypeConstraint VideoAncillaryDIDFieldInfo = (~) VideoAncillary
    type AttrAllowedOps VideoAncillaryDIDFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoAncillaryDIDFieldInfo = (~) Word8
    type AttrTransferTypeConstraint VideoAncillaryDIDFieldInfo = (~)Word8
    type AttrTransferType VideoAncillaryDIDFieldInfo = Word8
    type AttrGetType VideoAncillaryDIDFieldInfo = Word8
    type AttrLabel VideoAncillaryDIDFieldInfo = "DID"
    type AttrOrigin VideoAncillaryDIDFieldInfo = VideoAncillary
    attrGet = getVideoAncillaryDID
    attrSet = setVideoAncillaryDID
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoAncillary.dID"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoAncillary.html#g:attr:dID"
        })

videoAncillary_dID :: AttrLabelProxy "dID"
videoAncillary_dID = AttrLabelProxy

#endif


-- | Get the value of the “@SDID_block_number@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoAncillary #sDIDBlockNumber
-- @
getVideoAncillarySDIDBlockNumber :: MonadIO m => VideoAncillary -> m Word8
getVideoAncillarySDIDBlockNumber :: forall (m :: * -> *). MonadIO m => VideoAncillary -> m Word8
getVideoAncillarySDIDBlockNumber VideoAncillary
s = IO Word8 -> m Word8
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ VideoAncillary -> (Ptr VideoAncillary -> IO Word8) -> IO Word8
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoAncillary
s ((Ptr VideoAncillary -> IO Word8) -> IO Word8)
-> (Ptr VideoAncillary -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr VideoAncillary
ptr -> do
    Word8
val <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoAncillary
ptr Ptr VideoAncillary -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) :: IO Word8
    Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
val

-- | Set the value of the “@SDID_block_number@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoAncillary [ #sDIDBlockNumber 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoAncillarySDIDBlockNumber :: MonadIO m => VideoAncillary -> Word8 -> m ()
setVideoAncillarySDIDBlockNumber :: forall (m :: * -> *). MonadIO m => VideoAncillary -> Word8 -> m ()
setVideoAncillarySDIDBlockNumber VideoAncillary
s Word8
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoAncillary -> (Ptr VideoAncillary -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoAncillary
s ((Ptr VideoAncillary -> IO ()) -> IO ())
-> (Ptr VideoAncillary -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoAncillary
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoAncillary
ptr Ptr VideoAncillary -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Word8
val :: Word8)

#if defined(ENABLE_OVERLOADING)
data VideoAncillarySDIDBlockNumberFieldInfo
instance AttrInfo VideoAncillarySDIDBlockNumberFieldInfo where
    type AttrBaseTypeConstraint VideoAncillarySDIDBlockNumberFieldInfo = (~) VideoAncillary
    type AttrAllowedOps VideoAncillarySDIDBlockNumberFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoAncillarySDIDBlockNumberFieldInfo = (~) Word8
    type AttrTransferTypeConstraint VideoAncillarySDIDBlockNumberFieldInfo = (~)Word8
    type AttrTransferType VideoAncillarySDIDBlockNumberFieldInfo = Word8
    type AttrGetType VideoAncillarySDIDBlockNumberFieldInfo = Word8
    type AttrLabel VideoAncillarySDIDBlockNumberFieldInfo = "SDID_block_number"
    type AttrOrigin VideoAncillarySDIDBlockNumberFieldInfo = VideoAncillary
    attrGet = getVideoAncillarySDIDBlockNumber
    attrSet = setVideoAncillarySDIDBlockNumber
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoAncillary.sDIDBlockNumber"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoAncillary.html#g:attr:sDIDBlockNumber"
        })

videoAncillary_sDIDBlockNumber :: AttrLabelProxy "sDIDBlockNumber"
videoAncillary_sDIDBlockNumber = AttrLabelProxy

#endif


-- | Get the value of the “@data_count@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoAncillary #dataCount
-- @
getVideoAncillaryDataCount :: MonadIO m => VideoAncillary -> m Word8
getVideoAncillaryDataCount :: forall (m :: * -> *). MonadIO m => VideoAncillary -> m Word8
getVideoAncillaryDataCount VideoAncillary
s = IO Word8 -> m Word8
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ VideoAncillary -> (Ptr VideoAncillary -> IO Word8) -> IO Word8
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoAncillary
s ((Ptr VideoAncillary -> IO Word8) -> IO Word8)
-> (Ptr VideoAncillary -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr VideoAncillary
ptr -> do
    Word8
val <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoAncillary
ptr Ptr VideoAncillary -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) :: IO Word8
    Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
val

-- | Set the value of the “@data_count@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' videoAncillary [ #dataCount 'Data.GI.Base.Attributes.:=' value ]
-- @
setVideoAncillaryDataCount :: MonadIO m => VideoAncillary -> Word8 -> m ()
setVideoAncillaryDataCount :: forall (m :: * -> *). MonadIO m => VideoAncillary -> Word8 -> m ()
setVideoAncillaryDataCount VideoAncillary
s Word8
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ VideoAncillary -> (Ptr VideoAncillary -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoAncillary
s ((Ptr VideoAncillary -> IO ()) -> IO ())
-> (Ptr VideoAncillary -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr VideoAncillary
ptr -> do
    Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr VideoAncillary
ptr Ptr VideoAncillary -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
2) (Word8
val :: Word8)

#if defined(ENABLE_OVERLOADING)
data VideoAncillaryDataCountFieldInfo
instance AttrInfo VideoAncillaryDataCountFieldInfo where
    type AttrBaseTypeConstraint VideoAncillaryDataCountFieldInfo = (~) VideoAncillary
    type AttrAllowedOps VideoAncillaryDataCountFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoAncillaryDataCountFieldInfo = (~) Word8
    type AttrTransferTypeConstraint VideoAncillaryDataCountFieldInfo = (~)Word8
    type AttrTransferType VideoAncillaryDataCountFieldInfo = Word8
    type AttrGetType VideoAncillaryDataCountFieldInfo = Word8
    type AttrLabel VideoAncillaryDataCountFieldInfo = "data_count"
    type AttrOrigin VideoAncillaryDataCountFieldInfo = VideoAncillary
    attrGet = getVideoAncillaryDataCount
    attrSet = setVideoAncillaryDataCount
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoAncillary.dataCount"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.25/docs/GI-GstVideo-Structs-VideoAncillary.html#g:attr:dataCount"
        })

videoAncillary_dataCount :: AttrLabelProxy "dataCount"
videoAncillary_dataCount = AttrLabelProxy

#endif


-- XXX Skipped attribute for "VideoAncillary:data"
-- Not implemented: Don't know how to unpack C array of type TCArray False (-1) 2 (TBasicType TUInt8)

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoAncillary
type instance O.AttributeList VideoAncillary = VideoAncillaryAttributeList
type VideoAncillaryAttributeList = ('[ '("dID", VideoAncillaryDIDFieldInfo), '("sDIDBlockNumber", VideoAncillarySDIDBlockNumberFieldInfo), '("dataCount", VideoAncillaryDataCountFieldInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoAncillaryMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoAncillaryMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveVideoAncillaryMethod t VideoAncillary, O.OverloadedMethod info VideoAncillary p) => OL.IsLabel t (VideoAncillary -> 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 ~ ResolveVideoAncillaryMethod t VideoAncillary, O.OverloadedMethod info VideoAncillary p, R.HasField t VideoAncillary p) => R.HasField t VideoAncillary p where
    getField = O.overloadedMethod @info

#endif

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

#endif