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

Information describing image properties. This information can be filled
in from GstCaps with 'GI.GstVideo.Structs.VideoInfo.videoInfoFromCaps'. The information is also used
to store the specific video info when mapping a video frame with
'GI.GstVideo.Structs.VideoFrame.videoFrameMap'.

Use the provided macros to access the info in this structure.
-}

module GI.GstVideo.Structs.VideoInfo
    ( 

-- * Exported types
    VideoInfo(..)                           ,
    newZeroVideoInfo                        ,
    noVideoInfo                             ,


 -- * Methods
-- ** align #method:align#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    VideoInfoAlignMethodInfo                ,
#endif
    videoInfoAlign                          ,


-- ** convert #method:convert#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    VideoInfoConvertMethodInfo              ,
#endif
    videoInfoConvert                        ,


-- ** copy #method:copy#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    VideoInfoCopyMethodInfo                 ,
#endif
    videoInfoCopy                           ,


-- ** free #method:free#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    VideoInfoFreeMethodInfo                 ,
#endif
    videoInfoFree                           ,


-- ** fromCaps #method:fromCaps#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    VideoInfoFromCapsMethodInfo             ,
#endif
    videoInfoFromCaps                       ,


-- ** init #method:init#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    VideoInfoInitMethodInfo                 ,
#endif
    videoInfoInit                           ,


-- ** isEqual #method:isEqual#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    VideoInfoIsEqualMethodInfo              ,
#endif
    videoInfoIsEqual                        ,


-- ** new #method:new#
    videoInfoNew                            ,


-- ** setFormat #method:setFormat#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    VideoInfoSetFormatMethodInfo            ,
#endif
    videoInfoSetFormat                      ,


-- ** toCaps #method:toCaps#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    VideoInfoToCapsMethodInfo               ,
#endif
    videoInfoToCaps                         ,




 -- * Properties
-- ** chromaSite #attr:chromaSite#
    getVideoInfoChromaSite                  ,
    setVideoInfoChromaSite                  ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoInfo_chromaSite                    ,
#endif


-- ** colorimetry #attr:colorimetry#
    getVideoInfoColorimetry                 ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoInfo_colorimetry                   ,
#endif


-- ** finfo #attr:finfo#
    clearVideoInfoFinfo                     ,
    getVideoInfoFinfo                       ,
    setVideoInfoFinfo                       ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoInfo_finfo                         ,
#endif


-- ** flags #attr:flags#
    getVideoInfoFlags                       ,
    setVideoInfoFlags                       ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoInfo_flags                         ,
#endif


-- ** fpsD #attr:fpsD#
    getVideoInfoFpsD                        ,
    setVideoInfoFpsD                        ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoInfo_fpsD                          ,
#endif


-- ** fpsN #attr:fpsN#
    getVideoInfoFpsN                        ,
    setVideoInfoFpsN                        ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoInfo_fpsN                          ,
#endif


-- ** height #attr:height#
    getVideoInfoHeight                      ,
    setVideoInfoHeight                      ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoInfo_height                        ,
#endif


-- ** interlaceMode #attr:interlaceMode#
    getVideoInfoInterlaceMode               ,
    setVideoInfoInterlaceMode               ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoInfo_interlaceMode                 ,
#endif


-- ** parD #attr:parD#
    getVideoInfoParD                        ,
    setVideoInfoParD                        ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoInfo_parD                          ,
#endif


-- ** parN #attr:parN#
    getVideoInfoParN                        ,
    setVideoInfoParN                        ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoInfo_parN                          ,
#endif


-- ** size #attr:size#
    getVideoInfoSize                        ,
    setVideoInfoSize                        ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoInfo_size                          ,
#endif


-- ** views #attr:views#
    getVideoInfoViews                       ,
    setVideoInfoViews                       ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoInfo_views                         ,
#endif


-- ** width #attr:width#
    getVideoInfoWidth                       ,
    setVideoInfoWidth                       ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    videoInfo_width                         ,
#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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP

import qualified GI.Gst.Enums as Gst.Enums
import qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.GstVideo.Enums as GstVideo.Enums
import {-# SOURCE #-} qualified GI.GstVideo.Flags as GstVideo.Flags
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoAlignment as GstVideo.VideoAlignment
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoColorimetry as GstVideo.VideoColorimetry
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoFormatInfo as GstVideo.VideoFormatInfo

newtype VideoInfo = VideoInfo (ManagedPtr VideoInfo)
foreign import ccall "gst_video_info_get_type" c_gst_video_info_get_type :: 
    IO GType

instance BoxedObject VideoInfo where
    boxedType _ = c_gst_video_info_get_type

-- | Construct a `VideoInfo` struct initialized to zero.
newZeroVideoInfo :: MonadIO m => m VideoInfo
newZeroVideoInfo = liftIO $ callocBoxedBytes 120 >>= wrapBoxed VideoInfo

instance tag ~ 'AttrSet => Constructible VideoInfo tag where
    new _ attrs = do
        o <- newZeroVideoInfo
        GI.Attributes.set o attrs
        return o


noVideoInfo :: Maybe VideoInfo
noVideoInfo = Nothing

getVideoInfoFinfo :: MonadIO m => VideoInfo -> m (Maybe GstVideo.VideoFormatInfo.VideoFormatInfo)
getVideoInfoFinfo s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO (Ptr GstVideo.VideoFormatInfo.VideoFormatInfo)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- (newPtr GstVideo.VideoFormatInfo.VideoFormatInfo) val'
        return val''
    return result

setVideoInfoFinfo :: MonadIO m => VideoInfo -> Ptr GstVideo.VideoFormatInfo.VideoFormatInfo -> m ()
setVideoInfoFinfo s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Ptr GstVideo.VideoFormatInfo.VideoFormatInfo)

clearVideoInfoFinfo :: MonadIO m => VideoInfo -> m ()
clearVideoInfoFinfo s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullPtr :: Ptr GstVideo.VideoFormatInfo.VideoFormatInfo)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoFinfoFieldInfo
instance AttrInfo VideoInfoFinfoFieldInfo where
    type AttrAllowedOps VideoInfoFinfoFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint VideoInfoFinfoFieldInfo = (~) (Ptr GstVideo.VideoFormatInfo.VideoFormatInfo)
    type AttrBaseTypeConstraint VideoInfoFinfoFieldInfo = (~) VideoInfo
    type AttrGetType VideoInfoFinfoFieldInfo = Maybe GstVideo.VideoFormatInfo.VideoFormatInfo
    type AttrLabel VideoInfoFinfoFieldInfo = "finfo"
    type AttrOrigin VideoInfoFinfoFieldInfo = VideoInfo
    attrGet _ = getVideoInfoFinfo
    attrSet _ = setVideoInfoFinfo
    attrConstruct = undefined
    attrClear _ = clearVideoInfoFinfo

videoInfo_finfo :: AttrLabelProxy "finfo"
videoInfo_finfo = AttrLabelProxy

#endif


getVideoInfoInterlaceMode :: MonadIO m => VideoInfo -> m GstVideo.Enums.VideoInterlaceMode
getVideoInfoInterlaceMode s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CUInt
    let val' = (toEnum . fromIntegral) val
    return val'

setVideoInfoInterlaceMode :: MonadIO m => VideoInfo -> GstVideo.Enums.VideoInterlaceMode -> m ()
setVideoInfoInterlaceMode s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 8) (val' :: CUInt)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoInterlaceModeFieldInfo
instance AttrInfo VideoInfoInterlaceModeFieldInfo where
    type AttrAllowedOps VideoInfoInterlaceModeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoInterlaceModeFieldInfo = (~) GstVideo.Enums.VideoInterlaceMode
    type AttrBaseTypeConstraint VideoInfoInterlaceModeFieldInfo = (~) VideoInfo
    type AttrGetType VideoInfoInterlaceModeFieldInfo = GstVideo.Enums.VideoInterlaceMode
    type AttrLabel VideoInfoInterlaceModeFieldInfo = "interlace_mode"
    type AttrOrigin VideoInfoInterlaceModeFieldInfo = VideoInfo
    attrGet _ = getVideoInfoInterlaceMode
    attrSet _ = setVideoInfoInterlaceMode
    attrConstruct = undefined
    attrClear _ = undefined

videoInfo_interlaceMode :: AttrLabelProxy "interlaceMode"
videoInfo_interlaceMode = AttrLabelProxy

#endif


getVideoInfoFlags :: MonadIO m => VideoInfo -> m [GstVideo.Flags.VideoFlags]
getVideoInfoFlags s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 12) :: IO CUInt
    let val' = wordToGFlags val
    return val'

setVideoInfoFlags :: MonadIO m => VideoInfo -> [GstVideo.Flags.VideoFlags] -> m ()
setVideoInfoFlags s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = gflagsToWord val
    poke (ptr `plusPtr` 12) (val' :: CUInt)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoFlagsFieldInfo
instance AttrInfo VideoInfoFlagsFieldInfo where
    type AttrAllowedOps VideoInfoFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoFlagsFieldInfo = (~) [GstVideo.Flags.VideoFlags]
    type AttrBaseTypeConstraint VideoInfoFlagsFieldInfo = (~) VideoInfo
    type AttrGetType VideoInfoFlagsFieldInfo = [GstVideo.Flags.VideoFlags]
    type AttrLabel VideoInfoFlagsFieldInfo = "flags"
    type AttrOrigin VideoInfoFlagsFieldInfo = VideoInfo
    attrGet _ = getVideoInfoFlags
    attrSet _ = setVideoInfoFlags
    attrConstruct = undefined
    attrClear _ = undefined

videoInfo_flags :: AttrLabelProxy "flags"
videoInfo_flags = AttrLabelProxy

#endif


getVideoInfoWidth :: MonadIO m => VideoInfo -> m Int32
getVideoInfoWidth s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO Int32
    return val

setVideoInfoWidth :: MonadIO m => VideoInfo -> Int32 -> m ()
setVideoInfoWidth s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: Int32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoWidthFieldInfo
instance AttrInfo VideoInfoWidthFieldInfo where
    type AttrAllowedOps VideoInfoWidthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoWidthFieldInfo = (~) Int32
    type AttrBaseTypeConstraint VideoInfoWidthFieldInfo = (~) VideoInfo
    type AttrGetType VideoInfoWidthFieldInfo = Int32
    type AttrLabel VideoInfoWidthFieldInfo = "width"
    type AttrOrigin VideoInfoWidthFieldInfo = VideoInfo
    attrGet _ = getVideoInfoWidth
    attrSet _ = setVideoInfoWidth
    attrConstruct = undefined
    attrClear _ = undefined

videoInfo_width :: AttrLabelProxy "width"
videoInfo_width = AttrLabelProxy

#endif


getVideoInfoHeight :: MonadIO m => VideoInfo -> m Int32
getVideoInfoHeight s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 20) :: IO Int32
    return val

setVideoInfoHeight :: MonadIO m => VideoInfo -> Int32 -> m ()
setVideoInfoHeight s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 20) (val :: Int32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoHeightFieldInfo
instance AttrInfo VideoInfoHeightFieldInfo where
    type AttrAllowedOps VideoInfoHeightFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoHeightFieldInfo = (~) Int32
    type AttrBaseTypeConstraint VideoInfoHeightFieldInfo = (~) VideoInfo
    type AttrGetType VideoInfoHeightFieldInfo = Int32
    type AttrLabel VideoInfoHeightFieldInfo = "height"
    type AttrOrigin VideoInfoHeightFieldInfo = VideoInfo
    attrGet _ = getVideoInfoHeight
    attrSet _ = setVideoInfoHeight
    attrConstruct = undefined
    attrClear _ = undefined

videoInfo_height :: AttrLabelProxy "height"
videoInfo_height = AttrLabelProxy

#endif


getVideoInfoSize :: MonadIO m => VideoInfo -> m Word64
getVideoInfoSize s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO Word64
    return val

setVideoInfoSize :: MonadIO m => VideoInfo -> Word64 -> m ()
setVideoInfoSize s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (val :: Word64)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoSizeFieldInfo
instance AttrInfo VideoInfoSizeFieldInfo where
    type AttrAllowedOps VideoInfoSizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoSizeFieldInfo = (~) Word64
    type AttrBaseTypeConstraint VideoInfoSizeFieldInfo = (~) VideoInfo
    type AttrGetType VideoInfoSizeFieldInfo = Word64
    type AttrLabel VideoInfoSizeFieldInfo = "size"
    type AttrOrigin VideoInfoSizeFieldInfo = VideoInfo
    attrGet _ = getVideoInfoSize
    attrSet _ = setVideoInfoSize
    attrConstruct = undefined
    attrClear _ = undefined

videoInfo_size :: AttrLabelProxy "size"
videoInfo_size = AttrLabelProxy

#endif


getVideoInfoViews :: MonadIO m => VideoInfo -> m Int32
getVideoInfoViews s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 32) :: IO Int32
    return val

setVideoInfoViews :: MonadIO m => VideoInfo -> Int32 -> m ()
setVideoInfoViews s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 32) (val :: Int32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoViewsFieldInfo
instance AttrInfo VideoInfoViewsFieldInfo where
    type AttrAllowedOps VideoInfoViewsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoViewsFieldInfo = (~) Int32
    type AttrBaseTypeConstraint VideoInfoViewsFieldInfo = (~) VideoInfo
    type AttrGetType VideoInfoViewsFieldInfo = Int32
    type AttrLabel VideoInfoViewsFieldInfo = "views"
    type AttrOrigin VideoInfoViewsFieldInfo = VideoInfo
    attrGet _ = getVideoInfoViews
    attrSet _ = setVideoInfoViews
    attrConstruct = undefined
    attrClear _ = undefined

videoInfo_views :: AttrLabelProxy "views"
videoInfo_views = AttrLabelProxy

#endif


getVideoInfoChromaSite :: MonadIO m => VideoInfo -> m [GstVideo.Flags.VideoChromaSite]
getVideoInfoChromaSite s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 36) :: IO CUInt
    let val' = wordToGFlags val
    return val'

setVideoInfoChromaSite :: MonadIO m => VideoInfo -> [GstVideo.Flags.VideoChromaSite] -> m ()
setVideoInfoChromaSite s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = gflagsToWord val
    poke (ptr `plusPtr` 36) (val' :: CUInt)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoChromaSiteFieldInfo
instance AttrInfo VideoInfoChromaSiteFieldInfo where
    type AttrAllowedOps VideoInfoChromaSiteFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoChromaSiteFieldInfo = (~) [GstVideo.Flags.VideoChromaSite]
    type AttrBaseTypeConstraint VideoInfoChromaSiteFieldInfo = (~) VideoInfo
    type AttrGetType VideoInfoChromaSiteFieldInfo = [GstVideo.Flags.VideoChromaSite]
    type AttrLabel VideoInfoChromaSiteFieldInfo = "chroma_site"
    type AttrOrigin VideoInfoChromaSiteFieldInfo = VideoInfo
    attrGet _ = getVideoInfoChromaSite
    attrSet _ = setVideoInfoChromaSite
    attrConstruct = undefined
    attrClear _ = undefined

videoInfo_chromaSite :: AttrLabelProxy "chromaSite"
videoInfo_chromaSite = AttrLabelProxy

#endif


getVideoInfoColorimetry :: MonadIO m => VideoInfo -> m GstVideo.VideoColorimetry.VideoColorimetry
getVideoInfoColorimetry s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 40 :: (Ptr GstVideo.VideoColorimetry.VideoColorimetry)
    val' <- (newPtr GstVideo.VideoColorimetry.VideoColorimetry) val
    return val'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoColorimetryFieldInfo
instance AttrInfo VideoInfoColorimetryFieldInfo where
    type AttrAllowedOps VideoInfoColorimetryFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint VideoInfoColorimetryFieldInfo = (~) (Ptr GstVideo.VideoColorimetry.VideoColorimetry)
    type AttrBaseTypeConstraint VideoInfoColorimetryFieldInfo = (~) VideoInfo
    type AttrGetType VideoInfoColorimetryFieldInfo = GstVideo.VideoColorimetry.VideoColorimetry
    type AttrLabel VideoInfoColorimetryFieldInfo = "colorimetry"
    type AttrOrigin VideoInfoColorimetryFieldInfo = VideoInfo
    attrGet _ = getVideoInfoColorimetry
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

videoInfo_colorimetry :: AttrLabelProxy "colorimetry"
videoInfo_colorimetry = AttrLabelProxy

#endif


getVideoInfoParN :: MonadIO m => VideoInfo -> m Int32
getVideoInfoParN s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 56) :: IO Int32
    return val

setVideoInfoParN :: MonadIO m => VideoInfo -> Int32 -> m ()
setVideoInfoParN s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 56) (val :: Int32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoParNFieldInfo
instance AttrInfo VideoInfoParNFieldInfo where
    type AttrAllowedOps VideoInfoParNFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoParNFieldInfo = (~) Int32
    type AttrBaseTypeConstraint VideoInfoParNFieldInfo = (~) VideoInfo
    type AttrGetType VideoInfoParNFieldInfo = Int32
    type AttrLabel VideoInfoParNFieldInfo = "par_n"
    type AttrOrigin VideoInfoParNFieldInfo = VideoInfo
    attrGet _ = getVideoInfoParN
    attrSet _ = setVideoInfoParN
    attrConstruct = undefined
    attrClear _ = undefined

videoInfo_parN :: AttrLabelProxy "parN"
videoInfo_parN = AttrLabelProxy

#endif


getVideoInfoParD :: MonadIO m => VideoInfo -> m Int32
getVideoInfoParD s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 60) :: IO Int32
    return val

setVideoInfoParD :: MonadIO m => VideoInfo -> Int32 -> m ()
setVideoInfoParD s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 60) (val :: Int32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoParDFieldInfo
instance AttrInfo VideoInfoParDFieldInfo where
    type AttrAllowedOps VideoInfoParDFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoParDFieldInfo = (~) Int32
    type AttrBaseTypeConstraint VideoInfoParDFieldInfo = (~) VideoInfo
    type AttrGetType VideoInfoParDFieldInfo = Int32
    type AttrLabel VideoInfoParDFieldInfo = "par_d"
    type AttrOrigin VideoInfoParDFieldInfo = VideoInfo
    attrGet _ = getVideoInfoParD
    attrSet _ = setVideoInfoParD
    attrConstruct = undefined
    attrClear _ = undefined

videoInfo_parD :: AttrLabelProxy "parD"
videoInfo_parD = AttrLabelProxy

#endif


getVideoInfoFpsN :: MonadIO m => VideoInfo -> m Int32
getVideoInfoFpsN s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 64) :: IO Int32
    return val

setVideoInfoFpsN :: MonadIO m => VideoInfo -> Int32 -> m ()
setVideoInfoFpsN s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 64) (val :: Int32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoFpsNFieldInfo
instance AttrInfo VideoInfoFpsNFieldInfo where
    type AttrAllowedOps VideoInfoFpsNFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoFpsNFieldInfo = (~) Int32
    type AttrBaseTypeConstraint VideoInfoFpsNFieldInfo = (~) VideoInfo
    type AttrGetType VideoInfoFpsNFieldInfo = Int32
    type AttrLabel VideoInfoFpsNFieldInfo = "fps_n"
    type AttrOrigin VideoInfoFpsNFieldInfo = VideoInfo
    attrGet _ = getVideoInfoFpsN
    attrSet _ = setVideoInfoFpsN
    attrConstruct = undefined
    attrClear _ = undefined

videoInfo_fpsN :: AttrLabelProxy "fpsN"
videoInfo_fpsN = AttrLabelProxy

#endif


getVideoInfoFpsD :: MonadIO m => VideoInfo -> m Int32
getVideoInfoFpsD s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 68) :: IO Int32
    return val

setVideoInfoFpsD :: MonadIO m => VideoInfo -> Int32 -> m ()
setVideoInfoFpsD s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 68) (val :: Int32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoFpsDFieldInfo
instance AttrInfo VideoInfoFpsDFieldInfo where
    type AttrAllowedOps VideoInfoFpsDFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint VideoInfoFpsDFieldInfo = (~) Int32
    type AttrBaseTypeConstraint VideoInfoFpsDFieldInfo = (~) VideoInfo
    type AttrGetType VideoInfoFpsDFieldInfo = Int32
    type AttrLabel VideoInfoFpsDFieldInfo = "fps_d"
    type AttrOrigin VideoInfoFpsDFieldInfo = VideoInfo
    attrGet _ = getVideoInfoFpsD
    attrSet _ = setVideoInfoFpsD
    attrConstruct = undefined
    attrClear _ = undefined

videoInfo_fpsD :: AttrLabelProxy "fpsD"
videoInfo_fpsD = AttrLabelProxy

#endif


-- XXX Skipped attribute for "VideoInfo:offset" :: Not implemented: "Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TUInt64)"
-- XXX Skipped attribute for "VideoInfo:stride" :: Not implemented: "Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TInt)"

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList VideoInfo
type instance O.AttributeList VideoInfo = VideoInfoAttributeList
type VideoInfoAttributeList = ('[ '("finfo", VideoInfoFinfoFieldInfo), '("interlaceMode", VideoInfoInterlaceModeFieldInfo), '("flags", VideoInfoFlagsFieldInfo), '("width", VideoInfoWidthFieldInfo), '("height", VideoInfoHeightFieldInfo), '("size", VideoInfoSizeFieldInfo), '("views", VideoInfoViewsFieldInfo), '("chromaSite", VideoInfoChromaSiteFieldInfo), '("colorimetry", VideoInfoColorimetryFieldInfo), '("parN", VideoInfoParNFieldInfo), '("parD", VideoInfoParDFieldInfo), '("fpsN", VideoInfoFpsNFieldInfo), '("fpsD", VideoInfoFpsDFieldInfo)] :: [(Symbol, *)])
#endif

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

foreign import ccall "gst_video_info_new" gst_video_info_new :: 
    IO (Ptr VideoInfo)

{- |
Allocate a new 'GI.GstVideo.Structs.VideoInfo.VideoInfo' that is also initialized with
'GI.GstVideo.Structs.VideoInfo.videoInfoInit'.

@since 1.6
-}
videoInfoNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m VideoInfo
    {- ^ __Returns:__ a new 'GI.GstVideo.Structs.VideoInfo.VideoInfo'. free with 'GI.GstVideo.Structs.VideoInfo.videoInfoFree'. -}
videoInfoNew  = liftIO $ do
    result <- gst_video_info_new
    checkUnexpectedReturnNULL "videoInfoNew" result
    result' <- (wrapBoxed VideoInfo) result
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
#endif

-- method VideoInfo::align
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "info", argType = TInterface (Name {namespace = "GstVideo", name = "VideoInfo"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstVideoInfo", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "align", argType = TInterface (Name {namespace = "GstVideo", name = "VideoAlignment"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "alignment parameters", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_info_align" gst_video_info_align :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    Ptr GstVideo.VideoAlignment.VideoAlignment -> -- align : TInterface (Name {namespace = "GstVideo", name = "VideoAlignment"})
    IO CInt

{- |
Adjust the offset and stride fields in /@info@/ so that the padding and
stride alignment in /@align@/ is respected.

Extra padding will be added to the right side when stride alignment padding
is required and /@align@/ will be updated with the new padding values.
-}
videoInfoAlign ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    {- ^ /@info@/: a 'GI.GstVideo.Structs.VideoInfo.VideoInfo' -}
    -> GstVideo.VideoAlignment.VideoAlignment
    {- ^ /@align@/: alignment parameters -}
    -> m Bool
    {- ^ __Returns:__ 'False' if alignment could not be applied, e.g. because the
  size of a frame can\'t be represented as a 32 bit integer (Since: 1.12) -}
videoInfoAlign info align = liftIO $ do
    info' <- unsafeManagedPtrGetPtr info
    align' <- unsafeManagedPtrGetPtr align
    result <- gst_video_info_align info' align'
    let result' = (/= 0) result
    touchManagedPtr info
    touchManagedPtr align
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoAlignMethodInfo
instance (signature ~ (GstVideo.VideoAlignment.VideoAlignment -> m Bool), MonadIO m) => O.MethodInfo VideoInfoAlignMethodInfo VideoInfo signature where
    overloadedMethod _ = videoInfoAlign

#endif

-- method VideoInfo::convert
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "info", argType = TInterface (Name {namespace = "GstVideo", name = "VideoInfo"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstVideoInfo", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "src_format", argType = TInterface (Name {namespace = "Gst", name = "Format"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "#GstFormat of the @src_value", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "src_value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "value to convert", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "dest_format", argType = TInterface (Name {namespace = "Gst", name = "Format"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "#GstFormat of the @dest_value", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "dest_value", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "pointer to destination value", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_info_convert" gst_video_info_convert :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    CUInt ->                                -- src_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- src_value : TBasicType TInt64
    CUInt ->                                -- dest_format : TInterface (Name {namespace = "Gst", name = "Format"})
    Int64 ->                                -- dest_value : TBasicType TInt64
    IO CInt

{- |
Converts among various 'GI.Gst.Enums.Format' types.  This function handles
GST_FORMAT_BYTES, GST_FORMAT_TIME, and GST_FORMAT_DEFAULT.  For
raw video, GST_FORMAT_DEFAULT corresponds to video frames.  This
function can be used to handle pad queries of the type GST_QUERY_CONVERT.
-}
videoInfoConvert ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    {- ^ /@info@/: a 'GI.GstVideo.Structs.VideoInfo.VideoInfo' -}
    -> Gst.Enums.Format
    {- ^ /@srcFormat@/: 'GI.Gst.Enums.Format' of the /@srcValue@/ -}
    -> Int64
    {- ^ /@srcValue@/: value to convert -}
    -> Gst.Enums.Format
    {- ^ /@destFormat@/: 'GI.Gst.Enums.Format' of the /@destValue@/ -}
    -> Int64
    {- ^ /@destValue@/: pointer to destination value -}
    -> m Bool
    {- ^ __Returns:__ TRUE if the conversion was successful. -}
videoInfoConvert info srcFormat srcValue destFormat destValue = liftIO $ do
    info' <- unsafeManagedPtrGetPtr info
    let srcFormat' = (fromIntegral . fromEnum) srcFormat
    let destFormat' = (fromIntegral . fromEnum) destFormat
    result <- gst_video_info_convert info' srcFormat' srcValue destFormat' destValue
    let result' = (/= 0) result
    touchManagedPtr info
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoConvertMethodInfo
instance (signature ~ (Gst.Enums.Format -> Int64 -> Gst.Enums.Format -> Int64 -> m Bool), MonadIO m) => O.MethodInfo VideoInfoConvertMethodInfo VideoInfo signature where
    overloadedMethod _ = videoInfoConvert

#endif

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

foreign import ccall "gst_video_info_copy" gst_video_info_copy :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    IO (Ptr VideoInfo)

{- |
Copy a GstVideoInfo structure.

@since 1.6
-}
videoInfoCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    {- ^ /@info@/: a 'GI.GstVideo.Structs.VideoInfo.VideoInfo' -}
    -> m VideoInfo
    {- ^ __Returns:__ a new 'GI.GstVideo.Structs.VideoInfo.VideoInfo'. free with gst_video_info_free. -}
videoInfoCopy info = liftIO $ do
    info' <- unsafeManagedPtrGetPtr info
    result <- gst_video_info_copy info'
    checkUnexpectedReturnNULL "videoInfoCopy" result
    result' <- (wrapBoxed VideoInfo) result
    touchManagedPtr info
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoCopyMethodInfo
instance (signature ~ (m VideoInfo), MonadIO m) => O.MethodInfo VideoInfoCopyMethodInfo VideoInfo signature where
    overloadedMethod _ = videoInfoCopy

#endif

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

{- |
Free a GstVideoInfo structure previously allocated with 'GI.GstVideo.Structs.VideoInfo.videoInfoNew'
or 'GI.GstVideo.Structs.VideoInfo.videoInfoCopy'.

@since 1.6
-}
videoInfoFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    {- ^ /@info@/: a 'GI.GstVideo.Structs.VideoInfo.VideoInfo' -}
    -> m ()
videoInfoFree info = liftIO $ do
    info' <- unsafeManagedPtrGetPtr info
    gst_video_info_free info'
    touchManagedPtr info
    return ()

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo VideoInfoFreeMethodInfo VideoInfo signature where
    overloadedMethod _ = videoInfoFree

#endif

-- method VideoInfo::from_caps
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "info", argType = TInterface (Name {namespace = "GstVideo", name = "VideoInfo"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstVideoInfo", 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 : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_info_from_caps" gst_video_info_from_caps :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

{- |
Parse /@caps@/ and update /@info@/.
-}
videoInfoFromCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    {- ^ /@info@/: a 'GI.GstVideo.Structs.VideoInfo.VideoInfo' -}
    -> Gst.Caps.Caps
    {- ^ /@caps@/: a 'GI.Gst.Structs.Caps.Caps' -}
    -> m Bool
    {- ^ __Returns:__ TRUE if /@caps@/ could be parsed -}
videoInfoFromCaps info caps = liftIO $ do
    info' <- unsafeManagedPtrGetPtr info
    caps' <- unsafeManagedPtrGetPtr caps
    result <- gst_video_info_from_caps info' caps'
    let result' = (/= 0) result
    touchManagedPtr info
    touchManagedPtr caps
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoFromCapsMethodInfo
instance (signature ~ (Gst.Caps.Caps -> m Bool), MonadIO m) => O.MethodInfo VideoInfoFromCapsMethodInfo VideoInfo signature where
    overloadedMethod _ = videoInfoFromCaps

#endif

-- method VideoInfo::init
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "info", argType = TInterface (Name {namespace = "GstVideo", name = "VideoInfo"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstVideoInfo", 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_info_init" gst_video_info_init :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    IO ()

{- |
Initialize /@info@/ with default values.
-}
videoInfoInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    {- ^ /@info@/: a 'GI.GstVideo.Structs.VideoInfo.VideoInfo' -}
    -> m ()
videoInfoInit info = liftIO $ do
    info' <- unsafeManagedPtrGetPtr info
    gst_video_info_init info'
    touchManagedPtr info
    return ()

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoInitMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo VideoInfoInitMethodInfo VideoInfo signature where
    overloadedMethod _ = videoInfoInit

#endif

-- method VideoInfo::is_equal
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "info", argType = TInterface (Name {namespace = "GstVideo", name = "VideoInfo"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstVideoInfo", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "other", argType = TInterface (Name {namespace = "GstVideo", name = "VideoInfo"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstVideoInfo", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_info_is_equal" gst_video_info_is_equal :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    Ptr VideoInfo ->                        -- other : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    IO CInt

{- |
Compares two 'GI.GstVideo.Structs.VideoInfo.VideoInfo' and returns whether they are equal or not
-}
videoInfoIsEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    {- ^ /@info@/: a 'GI.GstVideo.Structs.VideoInfo.VideoInfo' -}
    -> VideoInfo
    {- ^ /@other@/: a 'GI.GstVideo.Structs.VideoInfo.VideoInfo' -}
    -> m Bool
    {- ^ __Returns:__ 'True' if /@info@/ and /@other@/ are equal, else 'False'. -}
videoInfoIsEqual info other = liftIO $ do
    info' <- unsafeManagedPtrGetPtr info
    other' <- unsafeManagedPtrGetPtr other
    result <- gst_video_info_is_equal info' other'
    let result' = (/= 0) result
    touchManagedPtr info
    touchManagedPtr other
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoIsEqualMethodInfo
instance (signature ~ (VideoInfo -> m Bool), MonadIO m) => O.MethodInfo VideoInfoIsEqualMethodInfo VideoInfo signature where
    overloadedMethod _ = videoInfoIsEqual

#endif

-- method VideoInfo::set_format
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "info", argType = TInterface (Name {namespace = "GstVideo", name = "VideoInfo"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstVideoInfo", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "format", argType = TInterface (Name {namespace = "GstVideo", name = "VideoFormat"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the format", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "width", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a width", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "height", argType = TBasicType TUInt, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a height", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_info_set_format" gst_video_info_set_format :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    CUInt ->                                -- format : TInterface (Name {namespace = "GstVideo", name = "VideoFormat"})
    Word32 ->                               -- width : TBasicType TUInt
    Word32 ->                               -- height : TBasicType TUInt
    IO CInt

{- |
Set the default info for a video frame of /@format@/ and /@width@/ and /@height@/.

Note: This initializes /@info@/ first, no values are preserved. This function
does not set the offsets correctly for interlaced vertically
subsampled formats.
-}
videoInfoSetFormat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    {- ^ /@info@/: a 'GI.GstVideo.Structs.VideoInfo.VideoInfo' -}
    -> GstVideo.Enums.VideoFormat
    {- ^ /@format@/: the format -}
    -> Word32
    {- ^ /@width@/: a width -}
    -> Word32
    {- ^ /@height@/: a height -}
    -> m Bool
    {- ^ __Returns:__ 'False' if the returned video info is invalid, e.g. because the
  size of a frame can\'t be represented as a 32 bit integer (Since: 1.12) -}
videoInfoSetFormat info format width height = liftIO $ do
    info' <- unsafeManagedPtrGetPtr info
    let format' = (fromIntegral . fromEnum) format
    result <- gst_video_info_set_format info' format' width height
    let result' = (/= 0) result
    touchManagedPtr info
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoSetFormatMethodInfo
instance (signature ~ (GstVideo.Enums.VideoFormat -> Word32 -> Word32 -> m Bool), MonadIO m) => O.MethodInfo VideoInfoSetFormatMethodInfo VideoInfo signature where
    overloadedMethod _ = videoInfoSetFormat

#endif

-- method VideoInfo::to_caps
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "info", argType = TInterface (Name {namespace = "GstVideo", name = "VideoInfo"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstVideoInfo", 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_video_info_to_caps" gst_video_info_to_caps :: 
    Ptr VideoInfo ->                        -- info : TInterface (Name {namespace = "GstVideo", name = "VideoInfo"})
    IO (Ptr Gst.Caps.Caps)

{- |
Convert the values of /@info@/ into a 'GI.Gst.Structs.Caps.Caps'.
-}
videoInfoToCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoInfo
    {- ^ /@info@/: a 'GI.GstVideo.Structs.VideoInfo.VideoInfo' -}
    -> m Gst.Caps.Caps
    {- ^ __Returns:__ a new 'GI.Gst.Structs.Caps.Caps' containing the info of /@info@/. -}
videoInfoToCaps info = liftIO $ do
    info' <- unsafeManagedPtrGetPtr info
    result <- gst_video_info_to_caps info'
    checkUnexpectedReturnNULL "videoInfoToCaps" result
    result' <- (wrapBoxed Gst.Caps.Caps) result
    touchManagedPtr info
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data VideoInfoToCapsMethodInfo
instance (signature ~ (m Gst.Caps.Caps), MonadIO m) => O.MethodInfo VideoInfoToCapsMethodInfo VideoInfo signature where
    overloadedMethod _ = videoInfoToCaps

#endif

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
type family ResolveVideoInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoInfoMethod "align" o = VideoInfoAlignMethodInfo
    ResolveVideoInfoMethod "convert" o = VideoInfoConvertMethodInfo
    ResolveVideoInfoMethod "copy" o = VideoInfoCopyMethodInfo
    ResolveVideoInfoMethod "free" o = VideoInfoFreeMethodInfo
    ResolveVideoInfoMethod "fromCaps" o = VideoInfoFromCapsMethodInfo
    ResolveVideoInfoMethod "init" o = VideoInfoInitMethodInfo
    ResolveVideoInfoMethod "isEqual" o = VideoInfoIsEqualMethodInfo
    ResolveVideoInfoMethod "toCaps" o = VideoInfoToCapsMethodInfo
    ResolveVideoInfoMethod "setFormat" o = VideoInfoSetFormatMethodInfo
    ResolveVideoInfoMethod l o = O.MethodResolutionFailed l o

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

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

#endif