{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /@fieldCount@/ must be 0 for progressive video and 1 or 2 for interlaced.
-- 
-- A representation of a SMPTE time code.
-- 
-- /@hours@/ must be positive and less than 24. Will wrap around otherwise.
-- /@minutes@/ and /@seconds@/ must be positive and less than 60.
-- /@frames@/ must be less than or equal to /@config@/.fps_n \/ /@config@/.fps_d
-- These values are *NOT* automatically normalized.
-- 
-- /Since: 1.10/

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

module GI.GstVideo.Structs.VideoTimeCode
    ( 

-- * Exported types
    VideoTimeCode(..)                       ,
    newZeroVideoTimeCode                    ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addFrames]("GI.GstVideo.Structs.VideoTimeCode#g:method:addFrames"), [addInterval]("GI.GstVideo.Structs.VideoTimeCode#g:method:addInterval"), [clear]("GI.GstVideo.Structs.VideoTimeCode#g:method:clear"), [compare]("GI.GstVideo.Structs.VideoTimeCode#g:method:compare"), [copy]("GI.GstVideo.Structs.VideoTimeCode#g:method:copy"), [framesSinceDailyJam]("GI.GstVideo.Structs.VideoTimeCode#g:method:framesSinceDailyJam"), [free]("GI.GstVideo.Structs.VideoTimeCode#g:method:free"), [incrementFrame]("GI.GstVideo.Structs.VideoTimeCode#g:method:incrementFrame"), [init]("GI.GstVideo.Structs.VideoTimeCode#g:method:init"), [initFromDateTime]("GI.GstVideo.Structs.VideoTimeCode#g:method:initFromDateTime"), [initFromDateTimeFull]("GI.GstVideo.Structs.VideoTimeCode#g:method:initFromDateTimeFull"), [isValid]("GI.GstVideo.Structs.VideoTimeCode#g:method:isValid"), [nsecSinceDailyJam]("GI.GstVideo.Structs.VideoTimeCode#g:method:nsecSinceDailyJam"), [toDateTime]("GI.GstVideo.Structs.VideoTimeCode#g:method:toDateTime"), [toString]("GI.GstVideo.Structs.VideoTimeCode#g:method:toString").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveVideoTimeCodeMethod              ,
#endif

-- ** addFrames #method:addFrames#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeAddFramesMethodInfo        ,
#endif
    videoTimeCodeAddFrames                  ,


-- ** addInterval #method:addInterval#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeAddIntervalMethodInfo      ,
#endif
    videoTimeCodeAddInterval                ,


-- ** clear #method:clear#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeClearMethodInfo            ,
#endif
    videoTimeCodeClear                      ,


-- ** compare #method:compare#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeCompareMethodInfo          ,
#endif
    videoTimeCodeCompare                    ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeCopyMethodInfo             ,
#endif
    videoTimeCodeCopy                       ,


-- ** framesSinceDailyJam #method:framesSinceDailyJam#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeFramesSinceDailyJamMethodInfo,
#endif
    videoTimeCodeFramesSinceDailyJam        ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeFreeMethodInfo             ,
#endif
    videoTimeCodeFree                       ,


-- ** incrementFrame #method:incrementFrame#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeIncrementFrameMethodInfo   ,
#endif
    videoTimeCodeIncrementFrame             ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeInitMethodInfo             ,
#endif
    videoTimeCodeInit                       ,


-- ** initFromDateTime #method:initFromDateTime#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeInitFromDateTimeMethodInfo ,
#endif
    videoTimeCodeInitFromDateTime           ,


-- ** initFromDateTimeFull #method:initFromDateTimeFull#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeInitFromDateTimeFullMethodInfo,
#endif
    videoTimeCodeInitFromDateTimeFull       ,


-- ** isValid #method:isValid#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeIsValidMethodInfo          ,
#endif
    videoTimeCodeIsValid                    ,


-- ** new #method:new#

    videoTimeCodeNew                        ,


-- ** newEmpty #method:newEmpty#

    videoTimeCodeNewEmpty                   ,


-- ** newFromDateTime #method:newFromDateTime#

    videoTimeCodeNewFromDateTime            ,


-- ** newFromDateTimeFull #method:newFromDateTimeFull#

    videoTimeCodeNewFromDateTimeFull        ,


-- ** newFromString #method:newFromString#

    videoTimeCodeNewFromString              ,


-- ** nsecSinceDailyJam #method:nsecSinceDailyJam#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeNsecSinceDailyJamMethodInfo,
#endif
    videoTimeCodeNsecSinceDailyJam          ,


-- ** toDateTime #method:toDateTime#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeToDateTimeMethodInfo       ,
#endif
    videoTimeCodeToDateTime                 ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    VideoTimeCodeToStringMethodInfo         ,
#endif
    videoTimeCodeToString                   ,




 -- * Properties


-- ** config #attr:config#
-- | the corresponding t'GI.GstVideo.Structs.VideoTimeCodeConfig.VideoTimeCodeConfig'

    getVideoTimeCodeConfig                  ,
#if defined(ENABLE_OVERLOADING)
    videoTimeCode_config                    ,
#endif


-- ** fieldCount #attr:fieldCount#
-- | Interlaced video field count

    getVideoTimeCodeFieldCount              ,
    setVideoTimeCodeFieldCount              ,
#if defined(ENABLE_OVERLOADING)
    videoTimeCode_fieldCount                ,
#endif


-- ** frames #attr:frames#
-- | the frames field of t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'

    getVideoTimeCodeFrames                  ,
    setVideoTimeCodeFrames                  ,
#if defined(ENABLE_OVERLOADING)
    videoTimeCode_frames                    ,
#endif


-- ** hours #attr:hours#
-- | the hours field of t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'

    getVideoTimeCodeHours                   ,
    setVideoTimeCodeHours                   ,
#if defined(ENABLE_OVERLOADING)
    videoTimeCode_hours                     ,
#endif


-- ** minutes #attr:minutes#
-- | the minutes field of t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'

    getVideoTimeCodeMinutes                 ,
    setVideoTimeCodeMinutes                 ,
#if defined(ENABLE_OVERLOADING)
    videoTimeCode_minutes                   ,
#endif


-- ** seconds #attr:seconds#
-- | the seconds field of t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'

    getVideoTimeCodeSeconds                 ,
    setVideoTimeCodeSeconds                 ,
#if defined(ENABLE_OVERLOADING)
    videoTimeCode_seconds                   ,
#endif




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GLib.Structs.DateTime as GLib.DateTime
import {-# SOURCE #-} qualified GI.GstVideo.Flags as GstVideo.Flags
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoTimeCodeConfig as GstVideo.VideoTimeCodeConfig
import {-# SOURCE #-} qualified GI.GstVideo.Structs.VideoTimeCodeInterval as GstVideo.VideoTimeCodeInterval

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

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

foreign import ccall "gst_video_time_code_get_type" c_gst_video_time_code_get_type :: 
    IO GType

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

instance B.Types.TypedObject VideoTimeCode where
    glibType :: IO GType
glibType = IO GType
c_gst_video_time_code_get_type

instance B.Types.GBoxed VideoTimeCode

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

-- | Construct a `VideoTimeCode` struct initialized to zero.
newZeroVideoTimeCode :: MonadIO m => m VideoTimeCode
newZeroVideoTimeCode :: forall (m :: * -> *). MonadIO m => m VideoTimeCode
newZeroVideoTimeCode = IO VideoTimeCode -> m VideoTimeCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoTimeCode -> m VideoTimeCode)
-> IO VideoTimeCode -> m VideoTimeCode
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr VideoTimeCode)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
48 IO (Ptr VideoTimeCode)
-> (Ptr VideoTimeCode -> IO VideoTimeCode) -> IO VideoTimeCode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr VideoTimeCode -> VideoTimeCode)
-> Ptr VideoTimeCode -> IO VideoTimeCode
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoTimeCode -> VideoTimeCode
VideoTimeCode

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


-- | Get the value of the “@config@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoTimeCode #config
-- @
getVideoTimeCodeConfig :: MonadIO m => VideoTimeCode -> m GstVideo.VideoTimeCodeConfig.VideoTimeCodeConfig
getVideoTimeCodeConfig :: forall (m :: * -> *).
MonadIO m =>
VideoTimeCode -> m VideoTimeCodeConfig
getVideoTimeCodeConfig VideoTimeCode
s = IO VideoTimeCodeConfig -> m VideoTimeCodeConfig
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoTimeCodeConfig -> m VideoTimeCodeConfig)
-> IO VideoTimeCodeConfig -> m VideoTimeCodeConfig
forall a b. (a -> b) -> a -> b
$ VideoTimeCode
-> (Ptr VideoTimeCode -> IO VideoTimeCodeConfig)
-> IO VideoTimeCodeConfig
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoTimeCode
s ((Ptr VideoTimeCode -> IO VideoTimeCodeConfig)
 -> IO VideoTimeCodeConfig)
-> (Ptr VideoTimeCode -> IO VideoTimeCodeConfig)
-> IO VideoTimeCodeConfig
forall a b. (a -> b) -> a -> b
$ \Ptr VideoTimeCode
ptr -> do
    let val :: Ptr VideoTimeCodeConfig
val = Ptr VideoTimeCode
ptr Ptr VideoTimeCode -> Int -> Ptr VideoTimeCodeConfig
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: (Ptr GstVideo.VideoTimeCodeConfig.VideoTimeCodeConfig)
    VideoTimeCodeConfig
val' <- ((ManagedPtr VideoTimeCodeConfig -> VideoTimeCodeConfig)
-> Ptr VideoTimeCodeConfig -> IO VideoTimeCodeConfig
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr VideoTimeCodeConfig -> VideoTimeCodeConfig
GstVideo.VideoTimeCodeConfig.VideoTimeCodeConfig) Ptr VideoTimeCodeConfig
val
    VideoTimeCodeConfig -> IO VideoTimeCodeConfig
forall (m :: * -> *) a. Monad m => a -> m a
return VideoTimeCodeConfig
val'

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

videoTimeCode_config :: AttrLabelProxy "config"
videoTimeCode_config = AttrLabelProxy

#endif


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

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

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

videoTimeCode_hours :: AttrLabelProxy "hours"
videoTimeCode_hours = AttrLabelProxy

#endif


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

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

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

videoTimeCode_minutes :: AttrLabelProxy "minutes"
videoTimeCode_minutes = AttrLabelProxy

#endif


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

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

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

videoTimeCode_seconds :: AttrLabelProxy "seconds"
videoTimeCode_seconds = AttrLabelProxy

#endif


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

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

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

videoTimeCode_frames :: AttrLabelProxy "frames"
videoTimeCode_frames = AttrLabelProxy

#endif


-- | Get the value of the “@field_count@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' videoTimeCode #fieldCount
-- @
getVideoTimeCodeFieldCount :: MonadIO m => VideoTimeCode -> m Word32
getVideoTimeCodeFieldCount :: forall (m :: * -> *). MonadIO m => VideoTimeCode -> m Word32
getVideoTimeCodeFieldCount VideoTimeCode
s = IO Word32 -> m Word32
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
$ VideoTimeCode -> (Ptr VideoTimeCode -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr VideoTimeCode
s ((Ptr VideoTimeCode -> IO Word32) -> IO Word32)
-> (Ptr VideoTimeCode -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr VideoTimeCode
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr VideoTimeCode
ptr Ptr VideoTimeCode -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) :: IO Word32
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

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

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

videoTimeCode_fieldCount :: AttrLabelProxy "fieldCount"
videoTimeCode_fieldCount = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VideoTimeCode
type instance O.AttributeList VideoTimeCode = VideoTimeCodeAttributeList
type VideoTimeCodeAttributeList = ('[ '("config", VideoTimeCodeConfigFieldInfo), '("hours", VideoTimeCodeHoursFieldInfo), '("minutes", VideoTimeCodeMinutesFieldInfo), '("seconds", VideoTimeCodeSecondsFieldInfo), '("frames", VideoTimeCodeFramesFieldInfo), '("fieldCount", VideoTimeCodeFieldCountFieldInfo)] :: [(Symbol, *)])
#endif

-- method VideoTimeCode::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "fps_n"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Numerator of the frame rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fps_d"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Denominator of the frame rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "latest_daily_jam"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The latest daily jam of the #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoTimeCodeFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstVideoTimeCodeFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hours"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the hours field of #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "minutes"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the minutes field of #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "seconds"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the seconds field of #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frames"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the frames field of #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field_count"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Interlaced video field count"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "VideoTimeCode" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_time_code_new" gst_video_time_code_new :: 
    Word32 ->                               -- fps_n : TBasicType TUInt
    Word32 ->                               -- fps_d : TBasicType TUInt
    Ptr GLib.DateTime.DateTime ->           -- latest_daily_jam : TInterface (Name {namespace = "GLib", name = "DateTime"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCodeFlags"})
    Word32 ->                               -- hours : TBasicType TUInt
    Word32 ->                               -- minutes : TBasicType TUInt
    Word32 ->                               -- seconds : TBasicType TUInt
    Word32 ->                               -- frames : TBasicType TUInt
    Word32 ->                               -- field_count : TBasicType TUInt
    IO (Ptr VideoTimeCode)

-- | /@fieldCount@/ is 0 for progressive, 1 or 2 for interlaced.
-- /@latestDaiyJam@/ reference is stolen from caller.
-- 
-- /Since: 1.10/
videoTimeCodeNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@fpsN@/: Numerator of the frame rate
    -> Word32
    -- ^ /@fpsD@/: Denominator of the frame rate
    -> GLib.DateTime.DateTime
    -- ^ /@latestDailyJam@/: The latest daily jam of the t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> [GstVideo.Flags.VideoTimeCodeFlags]
    -- ^ /@flags@/: t'GI.GstVideo.Flags.VideoTimeCodeFlags'
    -> Word32
    -- ^ /@hours@/: the hours field of t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> Word32
    -- ^ /@minutes@/: the minutes field of t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> Word32
    -- ^ /@seconds@/: the seconds field of t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> Word32
    -- ^ /@frames@/: the frames field of t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> Word32
    -- ^ /@fieldCount@/: Interlaced video field count
    -> m VideoTimeCode
    -- ^ __Returns:__ a new t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode' with the given values.
    -- The values are not checked for being in a valid range. To see if your
    -- timecode actually has valid content, use 'GI.GstVideo.Structs.VideoTimeCode.videoTimeCodeIsValid'.
videoTimeCodeNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32
-> Word32
-> DateTime
-> [VideoTimeCodeFlags]
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> m VideoTimeCode
videoTimeCodeNew Word32
fpsN Word32
fpsD DateTime
latestDailyJam [VideoTimeCodeFlags]
flags Word32
hours Word32
minutes Word32
seconds Word32
frames Word32
fieldCount = IO VideoTimeCode -> m VideoTimeCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoTimeCode -> m VideoTimeCode)
-> IO VideoTimeCode -> m VideoTimeCode
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
latestDailyJam' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
latestDailyJam
    let flags' :: CUInt
flags' = [VideoTimeCodeFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoTimeCodeFlags]
flags
    Ptr VideoTimeCode
result <- Word32
-> Word32
-> Ptr DateTime
-> CUInt
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> IO (Ptr VideoTimeCode)
gst_video_time_code_new Word32
fpsN Word32
fpsD Ptr DateTime
latestDailyJam' CUInt
flags' Word32
hours Word32
minutes Word32
seconds Word32
frames Word32
fieldCount
    Text -> Ptr VideoTimeCode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoTimeCodeNew" Ptr VideoTimeCode
result
    VideoTimeCode
result' <- ((ManagedPtr VideoTimeCode -> VideoTimeCode)
-> Ptr VideoTimeCode -> IO VideoTimeCode
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoTimeCode -> VideoTimeCode
VideoTimeCode) Ptr VideoTimeCode
result
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
latestDailyJam
    VideoTimeCode -> IO VideoTimeCode
forall (m :: * -> *) a. Monad m => a -> m a
return VideoTimeCode
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gst_video_time_code_new_empty" gst_video_time_code_new_empty :: 
    IO (Ptr VideoTimeCode)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.10/
videoTimeCodeNewEmpty ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m VideoTimeCode
    -- ^ __Returns:__ a new empty, invalid t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
videoTimeCodeNewEmpty :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m VideoTimeCode
videoTimeCodeNewEmpty  = IO VideoTimeCode -> m VideoTimeCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoTimeCode -> m VideoTimeCode)
-> IO VideoTimeCode -> m VideoTimeCode
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
result <- IO (Ptr VideoTimeCode)
gst_video_time_code_new_empty
    Text -> Ptr VideoTimeCode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoTimeCodeNewEmpty" Ptr VideoTimeCode
result
    VideoTimeCode
result' <- ((ManagedPtr VideoTimeCode -> VideoTimeCode)
-> Ptr VideoTimeCode -> IO VideoTimeCode
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoTimeCode -> VideoTimeCode
VideoTimeCode) Ptr VideoTimeCode
result
    VideoTimeCode -> IO VideoTimeCode
forall (m :: * -> *) a. Monad m => a -> m a
return VideoTimeCode
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method VideoTimeCode::new_from_date_time
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "fps_n"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Numerator of the frame rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fps_d"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Denominator of the frame rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dt"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GDateTime to convert"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoTimeCodeFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstVideoTimeCodeFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field_count"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Interlaced video field count"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "VideoTimeCode" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_time_code_new_from_date_time" gst_video_time_code_new_from_date_time :: 
    Word32 ->                               -- fps_n : TBasicType TUInt
    Word32 ->                               -- fps_d : TBasicType TUInt
    Ptr GLib.DateTime.DateTime ->           -- dt : TInterface (Name {namespace = "GLib", name = "DateTime"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCodeFlags"})
    Word32 ->                               -- field_count : TBasicType TUInt
    IO (Ptr VideoTimeCode)

-- | The resulting config->latest_daily_jam is set to
-- midnight, and timecode is set to the given time.
-- 
-- This might return a completely invalid timecode, use
-- 'GI.GstVideo.Structs.VideoTimeCode.videoTimeCodeNewFromDateTimeFull' to ensure
-- that you would get 'P.Nothing' instead in that case.
-- 
-- /Since: 1.12/
videoTimeCodeNewFromDateTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@fpsN@/: Numerator of the frame rate
    -> Word32
    -- ^ /@fpsD@/: Denominator of the frame rate
    -> GLib.DateTime.DateTime
    -- ^ /@dt@/: t'GI.GLib.Structs.DateTime.DateTime' to convert
    -> [GstVideo.Flags.VideoTimeCodeFlags]
    -- ^ /@flags@/: t'GI.GstVideo.Flags.VideoTimeCodeFlags'
    -> Word32
    -- ^ /@fieldCount@/: Interlaced video field count
    -> m VideoTimeCode
    -- ^ __Returns:__ the t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode' representation of /@dt@/.
videoTimeCodeNewFromDateTime :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32
-> Word32
-> DateTime
-> [VideoTimeCodeFlags]
-> Word32
-> m VideoTimeCode
videoTimeCodeNewFromDateTime Word32
fpsN Word32
fpsD DateTime
dt [VideoTimeCodeFlags]
flags Word32
fieldCount = IO VideoTimeCode -> m VideoTimeCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoTimeCode -> m VideoTimeCode)
-> IO VideoTimeCode -> m VideoTimeCode
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
dt' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
dt
    let flags' :: CUInt
flags' = [VideoTimeCodeFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoTimeCodeFlags]
flags
    Ptr VideoTimeCode
result <- Word32
-> Word32
-> Ptr DateTime
-> CUInt
-> Word32
-> IO (Ptr VideoTimeCode)
gst_video_time_code_new_from_date_time Word32
fpsN Word32
fpsD Ptr DateTime
dt' CUInt
flags' Word32
fieldCount
    Text -> Ptr VideoTimeCode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoTimeCodeNewFromDateTime" Ptr VideoTimeCode
result
    VideoTimeCode
result' <- ((ManagedPtr VideoTimeCode -> VideoTimeCode)
-> Ptr VideoTimeCode -> IO VideoTimeCode
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoTimeCode -> VideoTimeCode
VideoTimeCode) Ptr VideoTimeCode
result
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
dt
    VideoTimeCode -> IO VideoTimeCode
forall (m :: * -> *) a. Monad m => a -> m a
return VideoTimeCode
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method VideoTimeCode::new_from_date_time_full
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "fps_n"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Numerator of the frame rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fps_d"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Denominator of the frame rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dt"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GDateTime to convert"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoTimeCodeFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstVideoTimeCodeFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field_count"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Interlaced video field count"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "VideoTimeCode" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_time_code_new_from_date_time_full" gst_video_time_code_new_from_date_time_full :: 
    Word32 ->                               -- fps_n : TBasicType TUInt
    Word32 ->                               -- fps_d : TBasicType TUInt
    Ptr GLib.DateTime.DateTime ->           -- dt : TInterface (Name {namespace = "GLib", name = "DateTime"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCodeFlags"})
    Word32 ->                               -- field_count : TBasicType TUInt
    IO (Ptr VideoTimeCode)

-- | The resulting config->latest_daily_jam is set to
-- midnight, and timecode is set to the given time.
-- 
-- /Since: 1.16/
videoTimeCodeNewFromDateTimeFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@fpsN@/: Numerator of the frame rate
    -> Word32
    -- ^ /@fpsD@/: Denominator of the frame rate
    -> GLib.DateTime.DateTime
    -- ^ /@dt@/: t'GI.GLib.Structs.DateTime.DateTime' to convert
    -> [GstVideo.Flags.VideoTimeCodeFlags]
    -- ^ /@flags@/: t'GI.GstVideo.Flags.VideoTimeCodeFlags'
    -> Word32
    -- ^ /@fieldCount@/: Interlaced video field count
    -> m VideoTimeCode
    -- ^ __Returns:__ the t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode' representation of /@dt@/, or 'P.Nothing' if
    --   no valid timecode could be created.
videoTimeCodeNewFromDateTimeFull :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32
-> Word32
-> DateTime
-> [VideoTimeCodeFlags]
-> Word32
-> m VideoTimeCode
videoTimeCodeNewFromDateTimeFull Word32
fpsN Word32
fpsD DateTime
dt [VideoTimeCodeFlags]
flags Word32
fieldCount = IO VideoTimeCode -> m VideoTimeCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoTimeCode -> m VideoTimeCode)
-> IO VideoTimeCode -> m VideoTimeCode
forall a b. (a -> b) -> a -> b
$ do
    Ptr DateTime
dt' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
dt
    let flags' :: CUInt
flags' = [VideoTimeCodeFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoTimeCodeFlags]
flags
    Ptr VideoTimeCode
result <- Word32
-> Word32
-> Ptr DateTime
-> CUInt
-> Word32
-> IO (Ptr VideoTimeCode)
gst_video_time_code_new_from_date_time_full Word32
fpsN Word32
fpsD Ptr DateTime
dt' CUInt
flags' Word32
fieldCount
    Text -> Ptr VideoTimeCode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoTimeCodeNewFromDateTimeFull" Ptr VideoTimeCode
result
    VideoTimeCode
result' <- ((ManagedPtr VideoTimeCode -> VideoTimeCode)
-> Ptr VideoTimeCode -> IO VideoTimeCode
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoTimeCode -> VideoTimeCode
VideoTimeCode) Ptr VideoTimeCode
result
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
dt
    VideoTimeCode -> IO VideoTimeCode
forall (m :: * -> *) a. Monad m => a -> m a
return VideoTimeCode
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method VideoTimeCode::new_from_string
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "tc_str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The string that represents the #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "VideoTimeCode" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_time_code_new_from_string" gst_video_time_code_new_from_string :: 
    CString ->                              -- tc_str : TBasicType TUTF8
    IO (Ptr VideoTimeCode)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.12/
videoTimeCodeNewFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@tcStr@/: The string that represents the t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> m (Maybe VideoTimeCode)
    -- ^ __Returns:__ a new t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode' from the given string or 'P.Nothing'
    --   if the string could not be passed.
videoTimeCodeNewFromString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe VideoTimeCode)
videoTimeCodeNewFromString Text
tcStr = IO (Maybe VideoTimeCode) -> m (Maybe VideoTimeCode)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe VideoTimeCode) -> m (Maybe VideoTimeCode))
-> IO (Maybe VideoTimeCode) -> m (Maybe VideoTimeCode)
forall a b. (a -> b) -> a -> b
$ do
    CString
tcStr' <- Text -> IO CString
textToCString Text
tcStr
    Ptr VideoTimeCode
result <- CString -> IO (Ptr VideoTimeCode)
gst_video_time_code_new_from_string CString
tcStr'
    Maybe VideoTimeCode
maybeResult <- Ptr VideoTimeCode
-> (Ptr VideoTimeCode -> IO VideoTimeCode)
-> IO (Maybe VideoTimeCode)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr VideoTimeCode
result ((Ptr VideoTimeCode -> IO VideoTimeCode)
 -> IO (Maybe VideoTimeCode))
-> (Ptr VideoTimeCode -> IO VideoTimeCode)
-> IO (Maybe VideoTimeCode)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoTimeCode
result' -> do
        VideoTimeCode
result'' <- ((ManagedPtr VideoTimeCode -> VideoTimeCode)
-> Ptr VideoTimeCode -> IO VideoTimeCode
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoTimeCode -> VideoTimeCode
VideoTimeCode) Ptr VideoTimeCode
result'
        VideoTimeCode -> IO VideoTimeCode
forall (m :: * -> *) a. Monad m => a -> m a
return VideoTimeCode
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tcStr'
    Maybe VideoTimeCode -> IO (Maybe VideoTimeCode)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoTimeCode
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method VideoTimeCode::add_frames
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tc"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoTimeCode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a valid #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frames"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "How many frames to add or subtract"
--                 , 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_time_code_add_frames" gst_video_time_code_add_frames :: 
    Ptr VideoTimeCode ->                    -- tc : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    Int64 ->                                -- frames : TBasicType TInt64
    IO ()

-- | Adds or subtracts /@frames@/ amount of frames to /@tc@/. tc needs to
-- contain valid data, as verified by 'GI.GstVideo.Structs.VideoTimeCode.videoTimeCodeIsValid'.
-- 
-- /Since: 1.10/
videoTimeCodeAddFrames ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: a valid t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> Int64
    -- ^ /@frames@/: How many frames to add or subtract
    -> m ()
videoTimeCodeAddFrames :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode -> Int64 -> m ()
videoTimeCodeAddFrames VideoTimeCode
tc Int64
frames = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    Ptr VideoTimeCode -> Int64 -> IO ()
gst_video_time_code_add_frames Ptr VideoTimeCode
tc' Int64
frames
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeAddFramesMethodInfo
instance (signature ~ (Int64 -> m ()), MonadIO m) => O.OverloadedMethod VideoTimeCodeAddFramesMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeAddFrames

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


#endif

-- method VideoTimeCode::add_interval
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tc"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoTimeCode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The #GstVideoTimeCode where the diff should be added. This\nmust contain valid timecode values."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tc_inter"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoTimeCodeInterval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "The #GstVideoTimeCodeInterval to add to @tc.\nThe interval must contain valid values, except that for drop-frame\ntimecode, it may also contain timecodes which would normally\nbe dropped. These are then corrected to the next reasonable timecode."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GstVideo" , name = "VideoTimeCode" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_time_code_add_interval" gst_video_time_code_add_interval :: 
    Ptr VideoTimeCode ->                    -- tc : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    Ptr GstVideo.VideoTimeCodeInterval.VideoTimeCodeInterval -> -- tc_inter : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCodeInterval"})
    IO (Ptr VideoTimeCode)

-- | This makes a component-wise addition of /@tcInter@/ to /@tc@/. For example,
-- adding (\"01:02:03:04\", \"00:01:00:00\") will return \"01:03:03:04\".
-- When it comes to drop-frame timecodes,
-- adding (\"00:00:00;00\", \"00:01:00:00\") will return \"00:01:00;02\"
-- because of drop-frame oddities. However,
-- adding (\"00:09:00;02\", \"00:01:00:00\") will return \"00:10:00;00\"
-- because this time we can have an exact minute.
-- 
-- /Since: 1.12/
videoTimeCodeAddInterval ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: The t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode' where the diff should be added. This
    -- must contain valid timecode values.
    -> GstVideo.VideoTimeCodeInterval.VideoTimeCodeInterval
    -- ^ /@tcInter@/: The t'GI.GstVideo.Structs.VideoTimeCodeInterval.VideoTimeCodeInterval' to add to /@tc@/.
    -- The interval must contain valid values, except that for drop-frame
    -- timecode, it may also contain timecodes which would normally
    -- be dropped. These are then corrected to the next reasonable timecode.
    -> m (Maybe VideoTimeCode)
    -- ^ __Returns:__ A new t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode' with /@tcInter@/ added or 'P.Nothing'
    --   if the interval can\'t be added.
videoTimeCodeAddInterval :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode -> VideoTimeCodeInterval -> m (Maybe VideoTimeCode)
videoTimeCodeAddInterval VideoTimeCode
tc VideoTimeCodeInterval
tcInter = IO (Maybe VideoTimeCode) -> m (Maybe VideoTimeCode)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe VideoTimeCode) -> m (Maybe VideoTimeCode))
-> IO (Maybe VideoTimeCode) -> m (Maybe VideoTimeCode)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    Ptr VideoTimeCodeInterval
tcInter' <- VideoTimeCodeInterval -> IO (Ptr VideoTimeCodeInterval)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCodeInterval
tcInter
    Ptr VideoTimeCode
result <- Ptr VideoTimeCode
-> Ptr VideoTimeCodeInterval -> IO (Ptr VideoTimeCode)
gst_video_time_code_add_interval Ptr VideoTimeCode
tc' Ptr VideoTimeCodeInterval
tcInter'
    Maybe VideoTimeCode
maybeResult <- Ptr VideoTimeCode
-> (Ptr VideoTimeCode -> IO VideoTimeCode)
-> IO (Maybe VideoTimeCode)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr VideoTimeCode
result ((Ptr VideoTimeCode -> IO VideoTimeCode)
 -> IO (Maybe VideoTimeCode))
-> (Ptr VideoTimeCode -> IO VideoTimeCode)
-> IO (Maybe VideoTimeCode)
forall a b. (a -> b) -> a -> b
$ \Ptr VideoTimeCode
result' -> do
        VideoTimeCode
result'' <- ((ManagedPtr VideoTimeCode -> VideoTimeCode)
-> Ptr VideoTimeCode -> IO VideoTimeCode
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoTimeCode -> VideoTimeCode
VideoTimeCode) Ptr VideoTimeCode
result'
        VideoTimeCode -> IO VideoTimeCode
forall (m :: * -> *) a. Monad m => a -> m a
return VideoTimeCode
result''
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    VideoTimeCodeInterval -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCodeInterval
tcInter
    Maybe VideoTimeCode -> IO (Maybe VideoTimeCode)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VideoTimeCode
maybeResult

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeAddIntervalMethodInfo
instance (signature ~ (GstVideo.VideoTimeCodeInterval.VideoTimeCodeInterval -> m (Maybe VideoTimeCode)), MonadIO m) => O.OverloadedMethod VideoTimeCodeAddIntervalMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeAddInterval

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


#endif

-- method VideoTimeCode::clear
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tc"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoTimeCode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoTimeCode"
--                 , 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_time_code_clear" gst_video_time_code_clear :: 
    Ptr VideoTimeCode ->                    -- tc : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    IO ()

-- | Initializes /@tc@/ with empty\/zero\/NULL values and frees any memory
-- it might currently use.
-- 
-- /Since: 1.10/
videoTimeCodeClear ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: a t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> m ()
videoTimeCodeClear :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode -> m ()
videoTimeCodeClear VideoTimeCode
tc = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    Ptr VideoTimeCode -> IO ()
gst_video_time_code_clear Ptr VideoTimeCode
tc'
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeClearMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod VideoTimeCodeClearMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeClear

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


#endif

-- method VideoTimeCode::compare
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tc1"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoTimeCode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a valid #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tc2"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoTimeCode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another valid #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_time_code_compare" gst_video_time_code_compare :: 
    Ptr VideoTimeCode ->                    -- tc1 : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    Ptr VideoTimeCode ->                    -- tc2 : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    IO Int32

-- | Compares /@tc1@/ and /@tc2@/. If both have latest daily jam information, it is
-- taken into account. Otherwise, it is assumed that the daily jam of both
-- /@tc1@/ and /@tc2@/ was at the same time. Both time codes must be valid.
-- 
-- /Since: 1.10/
videoTimeCodeCompare ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc1@/: a valid t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> VideoTimeCode
    -- ^ /@tc2@/: another valid t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> m Int32
    -- ^ __Returns:__ 1 if /@tc1@/ is after /@tc2@/, -1 if /@tc1@/ is before /@tc2@/, 0 otherwise.
videoTimeCodeCompare :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode -> VideoTimeCode -> m Int32
videoTimeCodeCompare VideoTimeCode
tc1 VideoTimeCode
tc2 = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc1' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc1
    Ptr VideoTimeCode
tc2' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc2
    Int32
result <- Ptr VideoTimeCode -> Ptr VideoTimeCode -> IO Int32
gst_video_time_code_compare Ptr VideoTimeCode
tc1' Ptr VideoTimeCode
tc2'
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc1
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc2
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeCompareMethodInfo
instance (signature ~ (VideoTimeCode -> m Int32), MonadIO m) => O.OverloadedMethod VideoTimeCodeCompareMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeCompare

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


#endif

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

foreign import ccall "gst_video_time_code_copy" gst_video_time_code_copy :: 
    Ptr VideoTimeCode ->                    -- tc : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    IO (Ptr VideoTimeCode)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.10/
videoTimeCodeCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: a t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> m VideoTimeCode
    -- ^ __Returns:__ a new t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode' with the same values as /@tc@/.
videoTimeCodeCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode -> m VideoTimeCode
videoTimeCodeCopy VideoTimeCode
tc = IO VideoTimeCode -> m VideoTimeCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VideoTimeCode -> m VideoTimeCode)
-> IO VideoTimeCode -> m VideoTimeCode
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    Ptr VideoTimeCode
result <- Ptr VideoTimeCode -> IO (Ptr VideoTimeCode)
gst_video_time_code_copy Ptr VideoTimeCode
tc'
    Text -> Ptr VideoTimeCode -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoTimeCodeCopy" Ptr VideoTimeCode
result
    VideoTimeCode
result' <- ((ManagedPtr VideoTimeCode -> VideoTimeCode)
-> Ptr VideoTimeCode -> IO VideoTimeCode
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr VideoTimeCode -> VideoTimeCode
VideoTimeCode) Ptr VideoTimeCode
result
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    VideoTimeCode -> IO VideoTimeCode
forall (m :: * -> *) a. Monad m => a -> m a
return VideoTimeCode
result'

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeCopyMethodInfo
instance (signature ~ (m VideoTimeCode), MonadIO m) => O.OverloadedMethod VideoTimeCodeCopyMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeCopy

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


#endif

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

foreign import ccall "gst_video_time_code_frames_since_daily_jam" gst_video_time_code_frames_since_daily_jam :: 
    Ptr VideoTimeCode ->                    -- tc : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    IO Word64

-- | /No description available in the introspection data./
-- 
-- /Since: 1.10/
videoTimeCodeFramesSinceDailyJam ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: a valid t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> m Word64
    -- ^ __Returns:__ how many frames have passed since the daily jam of /@tc@/.
videoTimeCodeFramesSinceDailyJam :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode -> m Word64
videoTimeCodeFramesSinceDailyJam VideoTimeCode
tc = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    Word64
result <- Ptr VideoTimeCode -> IO Word64
gst_video_time_code_frames_since_daily_jam Ptr VideoTimeCode
tc'
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeFramesSinceDailyJamMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.OverloadedMethod VideoTimeCodeFramesSinceDailyJamMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeFramesSinceDailyJam

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


#endif

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

-- | Frees /@tc@/.
-- 
-- /Since: 1.10/
videoTimeCodeFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: a t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> m ()
videoTimeCodeFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode -> m ()
videoTimeCodeFree VideoTimeCode
tc = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    Ptr VideoTimeCode -> IO ()
gst_video_time_code_free Ptr VideoTimeCode
tc'
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod VideoTimeCodeFreeMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeFree

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


#endif

-- method VideoTimeCode::increment_frame
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tc"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoTimeCode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a valid #GstVideoTimeCode"
--                 , 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_time_code_increment_frame" gst_video_time_code_increment_frame :: 
    Ptr VideoTimeCode ->                    -- tc : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    IO ()

-- | Adds one frame to /@tc@/.
-- 
-- /Since: 1.10/
videoTimeCodeIncrementFrame ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: a valid t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> m ()
videoTimeCodeIncrementFrame :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode -> m ()
videoTimeCodeIncrementFrame VideoTimeCode
tc = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    Ptr VideoTimeCode -> IO ()
gst_video_time_code_increment_frame Ptr VideoTimeCode
tc'
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeIncrementFrameMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod VideoTimeCodeIncrementFrameMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeIncrementFrame

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


#endif

-- method VideoTimeCode::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tc"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoTimeCode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fps_n"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Numerator of the frame rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fps_d"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Denominator of the frame rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "latest_daily_jam"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The latest daily jam of the #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoTimeCodeFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstVideoTimeCodeFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hours"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the hours field of #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "minutes"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the minutes field of #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "seconds"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the seconds field of #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "frames"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the frames field of #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field_count"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Interlaced video field count"
--                 , 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_time_code_init" gst_video_time_code_init :: 
    Ptr VideoTimeCode ->                    -- tc : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    Word32 ->                               -- fps_n : TBasicType TUInt
    Word32 ->                               -- fps_d : TBasicType TUInt
    Ptr GLib.DateTime.DateTime ->           -- latest_daily_jam : TInterface (Name {namespace = "GLib", name = "DateTime"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCodeFlags"})
    Word32 ->                               -- hours : TBasicType TUInt
    Word32 ->                               -- minutes : TBasicType TUInt
    Word32 ->                               -- seconds : TBasicType TUInt
    Word32 ->                               -- frames : TBasicType TUInt
    Word32 ->                               -- field_count : TBasicType TUInt
    IO ()

-- | /@fieldCount@/ is 0 for progressive, 1 or 2 for interlaced.
-- /@latestDaiyJam@/ reference is stolen from caller.
-- 
-- Initializes /@tc@/ with the given values.
-- The values are not checked for being in a valid range. To see if your
-- timecode actually has valid content, use 'GI.GstVideo.Structs.VideoTimeCode.videoTimeCodeIsValid'.
-- 
-- /Since: 1.10/
videoTimeCodeInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: a t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> Word32
    -- ^ /@fpsN@/: Numerator of the frame rate
    -> Word32
    -- ^ /@fpsD@/: Denominator of the frame rate
    -> Maybe (GLib.DateTime.DateTime)
    -- ^ /@latestDailyJam@/: The latest daily jam of the t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> [GstVideo.Flags.VideoTimeCodeFlags]
    -- ^ /@flags@/: t'GI.GstVideo.Flags.VideoTimeCodeFlags'
    -> Word32
    -- ^ /@hours@/: the hours field of t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> Word32
    -- ^ /@minutes@/: the minutes field of t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> Word32
    -- ^ /@seconds@/: the seconds field of t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> Word32
    -- ^ /@frames@/: the frames field of t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> Word32
    -- ^ /@fieldCount@/: Interlaced video field count
    -> m ()
videoTimeCodeInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode
-> Word32
-> Word32
-> Maybe DateTime
-> [VideoTimeCodeFlags]
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> m ()
videoTimeCodeInit VideoTimeCode
tc Word32
fpsN Word32
fpsD Maybe DateTime
latestDailyJam [VideoTimeCodeFlags]
flags Word32
hours Word32
minutes Word32
seconds Word32
frames Word32
fieldCount = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    Ptr DateTime
maybeLatestDailyJam <- case Maybe DateTime
latestDailyJam of
        Maybe DateTime
Nothing -> Ptr DateTime -> IO (Ptr DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DateTime
forall a. Ptr a
nullPtr
        Just DateTime
jLatestDailyJam -> do
            Ptr DateTime
jLatestDailyJam' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
jLatestDailyJam
            Ptr DateTime -> IO (Ptr DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DateTime
jLatestDailyJam'
    let flags' :: CUInt
flags' = [VideoTimeCodeFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoTimeCodeFlags]
flags
    Ptr VideoTimeCode
-> Word32
-> Word32
-> Ptr DateTime
-> CUInt
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> IO ()
gst_video_time_code_init Ptr VideoTimeCode
tc' Word32
fpsN Word32
fpsD Ptr DateTime
maybeLatestDailyJam CUInt
flags' Word32
hours Word32
minutes Word32
seconds Word32
frames Word32
fieldCount
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    Maybe DateTime -> (DateTime -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe DateTime
latestDailyJam DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeInitMethodInfo
instance (signature ~ (Word32 -> Word32 -> Maybe (GLib.DateTime.DateTime) -> [GstVideo.Flags.VideoTimeCodeFlags] -> Word32 -> Word32 -> Word32 -> Word32 -> Word32 -> m ()), MonadIO m) => O.OverloadedMethod VideoTimeCodeInitMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeInit

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


#endif

-- method VideoTimeCode::init_from_date_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tc"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoTimeCode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an uninitialized #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fps_n"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Numerator of the frame rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fps_d"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Denominator of the frame rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dt"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GDateTime to convert"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoTimeCodeFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstVideoTimeCodeFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field_count"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Interlaced video field count"
--                 , 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_time_code_init_from_date_time" gst_video_time_code_init_from_date_time :: 
    Ptr VideoTimeCode ->                    -- tc : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    Word32 ->                               -- fps_n : TBasicType TUInt
    Word32 ->                               -- fps_d : TBasicType TUInt
    Ptr GLib.DateTime.DateTime ->           -- dt : TInterface (Name {namespace = "GLib", name = "DateTime"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCodeFlags"})
    Word32 ->                               -- field_count : TBasicType TUInt
    IO ()

-- | The resulting config->latest_daily_jam is set to midnight, and timecode is
-- set to the given time.
-- 
-- Will assert on invalid parameters, use 'GI.GstVideo.Structs.VideoTimeCode.videoTimeCodeInitFromDateTimeFull'
-- for being able to handle invalid parameters.
-- 
-- /Since: 1.12/
videoTimeCodeInitFromDateTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: an uninitialized t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> Word32
    -- ^ /@fpsN@/: Numerator of the frame rate
    -> Word32
    -- ^ /@fpsD@/: Denominator of the frame rate
    -> GLib.DateTime.DateTime
    -- ^ /@dt@/: t'GI.GLib.Structs.DateTime.DateTime' to convert
    -> [GstVideo.Flags.VideoTimeCodeFlags]
    -- ^ /@flags@/: t'GI.GstVideo.Flags.VideoTimeCodeFlags'
    -> Word32
    -- ^ /@fieldCount@/: Interlaced video field count
    -> m ()
videoTimeCodeInitFromDateTime :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode
-> Word32
-> Word32
-> DateTime
-> [VideoTimeCodeFlags]
-> Word32
-> m ()
videoTimeCodeInitFromDateTime VideoTimeCode
tc Word32
fpsN Word32
fpsD DateTime
dt [VideoTimeCodeFlags]
flags Word32
fieldCount = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    Ptr DateTime
dt' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
dt
    let flags' :: CUInt
flags' = [VideoTimeCodeFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoTimeCodeFlags]
flags
    Ptr VideoTimeCode
-> Word32 -> Word32 -> Ptr DateTime -> CUInt -> Word32 -> IO ()
gst_video_time_code_init_from_date_time Ptr VideoTimeCode
tc' Word32
fpsN Word32
fpsD Ptr DateTime
dt' CUInt
flags' Word32
fieldCount
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
dt
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeInitFromDateTimeMethodInfo
instance (signature ~ (Word32 -> Word32 -> GLib.DateTime.DateTime -> [GstVideo.Flags.VideoTimeCodeFlags] -> Word32 -> m ()), MonadIO m) => O.OverloadedMethod VideoTimeCodeInitFromDateTimeMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeInitFromDateTime

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


#endif

-- method VideoTimeCode::init_from_date_time_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tc"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoTimeCode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstVideoTimeCode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fps_n"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Numerator of the frame rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fps_d"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Denominator of the frame rate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dt"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DateTime" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GDateTime to convert"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "GstVideo" , name = "VideoTimeCodeFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstVideoTimeCodeFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "field_count"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Interlaced video field count"
--                 , 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_time_code_init_from_date_time_full" gst_video_time_code_init_from_date_time_full :: 
    Ptr VideoTimeCode ->                    -- tc : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    Word32 ->                               -- fps_n : TBasicType TUInt
    Word32 ->                               -- fps_d : TBasicType TUInt
    Ptr GLib.DateTime.DateTime ->           -- dt : TInterface (Name {namespace = "GLib", name = "DateTime"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCodeFlags"})
    Word32 ->                               -- field_count : TBasicType TUInt
    IO CInt

-- | The resulting config->latest_daily_jam is set to
-- midnight, and timecode is set to the given time.
-- 
-- /Since: 1.16/
videoTimeCodeInitFromDateTimeFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: a t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> Word32
    -- ^ /@fpsN@/: Numerator of the frame rate
    -> Word32
    -- ^ /@fpsD@/: Denominator of the frame rate
    -> GLib.DateTime.DateTime
    -- ^ /@dt@/: t'GI.GLib.Structs.DateTime.DateTime' to convert
    -> [GstVideo.Flags.VideoTimeCodeFlags]
    -- ^ /@flags@/: t'GI.GstVideo.Flags.VideoTimeCodeFlags'
    -> Word32
    -- ^ /@fieldCount@/: Interlaced video field count
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@tc@/ could be correctly initialized to a valid timecode
videoTimeCodeInitFromDateTimeFull :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode
-> Word32
-> Word32
-> DateTime
-> [VideoTimeCodeFlags]
-> Word32
-> m Bool
videoTimeCodeInitFromDateTimeFull VideoTimeCode
tc Word32
fpsN Word32
fpsD DateTime
dt [VideoTimeCodeFlags]
flags Word32
fieldCount = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    Ptr DateTime
dt' <- DateTime -> IO (Ptr DateTime)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DateTime
dt
    let flags' :: CUInt
flags' = [VideoTimeCodeFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [VideoTimeCodeFlags]
flags
    CInt
result <- Ptr VideoTimeCode
-> Word32 -> Word32 -> Ptr DateTime -> CUInt -> Word32 -> IO CInt
gst_video_time_code_init_from_date_time_full Ptr VideoTimeCode
tc' Word32
fpsN Word32
fpsD Ptr DateTime
dt' CUInt
flags' Word32
fieldCount
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    DateTime -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DateTime
dt
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeInitFromDateTimeFullMethodInfo
instance (signature ~ (Word32 -> Word32 -> GLib.DateTime.DateTime -> [GstVideo.Flags.VideoTimeCodeFlags] -> Word32 -> m Bool), MonadIO m) => O.OverloadedMethod VideoTimeCodeInitFromDateTimeFullMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeInitFromDateTimeFull

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


#endif

-- method VideoTimeCode::is_valid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tc"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoTimeCode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstVideoTimeCode to check"
--                 , 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_time_code_is_valid" gst_video_time_code_is_valid :: 
    Ptr VideoTimeCode ->                    -- tc : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    IO CInt

-- | /No description available in the introspection data./
-- 
-- /Since: 1.10/
videoTimeCodeIsValid ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode' to check
    -> m Bool
    -- ^ __Returns:__ whether /@tc@/ is a valid timecode (supported frame rate,
    -- hours\/minutes\/seconds\/frames not overflowing)
videoTimeCodeIsValid :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode -> m Bool
videoTimeCodeIsValid VideoTimeCode
tc = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    CInt
result <- Ptr VideoTimeCode -> IO CInt
gst_video_time_code_is_valid Ptr VideoTimeCode
tc'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeIsValidMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod VideoTimeCodeIsValidMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeIsValid

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


#endif

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

foreign import ccall "gst_video_time_code_nsec_since_daily_jam" gst_video_time_code_nsec_since_daily_jam :: 
    Ptr VideoTimeCode ->                    -- tc : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    IO Word64

-- | /No description available in the introspection data./
-- 
-- /Since: 1.10/
videoTimeCodeNsecSinceDailyJam ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: a valid t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode'
    -> m Word64
    -- ^ __Returns:__ how many nsec have passed since the daily jam of /@tc@/.
videoTimeCodeNsecSinceDailyJam :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode -> m Word64
videoTimeCodeNsecSinceDailyJam VideoTimeCode
tc = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    Word64
result <- Ptr VideoTimeCode -> IO Word64
gst_video_time_code_nsec_since_daily_jam Ptr VideoTimeCode
tc'
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeNsecSinceDailyJamMethodInfo
instance (signature ~ (m Word64), MonadIO m) => O.OverloadedMethod VideoTimeCodeNsecSinceDailyJamMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeNsecSinceDailyJam

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


#endif

-- method VideoTimeCode::to_date_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tc"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoTimeCode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A valid #GstVideoTimeCode to convert"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "DateTime" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_video_time_code_to_date_time" gst_video_time_code_to_date_time :: 
    Ptr VideoTimeCode ->                    -- tc : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    IO (Ptr GLib.DateTime.DateTime)

-- | The /@tc@/.config->latest_daily_jam is required to be non-NULL.
-- 
-- /Since: 1.10/
videoTimeCodeToDateTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: A valid t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode' to convert
    -> m (Maybe GLib.DateTime.DateTime)
    -- ^ __Returns:__ the t'GI.GLib.Structs.DateTime.DateTime' representation of /@tc@/ or 'P.Nothing' if /@tc@/
    --   has no daily jam.
videoTimeCodeToDateTime :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode -> m (Maybe DateTime)
videoTimeCodeToDateTime VideoTimeCode
tc = IO (Maybe DateTime) -> m (Maybe DateTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DateTime) -> m (Maybe DateTime))
-> IO (Maybe DateTime) -> m (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    Ptr DateTime
result <- Ptr VideoTimeCode -> IO (Ptr DateTime)
gst_video_time_code_to_date_time Ptr VideoTimeCode
tc'
    Maybe DateTime
maybeResult <- Ptr DateTime
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr DateTime
result ((Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime))
-> (Ptr DateTime -> IO DateTime) -> IO (Maybe DateTime)
forall a b. (a -> b) -> a -> b
$ \Ptr DateTime
result' -> do
        DateTime
result'' <- ((ManagedPtr DateTime -> DateTime) -> Ptr DateTime -> IO DateTime
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr DateTime -> DateTime
GLib.DateTime.DateTime) Ptr DateTime
result'
        DateTime -> IO DateTime
forall (m :: * -> *) a. Monad m => a -> m a
return DateTime
result''
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    Maybe DateTime -> IO (Maybe DateTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DateTime
maybeResult

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeToDateTimeMethodInfo
instance (signature ~ (m (Maybe GLib.DateTime.DateTime)), MonadIO m) => O.OverloadedMethod VideoTimeCodeToDateTimeMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeToDateTime

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


#endif

-- method VideoTimeCode::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tc"
--           , argType =
--               TInterface Name { namespace = "GstVideo" , name = "VideoTimeCode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstVideoTimeCode to convert"
--                 , 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_time_code_to_string" gst_video_time_code_to_string :: 
    Ptr VideoTimeCode ->                    -- tc : TInterface (Name {namespace = "GstVideo", name = "VideoTimeCode"})
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 1.10/
videoTimeCodeToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    VideoTimeCode
    -- ^ /@tc@/: A t'GI.GstVideo.Structs.VideoTimeCode.VideoTimeCode' to convert
    -> m T.Text
    -- ^ __Returns:__ the SMPTE ST 2059-1:2015 string representation of /@tc@/. That will
    -- take the form hh:mm:ss:ff. The last separator (between seconds and frames)
    -- may vary:
    -- 
    -- \';\' for drop-frame, non-interlaced content and for drop-frame interlaced
    -- field 2
    -- \',\' for drop-frame interlaced field 1
    -- \':\' for non-drop-frame, non-interlaced content and for non-drop-frame
    -- interlaced field 2
    -- \'.\' for non-drop-frame interlaced field 1
videoTimeCodeToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
VideoTimeCode -> m Text
videoTimeCodeToString VideoTimeCode
tc = IO Text -> m Text
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 VideoTimeCode
tc' <- VideoTimeCode -> IO (Ptr VideoTimeCode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr VideoTimeCode
tc
    CString
result <- Ptr VideoTimeCode -> IO CString
gst_video_time_code_to_string Ptr VideoTimeCode
tc'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"videoTimeCodeToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    VideoTimeCode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr VideoTimeCode
tc
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data VideoTimeCodeToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod VideoTimeCodeToStringMethodInfo VideoTimeCode signature where
    overloadedMethod = videoTimeCodeToString

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVideoTimeCodeMethod (t :: Symbol) (o :: *) :: * where
    ResolveVideoTimeCodeMethod "addFrames" o = VideoTimeCodeAddFramesMethodInfo
    ResolveVideoTimeCodeMethod "addInterval" o = VideoTimeCodeAddIntervalMethodInfo
    ResolveVideoTimeCodeMethod "clear" o = VideoTimeCodeClearMethodInfo
    ResolveVideoTimeCodeMethod "compare" o = VideoTimeCodeCompareMethodInfo
    ResolveVideoTimeCodeMethod "copy" o = VideoTimeCodeCopyMethodInfo
    ResolveVideoTimeCodeMethod "framesSinceDailyJam" o = VideoTimeCodeFramesSinceDailyJamMethodInfo
    ResolveVideoTimeCodeMethod "free" o = VideoTimeCodeFreeMethodInfo
    ResolveVideoTimeCodeMethod "incrementFrame" o = VideoTimeCodeIncrementFrameMethodInfo
    ResolveVideoTimeCodeMethod "init" o = VideoTimeCodeInitMethodInfo
    ResolveVideoTimeCodeMethod "initFromDateTime" o = VideoTimeCodeInitFromDateTimeMethodInfo
    ResolveVideoTimeCodeMethod "initFromDateTimeFull" o = VideoTimeCodeInitFromDateTimeFullMethodInfo
    ResolveVideoTimeCodeMethod "isValid" o = VideoTimeCodeIsValidMethodInfo
    ResolveVideoTimeCodeMethod "nsecSinceDailyJam" o = VideoTimeCodeNsecSinceDailyJamMethodInfo
    ResolveVideoTimeCodeMethod "toDateTime" o = VideoTimeCodeToDateTimeMethodInfo
    ResolveVideoTimeCodeMethod "toString" o = VideoTimeCodeToStringMethodInfo
    ResolveVideoTimeCodeMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif