{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Mastering display color volume information defined by SMPTE ST 2086
-- (a.k.a static HDR metadata).
-- 
-- /Since: 1.18/

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

module GI.GstVideo.Structs.VideoMasteringDisplayInfo
    ( 

-- * Exported types
    VideoMasteringDisplayInfo(..)           ,
    newZeroVideoMasteringDisplayInfo        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addToCaps]("GI.GstVideo.Structs.VideoMasteringDisplayInfo#g:method:addToCaps"), [fromCaps]("GI.GstVideo.Structs.VideoMasteringDisplayInfo#g:method:fromCaps"), [init]("GI.GstVideo.Structs.VideoMasteringDisplayInfo#g:method:init"), [isEqual]("GI.GstVideo.Structs.VideoMasteringDisplayInfo#g:method:isEqual"), [toString]("GI.GstVideo.Structs.VideoMasteringDisplayInfo#g:method:toString").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveVideoMasteringDisplayInfoMethod  ,
#endif

-- ** addToCaps #method:addToCaps#

#if defined(ENABLE_OVERLOADING)
    VideoMasteringDisplayInfoAddToCapsMethodInfo,
#endif
    videoMasteringDisplayInfoAddToCaps      ,


-- ** fromCaps #method:fromCaps#

#if defined(ENABLE_OVERLOADING)
    VideoMasteringDisplayInfoFromCapsMethodInfo,
#endif
    videoMasteringDisplayInfoFromCaps       ,


-- ** fromString #method:fromString#

    videoMasteringDisplayInfoFromString     ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    VideoMasteringDisplayInfoInitMethodInfo ,
#endif
    videoMasteringDisplayInfoInit           ,


-- ** isEqual #method:isEqual#

#if defined(ENABLE_OVERLOADING)
    VideoMasteringDisplayInfoIsEqualMethodInfo,
#endif
    videoMasteringDisplayInfoIsEqual        ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    VideoMasteringDisplayInfoToStringMethodInfo,
#endif
    videoMasteringDisplayInfoToString       ,




 -- * Properties


-- ** maxDisplayMasteringLuminance #attr:maxDisplayMasteringLuminance#
-- | the maximum value of display luminance
--   in unit of 0.0001 candelas per square metre (cd\/m^2 and nit)

    getVideoMasteringDisplayInfoMaxDisplayMasteringLuminance,
    setVideoMasteringDisplayInfoMaxDisplayMasteringLuminance,
#if defined(ENABLE_OVERLOADING)
    videoMasteringDisplayInfo_maxDisplayMasteringLuminance,
#endif


-- ** minDisplayMasteringLuminance #attr:minDisplayMasteringLuminance#
-- | the minimum value of display luminance
--   in unit of 0.0001 candelas per square metre (cd\/m^2 and nit)

    getVideoMasteringDisplayInfoMinDisplayMasteringLuminance,
    setVideoMasteringDisplayInfoMinDisplayMasteringLuminance,
#if defined(ENABLE_OVERLOADING)
    videoMasteringDisplayInfo_minDisplayMasteringLuminance,
#endif


-- ** whitePoint #attr:whitePoint#
-- | the xy coordinates of white point in the CIE 1931 color space.
--   each value is normalized to 50000 (meaning that in unit of 0.00002)

    getVideoMasteringDisplayInfoWhitePoint  ,
#if defined(ENABLE_OVERLOADING)
    videoMasteringDisplayInfo_whitePoint    ,
#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.GHashTable as B.GHT
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.Kind as DK
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 qualified GI.Gst.Structs.Caps as Gst.Caps
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoMasteringDisplayInfoCoordinates as GstVideo.VideoMasteringDisplayInfoCoordinates

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

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

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


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

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


-- XXX Skipped attribute for "VideoMasteringDisplayInfo:display_primaries"
-- Not implemented: Don't know how to unpack C array of type TCArray False 3 (-1) (TInterface (Name {namespace = "GstVideo", name = "VideoMasteringDisplayInfoCoordinates"}))
-- | Get the value of the “@white_point@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoMasteringDisplayInfo #whitePoint
-- @
getVideoMasteringDisplayInfoWhitePoint :: MonadIO m => VideoMasteringDisplayInfo -> m GstVideo.VideoMasteringDisplayInfoCoordinates.VideoMasteringDisplayInfoCoordinates
getVideoMasteringDisplayInfoWhitePoint :: forall (m :: * -> *).
MonadIO m =>
VideoMasteringDisplayInfo -> m VideoMasteringDisplayInfoCoordinates
getVideoMasteringDisplayInfoWhitePoint VideoMasteringDisplayInfo
s = IO VideoMasteringDisplayInfoCoordinates
-> m VideoMasteringDisplayInfoCoordinates
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoMasteringDisplayInfoCoordinates
 -> m VideoMasteringDisplayInfoCoordinates)
-> IO VideoMasteringDisplayInfoCoordinates
-> m VideoMasteringDisplayInfoCoordinates
forall a b. (a -> b) -> a -> b
$ VideoMasteringDisplayInfo
-> (Ptr VideoMasteringDisplayInfo
    -> IO VideoMasteringDisplayInfoCoordinates)
-> IO VideoMasteringDisplayInfoCoordinates
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoMasteringDisplayInfo
s ((Ptr VideoMasteringDisplayInfo
  -> IO VideoMasteringDisplayInfoCoordinates)
 -> IO VideoMasteringDisplayInfoCoordinates)
-> (Ptr VideoMasteringDisplayInfo
    -> IO VideoMasteringDisplayInfoCoordinates)
-> IO VideoMasteringDisplayInfoCoordinates
forall a b. (a -> b) -> a -> b
$ \Ptr VideoMasteringDisplayInfo
ptr -> do
    let val :: Ptr VideoMasteringDisplayInfoCoordinates
val = Ptr VideoMasteringDisplayInfo
ptr Ptr VideoMasteringDisplayInfo
-> Int -> Ptr VideoMasteringDisplayInfoCoordinates
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
12 :: (Ptr GstVideo.VideoMasteringDisplayInfoCoordinates.VideoMasteringDisplayInfoCoordinates)
    VideoMasteringDisplayInfoCoordinates
val' <- ((ManagedPtr VideoMasteringDisplayInfoCoordinates
 -> VideoMasteringDisplayInfoCoordinates)
-> Ptr VideoMasteringDisplayInfoCoordinates
-> IO VideoMasteringDisplayInfoCoordinates
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr VideoMasteringDisplayInfoCoordinates
-> VideoMasteringDisplayInfoCoordinates
GstVideo.VideoMasteringDisplayInfoCoordinates.VideoMasteringDisplayInfoCoordinates) Ptr VideoMasteringDisplayInfoCoordinates
val
    VideoMasteringDisplayInfoCoordinates
-> IO VideoMasteringDisplayInfoCoordinates
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VideoMasteringDisplayInfoCoordinates
val'

#if defined(ENABLE_OVERLOADING)
data VideoMasteringDisplayInfoWhitePointFieldInfo
instance AttrInfo VideoMasteringDisplayInfoWhitePointFieldInfo where
    type AttrBaseTypeConstraint VideoMasteringDisplayInfoWhitePointFieldInfo = (~) VideoMasteringDisplayInfo
    type AttrAllowedOps VideoMasteringDisplayInfoWhitePointFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint VideoMasteringDisplayInfoWhitePointFieldInfo = (~) (Ptr GstVideo.VideoMasteringDisplayInfoCoordinates.VideoMasteringDisplayInfoCoordinates)
    type AttrTransferTypeConstraint VideoMasteringDisplayInfoWhitePointFieldInfo = (~)(Ptr GstVideo.VideoMasteringDisplayInfoCoordinates.VideoMasteringDisplayInfoCoordinates)
    type AttrTransferType VideoMasteringDisplayInfoWhitePointFieldInfo = (Ptr GstVideo.VideoMasteringDisplayInfoCoordinates.VideoMasteringDisplayInfoCoordinates)
    type AttrGetType VideoMasteringDisplayInfoWhitePointFieldInfo = GstVideo.VideoMasteringDisplayInfoCoordinates.VideoMasteringDisplayInfoCoordinates
    type AttrLabel VideoMasteringDisplayInfoWhitePointFieldInfo = "white_point"
    type AttrOrigin VideoMasteringDisplayInfoWhitePointFieldInfo = VideoMasteringDisplayInfo
    attrGet = getVideoMasteringDisplayInfoWhitePoint
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoMasteringDisplayInfo.whitePoint"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoMasteringDisplayInfo.html#g:attr:whitePoint"
        })

videoMasteringDisplayInfo_whitePoint :: AttrLabelProxy "whitePoint"
videoMasteringDisplayInfo_whitePoint = AttrLabelProxy

#endif


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

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

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

videoMasteringDisplayInfo_maxDisplayMasteringLuminance :: AttrLabelProxy "maxDisplayMasteringLuminance"
videoMasteringDisplayInfo_maxDisplayMasteringLuminance = AttrLabelProxy

#endif


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

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

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

videoMasteringDisplayInfo_minDisplayMasteringLuminance :: AttrLabelProxy "minDisplayMasteringLuminance"
videoMasteringDisplayInfo_minDisplayMasteringLuminance = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoMasteringDisplayInfo
type instance O.AttributeList VideoMasteringDisplayInfo = VideoMasteringDisplayInfoAttributeList
type VideoMasteringDisplayInfoAttributeList = ('[ '("whitePoint", VideoMasteringDisplayInfoWhitePointFieldInfo), '("maxDisplayMasteringLuminance", VideoMasteringDisplayInfoMaxDisplayMasteringLuminanceFieldInfo), '("minDisplayMasteringLuminance", VideoMasteringDisplayInfoMinDisplayMasteringLuminanceFieldInfo)] :: [(Symbol, DK.Type)])
#endif

-- method VideoMasteringDisplayInfo::add_to_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "minfo"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstVideo" , name = "VideoMasteringDisplayInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoMasteringDisplayInfo"
--                 , 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_mastering_display_info_add_to_caps" gst_video_mastering_display_info_add_to_caps :: 
    Ptr VideoMasteringDisplayInfo ->        -- minfo : TInterface (Name {namespace = "GstVideo", name = "VideoMasteringDisplayInfo"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Set string representation of /@minfo@/ to /@caps@/
-- 
-- /Since: 1.18/
videoMasteringDisplayInfoAddToCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoMasteringDisplayInfo
    -- ^ /@minfo@/: a t'GI.GstVideo.Structs.VideoMasteringDisplayInfo.VideoMasteringDisplayInfo'
    -> Gst.Caps.Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@minfo@/ was successfully set to /@caps@/
videoMasteringDisplayInfoAddToCaps :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoMasteringDisplayInfo -> Caps -> m Bool
videoMasteringDisplayInfoAddToCaps VideoMasteringDisplayInfo
minfo Caps
caps = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoMasteringDisplayInfo
minfo' <- VideoMasteringDisplayInfo -> IO (Ptr VideoMasteringDisplayInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoMasteringDisplayInfo
minfo
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    CInt
result <- Ptr VideoMasteringDisplayInfo -> Ptr Caps -> IO CInt
gst_video_mastering_display_info_add_to_caps Ptr VideoMasteringDisplayInfo
minfo' Ptr Caps
caps'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoMasteringDisplayInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoMasteringDisplayInfo
minfo
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoMasteringDisplayInfoAddToCapsMethodInfo
instance (signature ~ (Gst.Caps.Caps -> m Bool), MonadIO m) => O.OverloadedMethod VideoMasteringDisplayInfoAddToCapsMethodInfo VideoMasteringDisplayInfo signature where
    overloadedMethod = videoMasteringDisplayInfoAddToCaps

instance O.OverloadedMethodInfo VideoMasteringDisplayInfoAddToCapsMethodInfo VideoMasteringDisplayInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoMasteringDisplayInfo.videoMasteringDisplayInfoAddToCaps",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoMasteringDisplayInfo.html#v:videoMasteringDisplayInfoAddToCaps"
        })


#endif

-- method VideoMasteringDisplayInfo::from_caps
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "minfo"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstVideo" , name = "VideoMasteringDisplayInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoMasteringDisplayInfo"
--                 , 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_mastering_display_info_from_caps" gst_video_mastering_display_info_from_caps :: 
    Ptr VideoMasteringDisplayInfo ->        -- minfo : TInterface (Name {namespace = "GstVideo", name = "VideoMasteringDisplayInfo"})
    Ptr Gst.Caps.Caps ->                    -- caps : TInterface (Name {namespace = "Gst", name = "Caps"})
    IO CInt

-- | Parse /@caps@/ and update /@minfo@/
-- 
-- /Since: 1.18/
videoMasteringDisplayInfoFromCaps ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoMasteringDisplayInfo
    -- ^ /@minfo@/: a t'GI.GstVideo.Structs.VideoMasteringDisplayInfo.VideoMasteringDisplayInfo'
    -> Gst.Caps.Caps
    -- ^ /@caps@/: a t'GI.Gst.Structs.Caps.Caps'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@caps@/ has t'GI.GstVideo.Structs.VideoMasteringDisplayInfo.VideoMasteringDisplayInfo' and could be parsed
videoMasteringDisplayInfoFromCaps :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoMasteringDisplayInfo -> Caps -> m Bool
videoMasteringDisplayInfoFromCaps VideoMasteringDisplayInfo
minfo Caps
caps = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoMasteringDisplayInfo
minfo' <- VideoMasteringDisplayInfo -> IO (Ptr VideoMasteringDisplayInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoMasteringDisplayInfo
minfo
    Ptr Caps
caps' <- Caps -> IO (Ptr Caps)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Caps
caps
    CInt
result <- Ptr VideoMasteringDisplayInfo -> Ptr Caps -> IO CInt
gst_video_mastering_display_info_from_caps Ptr VideoMasteringDisplayInfo
minfo' Ptr Caps
caps'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoMasteringDisplayInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoMasteringDisplayInfo
minfo
    Caps -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Caps
caps
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoMasteringDisplayInfoFromCapsMethodInfo
instance (signature ~ (Gst.Caps.Caps -> m Bool), MonadIO m) => O.OverloadedMethod VideoMasteringDisplayInfoFromCapsMethodInfo VideoMasteringDisplayInfo signature where
    overloadedMethod = videoMasteringDisplayInfoFromCaps

instance O.OverloadedMethodInfo VideoMasteringDisplayInfoFromCapsMethodInfo VideoMasteringDisplayInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoMasteringDisplayInfo.videoMasteringDisplayInfoFromCaps",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoMasteringDisplayInfo.html#v:videoMasteringDisplayInfoFromCaps"
        })


#endif

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

-- | Initialize /@minfo@/
-- 
-- /Since: 1.18/
videoMasteringDisplayInfoInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoMasteringDisplayInfo
    -- ^ /@minfo@/: a t'GI.GstVideo.Structs.VideoMasteringDisplayInfo.VideoMasteringDisplayInfo'
    -> m ()
videoMasteringDisplayInfoInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoMasteringDisplayInfo -> m ()
videoMasteringDisplayInfoInit VideoMasteringDisplayInfo
minfo = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoMasteringDisplayInfo
minfo' <- VideoMasteringDisplayInfo -> IO (Ptr VideoMasteringDisplayInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoMasteringDisplayInfo
minfo
    Ptr VideoMasteringDisplayInfo -> IO ()
gst_video_mastering_display_info_init Ptr VideoMasteringDisplayInfo
minfo'
    VideoMasteringDisplayInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoMasteringDisplayInfo
minfo
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoMasteringDisplayInfoInitMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod VideoMasteringDisplayInfoInitMethodInfo VideoMasteringDisplayInfo signature where
    overloadedMethod = videoMasteringDisplayInfoInit

instance O.OverloadedMethodInfo VideoMasteringDisplayInfoInitMethodInfo VideoMasteringDisplayInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoMasteringDisplayInfo.videoMasteringDisplayInfoInit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoMasteringDisplayInfo.html#v:videoMasteringDisplayInfoInit"
        })


#endif

-- method VideoMasteringDisplayInfo::is_equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "minfo"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstVideo" , name = "VideoMasteringDisplayInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoMasteringDisplayInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstVideo" , name = "VideoMasteringDisplayInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoMasteringDisplayInfo"
--                 , 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_mastering_display_info_is_equal" gst_video_mastering_display_info_is_equal :: 
    Ptr VideoMasteringDisplayInfo ->        -- minfo : TInterface (Name {namespace = "GstVideo", name = "VideoMasteringDisplayInfo"})
    Ptr VideoMasteringDisplayInfo ->        -- other : TInterface (Name {namespace = "GstVideo", name = "VideoMasteringDisplayInfo"})
    IO CInt

-- | Checks equality between /@minfo@/ and /@other@/.
-- 
-- /Since: 1.18/
videoMasteringDisplayInfoIsEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoMasteringDisplayInfo
    -- ^ /@minfo@/: a t'GI.GstVideo.Structs.VideoMasteringDisplayInfo.VideoMasteringDisplayInfo'
    -> VideoMasteringDisplayInfo
    -- ^ /@other@/: a t'GI.GstVideo.Structs.VideoMasteringDisplayInfo.VideoMasteringDisplayInfo'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@minfo@/ and /@other@/ are equal.
videoMasteringDisplayInfoIsEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoMasteringDisplayInfo -> VideoMasteringDisplayInfo -> m Bool
videoMasteringDisplayInfoIsEqual VideoMasteringDisplayInfo
minfo VideoMasteringDisplayInfo
other = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoMasteringDisplayInfo
minfo' <- VideoMasteringDisplayInfo -> IO (Ptr VideoMasteringDisplayInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoMasteringDisplayInfo
minfo
    Ptr VideoMasteringDisplayInfo
other' <- VideoMasteringDisplayInfo -> IO (Ptr VideoMasteringDisplayInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoMasteringDisplayInfo
other
    CInt
result <- Ptr VideoMasteringDisplayInfo
-> Ptr VideoMasteringDisplayInfo -> IO CInt
gst_video_mastering_display_info_is_equal Ptr VideoMasteringDisplayInfo
minfo' Ptr VideoMasteringDisplayInfo
other'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoMasteringDisplayInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoMasteringDisplayInfo
minfo
    VideoMasteringDisplayInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoMasteringDisplayInfo
other
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoMasteringDisplayInfoIsEqualMethodInfo
instance (signature ~ (VideoMasteringDisplayInfo -> m Bool), MonadIO m) => O.OverloadedMethod VideoMasteringDisplayInfoIsEqualMethodInfo VideoMasteringDisplayInfo signature where
    overloadedMethod = videoMasteringDisplayInfoIsEqual

instance O.OverloadedMethodInfo VideoMasteringDisplayInfoIsEqualMethodInfo VideoMasteringDisplayInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoMasteringDisplayInfo.videoMasteringDisplayInfoIsEqual",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoMasteringDisplayInfo.html#v:videoMasteringDisplayInfoIsEqual"
        })


#endif

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

foreign import ccall "gst_video_mastering_display_info_to_string" gst_video_mastering_display_info_to_string :: 
    Ptr VideoMasteringDisplayInfo ->        -- minfo : TInterface (Name {namespace = "GstVideo", name = "VideoMasteringDisplayInfo"})
    IO CString

-- | Convert /@minfo@/ to its string representation
-- 
-- /Since: 1.18/
videoMasteringDisplayInfoToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoMasteringDisplayInfo
    -- ^ /@minfo@/: a t'GI.GstVideo.Structs.VideoMasteringDisplayInfo.VideoMasteringDisplayInfo'
    -> m T.Text
    -- ^ __Returns:__ a string representation of /@minfo@/
videoMasteringDisplayInfoToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoMasteringDisplayInfo -> m Text
videoMasteringDisplayInfoToString VideoMasteringDisplayInfo
minfo = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoMasteringDisplayInfo
minfo' <- VideoMasteringDisplayInfo -> IO (Ptr VideoMasteringDisplayInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoMasteringDisplayInfo
minfo
    CString
result <- Ptr VideoMasteringDisplayInfo -> IO CString
gst_video_mastering_display_info_to_string Ptr VideoMasteringDisplayInfo
minfo'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoMasteringDisplayInfoToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    VideoMasteringDisplayInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoMasteringDisplayInfo
minfo
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data VideoMasteringDisplayInfoToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod VideoMasteringDisplayInfoToStringMethodInfo VideoMasteringDisplayInfo signature where
    overloadedMethod = videoMasteringDisplayInfoToString

instance O.OverloadedMethodInfo VideoMasteringDisplayInfoToStringMethodInfo VideoMasteringDisplayInfo where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GstVideo.Structs.VideoMasteringDisplayInfo.videoMasteringDisplayInfoToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gstvideo-1.0.28/docs/GI-GstVideo-Structs-VideoMasteringDisplayInfo.html#v:videoMasteringDisplayInfoToString"
        })


#endif

-- method VideoMasteringDisplayInfo::from_string
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "minfo"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "GstVideo" , name = "VideoMasteringDisplayInfo" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoMasteringDisplayInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mastering"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstStructure representing #GstVideoMasteringDisplayInfo"
--                 , 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_mastering_display_info_from_string" gst_video_mastering_display_info_from_string :: 
    Ptr VideoMasteringDisplayInfo ->        -- minfo : TInterface (Name {namespace = "GstVideo", name = "VideoMasteringDisplayInfo"})
    CString ->                              -- mastering : TBasicType TUTF8
    IO CInt

-- | Extract t'GI.GstVideo.Structs.VideoMasteringDisplayInfo.VideoMasteringDisplayInfo' from /@mastering@/
-- 
-- /Since: 1.18/
videoMasteringDisplayInfoFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@mastering@/: a t'GI.Gst.Structs.Structure.Structure' representing t'GI.GstVideo.Structs.VideoMasteringDisplayInfo.VideoMasteringDisplayInfo'
    -> m ((Bool, VideoMasteringDisplayInfo))
    -- ^ __Returns:__ 'P.True' if /@minfo@/ was filled with /@mastering@/
videoMasteringDisplayInfoFromString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Bool, VideoMasteringDisplayInfo)
videoMasteringDisplayInfoFromString Text
mastering = IO (Bool, VideoMasteringDisplayInfo)
-> m (Bool, VideoMasteringDisplayInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, VideoMasteringDisplayInfo)
 -> m (Bool, VideoMasteringDisplayInfo))
-> IO (Bool, VideoMasteringDisplayInfo)
-> m (Bool, VideoMasteringDisplayInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoMasteringDisplayInfo
minfo <- Int -> IO (Ptr VideoMasteringDisplayInfo)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
56 :: IO (Ptr VideoMasteringDisplayInfo)
    CString
mastering' <- Text -> IO CString
textToCString Text
mastering
    CInt
result <- Ptr VideoMasteringDisplayInfo -> CString -> IO CInt
gst_video_mastering_display_info_from_string Ptr VideoMasteringDisplayInfo
minfo CString
mastering'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoMasteringDisplayInfo
minfo' <- ((ManagedPtr VideoMasteringDisplayInfo -> VideoMasteringDisplayInfo)
-> Ptr VideoMasteringDisplayInfo -> IO VideoMasteringDisplayInfo
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr VideoMasteringDisplayInfo -> VideoMasteringDisplayInfo
VideoMasteringDisplayInfo) Ptr VideoMasteringDisplayInfo
minfo
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mastering'
    (Bool, VideoMasteringDisplayInfo)
-> IO (Bool, VideoMasteringDisplayInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', VideoMasteringDisplayInfo
minfo')

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoMasteringDisplayInfoMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveVideoMasteringDisplayInfoMethod "addToCaps" o = VideoMasteringDisplayInfoAddToCapsMethodInfo
    ResolveVideoMasteringDisplayInfoMethod "fromCaps" o = VideoMasteringDisplayInfoFromCapsMethodInfo
    ResolveVideoMasteringDisplayInfoMethod "init" o = VideoMasteringDisplayInfoInitMethodInfo
    ResolveVideoMasteringDisplayInfoMethod "isEqual" o = VideoMasteringDisplayInfoIsEqualMethodInfo
    ResolveVideoMasteringDisplayInfoMethod "toString" o = VideoMasteringDisplayInfoToStringMethodInfo
    ResolveVideoMasteringDisplayInfoMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif