{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GStreamer uses a global clock to synchronize the plugins in a pipeline.
-- Different clock implementations are possible by implementing this abstract
-- base class or, more conveniently, by subclassing t'GI.Gst.Objects.SystemClock.SystemClock'.
-- 
-- The t'GI.Gst.Objects.Clock.Clock' returns a monotonically increasing time with the method
-- 'GI.Gst.Objects.Clock.clockGetTime'. Its accuracy and base time depend on the specific
-- clock implementation but time is always expressed in nanoseconds. Since the
-- baseline of the clock is undefined, the clock time returned is not
-- meaningful in itself, what matters are the deltas between two clock times.
-- The time returned by a clock is called the absolute time.
-- 
-- The pipeline uses the clock to calculate the running time. Usually all
-- renderers synchronize to the global clock using the buffer timestamps, the
-- newsegment events and the element\'s base time, see t'GI.Gst.Objects.Pipeline.Pipeline'.
-- 
-- A clock implementation can support periodic and single shot clock
-- notifications both synchronous and asynchronous.
-- 
-- One first needs to create a @/GstClockID/@ for the periodic or single shot
-- notification using 'GI.Gst.Objects.Clock.clockNewSingleShotId' or
-- 'GI.Gst.Objects.Clock.clockNewPeriodicId'.
-- 
-- To perform a blocking wait for the specific time of the @/GstClockID/@ use the
-- 'GI.Gst.Objects.Clock.clockIdWait'. To receive a callback when the specific time is reached
-- in the clock use 'GI.Gst.Objects.Clock.clockIdWaitAsync'. Both these calls can be
-- interrupted with the 'GI.Gst.Objects.Clock.clockIdUnschedule' call. If the blocking wait is
-- unscheduled a return value of @/GST_CLOCK_UNSCHEDULED/@ is returned.
-- 
-- Periodic callbacks scheduled async will be repeatedly called automatically
-- until it is unscheduled. To schedule a sync periodic callback,
-- 'GI.Gst.Objects.Clock.clockIdWait' should be called repeatedly.
-- 
-- The async callbacks can happen from any thread, either provided by the core
-- or from a streaming thread. The application should be prepared for this.
-- 
-- A @/GstClockID/@ that has been unscheduled cannot be used again for any wait
-- operation, a new @/GstClockID/@ should be created and the old unscheduled one
-- should be destroyed with 'GI.Gst.Objects.Clock.clockIdUnref'.
-- 
-- It is possible to perform a blocking wait on the same @/GstClockID/@ from
-- multiple threads. However, registering the same @/GstClockID/@ for multiple
-- async notifications is not possible, the callback will only be called for
-- the thread registering the entry last.
-- 
-- None of the wait operations unref the @/GstClockID/@, the owner is responsible
-- for unreffing the ids itself. This holds for both periodic and single shot
-- notifications. The reason being that the owner of the @/GstClockID/@ has to
-- keep a handle to the @/GstClockID/@ to unblock the wait on FLUSHING events or
-- state changes and if the entry would be unreffed automatically, the handle
-- might become invalid without any notification.
-- 
-- These clock operations do not operate on the running time, so the callbacks
-- will also occur when not in PLAYING state as if the clock just keeps on
-- running. Some clocks however do not progress when the element that provided
-- the clock is not PLAYING.
-- 
-- When a clock has the @/GST_CLOCK_FLAG_CAN_SET_MASTER/@ flag set, it can be
-- slaved to another t'GI.Gst.Objects.Clock.Clock' with the 'GI.Gst.Objects.Clock.clockSetMaster'. The clock will
-- then automatically be synchronized to this master clock by repeatedly
-- sampling the master clock and the slave clock and recalibrating the slave
-- clock with 'GI.Gst.Objects.Clock.clockSetCalibration'. This feature is mostly useful for
-- plugins that have an internal clock but must operate with another clock
-- selected by the t'GI.Gst.Objects.Pipeline.Pipeline'.  They can track the offset and rate difference
-- of their internal clock relative to the master clock by using the
-- 'GI.Gst.Objects.Clock.clockGetCalibration' function.
-- 
-- The master\/slave synchronisation can be tuned with the t'GI.Gst.Objects.Clock.Clock':@/timeout/@,
-- t'GI.Gst.Objects.Clock.Clock':@/window-size/@ and t'GI.Gst.Objects.Clock.Clock':@/window-threshold/@ properties.
-- The t'GI.Gst.Objects.Clock.Clock':@/timeout/@ property defines the interval to sample the master
-- clock and run the calibration functions. t'GI.Gst.Objects.Clock.Clock':@/window-size/@ defines the
-- number of samples to use when calibrating and t'GI.Gst.Objects.Clock.Clock':@/window-threshold/@
-- defines the minimum number of samples before the calibration is performed.

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

module GI.Gst.Objects.Clock
    ( 

-- * Exported types
    Clock(..)                               ,
    IsClock                                 ,
    toClock                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addControlBinding]("GI.Gst.Objects.Object#g:method:addControlBinding"), [addObservation]("GI.Gst.Objects.Clock#g:method:addObservation"), [addObservationUnapplied]("GI.Gst.Objects.Clock#g:method:addObservationUnapplied"), [adjustUnlocked]("GI.Gst.Objects.Clock#g:method:adjustUnlocked"), [adjustWithCalibration]("GI.Gst.Objects.Clock#g:method:adjustWithCalibration"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [defaultError]("GI.Gst.Objects.Object#g:method:defaultError"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasActiveControlBindings]("GI.Gst.Objects.Object#g:method:hasActiveControlBindings"), [hasAncestor]("GI.Gst.Objects.Object#g:method:hasAncestor"), [hasAsAncestor]("GI.Gst.Objects.Object#g:method:hasAsAncestor"), [hasAsParent]("GI.Gst.Objects.Object#g:method:hasAsParent"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isSynced]("GI.Gst.Objects.Clock#g:method:isSynced"), [newPeriodicId]("GI.Gst.Objects.Clock#g:method:newPeriodicId"), [newSingleShotId]("GI.Gst.Objects.Clock#g:method:newSingleShotId"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [periodicIdReinit]("GI.Gst.Objects.Clock#g:method:periodicIdReinit"), [ref]("GI.Gst.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeControlBinding]("GI.Gst.Objects.Object#g:method:removeControlBinding"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [singleShotIdReinit]("GI.Gst.Objects.Clock#g:method:singleShotIdReinit"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [suggestNextSync]("GI.Gst.Objects.Object#g:method:suggestNextSync"), [syncValues]("GI.Gst.Objects.Object#g:method:syncValues"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unadjustUnlocked]("GI.Gst.Objects.Clock#g:method:unadjustUnlocked"), [unadjustWithCalibration]("GI.Gst.Objects.Clock#g:method:unadjustWithCalibration"), [unparent]("GI.Gst.Objects.Object#g:method:unparent"), [unref]("GI.Gst.Objects.Object#g:method:unref"), [waitForSync]("GI.Gst.Objects.Clock#g:method:waitForSync"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCalibration]("GI.Gst.Objects.Clock#g:method:getCalibration"), [getControlBinding]("GI.Gst.Objects.Object#g:method:getControlBinding"), [getControlRate]("GI.Gst.Objects.Object#g:method:getControlRate"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getGValueArray]("GI.Gst.Objects.Object#g:method:getGValueArray"), [getInternalTime]("GI.Gst.Objects.Clock#g:method:getInternalTime"), [getMaster]("GI.Gst.Objects.Clock#g:method:getMaster"), [getName]("GI.Gst.Objects.Object#g:method:getName"), [getParent]("GI.Gst.Objects.Object#g:method:getParent"), [getPathString]("GI.Gst.Objects.Object#g:method:getPathString"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getResolution]("GI.Gst.Objects.Clock#g:method:getResolution"), [getTime]("GI.Gst.Objects.Clock#g:method:getTime"), [getTimeout]("GI.Gst.Objects.Clock#g:method:getTimeout"), [getValue]("GI.Gst.Objects.Object#g:method:getValue").
-- 
-- ==== Setters
-- [setCalibration]("GI.Gst.Objects.Clock#g:method:setCalibration"), [setControlBindingDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingDisabled"), [setControlBindingsDisabled]("GI.Gst.Objects.Object#g:method:setControlBindingsDisabled"), [setControlRate]("GI.Gst.Objects.Object#g:method:setControlRate"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setMaster]("GI.Gst.Objects.Clock#g:method:setMaster"), [setName]("GI.Gst.Objects.Object#g:method:setName"), [setParent]("GI.Gst.Objects.Object#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setResolution]("GI.Gst.Objects.Clock#g:method:setResolution"), [setSynced]("GI.Gst.Objects.Clock#g:method:setSynced"), [setTimeout]("GI.Gst.Objects.Clock#g:method:setTimeout").

#if defined(ENABLE_OVERLOADING)
    ResolveClockMethod                      ,
#endif

-- ** addObservation #method:addObservation#

#if defined(ENABLE_OVERLOADING)
    ClockAddObservationMethodInfo           ,
#endif
    clockAddObservation                     ,


-- ** addObservationUnapplied #method:addObservationUnapplied#

#if defined(ENABLE_OVERLOADING)
    ClockAddObservationUnappliedMethodInfo  ,
#endif
    clockAddObservationUnapplied            ,


-- ** adjustUnlocked #method:adjustUnlocked#

#if defined(ENABLE_OVERLOADING)
    ClockAdjustUnlockedMethodInfo           ,
#endif
    clockAdjustUnlocked                     ,


-- ** adjustWithCalibration #method:adjustWithCalibration#

#if defined(ENABLE_OVERLOADING)
    ClockAdjustWithCalibrationMethodInfo    ,
#endif
    clockAdjustWithCalibration              ,


-- ** getCalibration #method:getCalibration#

#if defined(ENABLE_OVERLOADING)
    ClockGetCalibrationMethodInfo           ,
#endif
    clockGetCalibration                     ,


-- ** getInternalTime #method:getInternalTime#

#if defined(ENABLE_OVERLOADING)
    ClockGetInternalTimeMethodInfo          ,
#endif
    clockGetInternalTime                    ,


-- ** getMaster #method:getMaster#

#if defined(ENABLE_OVERLOADING)
    ClockGetMasterMethodInfo                ,
#endif
    clockGetMaster                          ,


-- ** getResolution #method:getResolution#

#if defined(ENABLE_OVERLOADING)
    ClockGetResolutionMethodInfo            ,
#endif
    clockGetResolution                      ,


-- ** getTime #method:getTime#

#if defined(ENABLE_OVERLOADING)
    ClockGetTimeMethodInfo                  ,
#endif
    clockGetTime                            ,


-- ** getTimeout #method:getTimeout#

#if defined(ENABLE_OVERLOADING)
    ClockGetTimeoutMethodInfo               ,
#endif
    clockGetTimeout                         ,


-- ** idCompareFunc #method:idCompareFunc#

    clockIdCompareFunc                      ,


-- ** idGetClock #method:idGetClock#

    clockIdGetClock                         ,


-- ** idGetTime #method:idGetTime#

    clockIdGetTime                          ,


-- ** idRef #method:idRef#

    clockIdRef                              ,


-- ** idUnref #method:idUnref#

    clockIdUnref                            ,


-- ** idUnschedule #method:idUnschedule#

    clockIdUnschedule                       ,


-- ** idUsesClock #method:idUsesClock#

    clockIdUsesClock                        ,


-- ** idWait #method:idWait#

    clockIdWait                             ,


-- ** idWaitAsync #method:idWaitAsync#

    clockIdWaitAsync                        ,


-- ** isSynced #method:isSynced#

#if defined(ENABLE_OVERLOADING)
    ClockIsSyncedMethodInfo                 ,
#endif
    clockIsSynced                           ,


-- ** newPeriodicId #method:newPeriodicId#

#if defined(ENABLE_OVERLOADING)
    ClockNewPeriodicIdMethodInfo            ,
#endif
    clockNewPeriodicId                      ,


-- ** newSingleShotId #method:newSingleShotId#

#if defined(ENABLE_OVERLOADING)
    ClockNewSingleShotIdMethodInfo          ,
#endif
    clockNewSingleShotId                    ,


-- ** periodicIdReinit #method:periodicIdReinit#

#if defined(ENABLE_OVERLOADING)
    ClockPeriodicIdReinitMethodInfo         ,
#endif
    clockPeriodicIdReinit                   ,


-- ** setCalibration #method:setCalibration#

#if defined(ENABLE_OVERLOADING)
    ClockSetCalibrationMethodInfo           ,
#endif
    clockSetCalibration                     ,


-- ** setMaster #method:setMaster#

#if defined(ENABLE_OVERLOADING)
    ClockSetMasterMethodInfo                ,
#endif
    clockSetMaster                          ,


-- ** setResolution #method:setResolution#

#if defined(ENABLE_OVERLOADING)
    ClockSetResolutionMethodInfo            ,
#endif
    clockSetResolution                      ,


-- ** setSynced #method:setSynced#

#if defined(ENABLE_OVERLOADING)
    ClockSetSyncedMethodInfo                ,
#endif
    clockSetSynced                          ,


-- ** setTimeout #method:setTimeout#

#if defined(ENABLE_OVERLOADING)
    ClockSetTimeoutMethodInfo               ,
#endif
    clockSetTimeout                         ,


-- ** singleShotIdReinit #method:singleShotIdReinit#

#if defined(ENABLE_OVERLOADING)
    ClockSingleShotIdReinitMethodInfo       ,
#endif
    clockSingleShotIdReinit                 ,


-- ** unadjustUnlocked #method:unadjustUnlocked#

#if defined(ENABLE_OVERLOADING)
    ClockUnadjustUnlockedMethodInfo         ,
#endif
    clockUnadjustUnlocked                   ,


-- ** unadjustWithCalibration #method:unadjustWithCalibration#

#if defined(ENABLE_OVERLOADING)
    ClockUnadjustWithCalibrationMethodInfo  ,
#endif
    clockUnadjustWithCalibration            ,


-- ** waitForSync #method:waitForSync#

#if defined(ENABLE_OVERLOADING)
    ClockWaitForSyncMethodInfo              ,
#endif
    clockWaitForSync                        ,




 -- * Properties


-- ** timeout #attr:timeout#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ClockTimeoutPropertyInfo                ,
#endif
#if defined(ENABLE_OVERLOADING)
    clockTimeout                            ,
#endif
    constructClockTimeout                   ,
    getClockTimeout                         ,
    setClockTimeout                         ,


-- ** windowSize #attr:windowSize#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ClockWindowSizePropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    clockWindowSize                         ,
#endif
    constructClockWindowSize                ,
    getClockWindowSize                      ,
    setClockWindowSize                      ,


-- ** windowThreshold #attr:windowThreshold#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ClockWindowThresholdPropertyInfo        ,
#endif
#if defined(ENABLE_OVERLOADING)
    clockWindowThreshold                    ,
#endif
    constructClockWindowThreshold           ,
    getClockWindowThreshold                 ,
    setClockWindowThreshold                 ,




 -- * Signals


-- ** synced #signal:synced#

    C_ClockSyncedCallback                   ,
    ClockSyncedCallback                     ,
#if defined(ENABLE_OVERLOADING)
    ClockSyncedSignalInfo                   ,
#endif
    afterClockSynced                        ,
    genClosure_ClockSynced                  ,
    mk_ClockSyncedCallback                  ,
    noClockSyncedCallback                   ,
    onClockSynced                           ,
    wrap_ClockSyncedCallback                ,




    ) where

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

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

import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Objects.Object as Gst.Object

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

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

foreign import ccall "gst_clock_get_type"
    c_gst_clock_get_type :: IO B.Types.GType

instance B.Types.TypedObject Clock where
    glibType :: IO GType
glibType = IO GType
c_gst_clock_get_type

instance B.Types.GObject Clock

-- | Type class for types which can be safely cast to `Clock`, for instance with `toClock`.
class (SP.GObject o, O.IsDescendantOf Clock o) => IsClock o
instance (SP.GObject o, O.IsDescendantOf Clock o) => IsClock o

instance O.HasParentTypes Clock
type instance O.ParentTypes Clock = '[Gst.Object.Object, GObject.Object.Object]

-- | Cast to `Clock`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toClock :: (MIO.MonadIO m, IsClock o) => o -> m Clock
toClock :: forall (m :: * -> *) o. (MonadIO m, IsClock o) => o -> m Clock
toClock = IO Clock -> m Clock
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Clock -> m Clock) -> (o -> IO Clock) -> o -> m Clock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Clock -> Clock) -> o -> IO Clock
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Clock -> Clock
Clock

-- | Convert 'Clock' 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 Clock) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gst_clock_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Clock -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Clock
P.Nothing = Ptr GValue -> Ptr Clock -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Clock
forall a. Ptr a
FP.nullPtr :: FP.Ptr Clock)
    gvalueSet_ Ptr GValue
gv (P.Just Clock
obj) = Clock -> (Ptr Clock -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Clock
obj (Ptr GValue -> Ptr Clock -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Clock)
gvalueGet_ Ptr GValue
gv = do
        Ptr Clock
ptr <- Ptr GValue -> IO (Ptr Clock)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Clock)
        if Ptr Clock
ptr Ptr Clock -> Ptr Clock -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Clock
forall a. Ptr a
FP.nullPtr
        then Clock -> Maybe Clock
forall a. a -> Maybe a
P.Just (Clock -> Maybe Clock) -> IO Clock -> IO (Maybe Clock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Clock -> Clock) -> Ptr Clock -> IO Clock
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Clock -> Clock
Clock Ptr Clock
ptr
        else Maybe Clock -> IO (Maybe Clock)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Clock
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveClockMethod (t :: Symbol) (o :: *) :: * where
    ResolveClockMethod "addControlBinding" o = Gst.Object.ObjectAddControlBindingMethodInfo
    ResolveClockMethod "addObservation" o = ClockAddObservationMethodInfo
    ResolveClockMethod "addObservationUnapplied" o = ClockAddObservationUnappliedMethodInfo
    ResolveClockMethod "adjustUnlocked" o = ClockAdjustUnlockedMethodInfo
    ResolveClockMethod "adjustWithCalibration" o = ClockAdjustWithCalibrationMethodInfo
    ResolveClockMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveClockMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveClockMethod "defaultError" o = Gst.Object.ObjectDefaultErrorMethodInfo
    ResolveClockMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveClockMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveClockMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveClockMethod "hasActiveControlBindings" o = Gst.Object.ObjectHasActiveControlBindingsMethodInfo
    ResolveClockMethod "hasAncestor" o = Gst.Object.ObjectHasAncestorMethodInfo
    ResolveClockMethod "hasAsAncestor" o = Gst.Object.ObjectHasAsAncestorMethodInfo
    ResolveClockMethod "hasAsParent" o = Gst.Object.ObjectHasAsParentMethodInfo
    ResolveClockMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveClockMethod "isSynced" o = ClockIsSyncedMethodInfo
    ResolveClockMethod "newPeriodicId" o = ClockNewPeriodicIdMethodInfo
    ResolveClockMethod "newSingleShotId" o = ClockNewSingleShotIdMethodInfo
    ResolveClockMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveClockMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveClockMethod "periodicIdReinit" o = ClockPeriodicIdReinitMethodInfo
    ResolveClockMethod "ref" o = Gst.Object.ObjectRefMethodInfo
    ResolveClockMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveClockMethod "removeControlBinding" o = Gst.Object.ObjectRemoveControlBindingMethodInfo
    ResolveClockMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveClockMethod "singleShotIdReinit" o = ClockSingleShotIdReinitMethodInfo
    ResolveClockMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveClockMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveClockMethod "suggestNextSync" o = Gst.Object.ObjectSuggestNextSyncMethodInfo
    ResolveClockMethod "syncValues" o = Gst.Object.ObjectSyncValuesMethodInfo
    ResolveClockMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveClockMethod "unadjustUnlocked" o = ClockUnadjustUnlockedMethodInfo
    ResolveClockMethod "unadjustWithCalibration" o = ClockUnadjustWithCalibrationMethodInfo
    ResolveClockMethod "unparent" o = Gst.Object.ObjectUnparentMethodInfo
    ResolveClockMethod "unref" o = Gst.Object.ObjectUnrefMethodInfo
    ResolveClockMethod "waitForSync" o = ClockWaitForSyncMethodInfo
    ResolveClockMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveClockMethod "getCalibration" o = ClockGetCalibrationMethodInfo
    ResolveClockMethod "getControlBinding" o = Gst.Object.ObjectGetControlBindingMethodInfo
    ResolveClockMethod "getControlRate" o = Gst.Object.ObjectGetControlRateMethodInfo
    ResolveClockMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveClockMethod "getGValueArray" o = Gst.Object.ObjectGetGValueArrayMethodInfo
    ResolveClockMethod "getInternalTime" o = ClockGetInternalTimeMethodInfo
    ResolveClockMethod "getMaster" o = ClockGetMasterMethodInfo
    ResolveClockMethod "getName" o = Gst.Object.ObjectGetNameMethodInfo
    ResolveClockMethod "getParent" o = Gst.Object.ObjectGetParentMethodInfo
    ResolveClockMethod "getPathString" o = Gst.Object.ObjectGetPathStringMethodInfo
    ResolveClockMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveClockMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveClockMethod "getResolution" o = ClockGetResolutionMethodInfo
    ResolveClockMethod "getTime" o = ClockGetTimeMethodInfo
    ResolveClockMethod "getTimeout" o = ClockGetTimeoutMethodInfo
    ResolveClockMethod "getValue" o = Gst.Object.ObjectGetValueMethodInfo
    ResolveClockMethod "setCalibration" o = ClockSetCalibrationMethodInfo
    ResolveClockMethod "setControlBindingDisabled" o = Gst.Object.ObjectSetControlBindingDisabledMethodInfo
    ResolveClockMethod "setControlBindingsDisabled" o = Gst.Object.ObjectSetControlBindingsDisabledMethodInfo
    ResolveClockMethod "setControlRate" o = Gst.Object.ObjectSetControlRateMethodInfo
    ResolveClockMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveClockMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveClockMethod "setMaster" o = ClockSetMasterMethodInfo
    ResolveClockMethod "setName" o = Gst.Object.ObjectSetNameMethodInfo
    ResolveClockMethod "setParent" o = Gst.Object.ObjectSetParentMethodInfo
    ResolveClockMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveClockMethod "setResolution" o = ClockSetResolutionMethodInfo
    ResolveClockMethod "setSynced" o = ClockSetSyncedMethodInfo
    ResolveClockMethod "setTimeout" o = ClockSetTimeoutMethodInfo
    ResolveClockMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Clock::synced
-- | Signaled on clocks with GST_CLOCK_FLAG_NEEDS_STARTUP_SYNC set once
-- the clock is synchronized, or when it completely lost synchronization.
-- This signal will not be emitted on clocks without the flag.
-- 
-- This signal will be emitted from an arbitrary thread, most likely not
-- the application\'s main thread.
-- 
-- /Since: 1.6/
type ClockSyncedCallback =
    Bool
    -- ^ /@synced@/: if the clock is synced now
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ClockSyncedCallback`@.
noClockSyncedCallback :: Maybe ClockSyncedCallback
noClockSyncedCallback :: Maybe ClockSyncedCallback
noClockSyncedCallback = Maybe ClockSyncedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_ClockSyncedCallback =
    Ptr () ->                               -- object
    CInt ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_ClockSyncedCallback`.
foreign import ccall "wrapper"
    mk_ClockSyncedCallback :: C_ClockSyncedCallback -> IO (FunPtr C_ClockSyncedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_ClockSynced :: MonadIO m => ClockSyncedCallback -> m (GClosure C_ClockSyncedCallback)
genClosure_ClockSynced :: forall (m :: * -> *).
MonadIO m =>
ClockSyncedCallback -> m (GClosure C_ClockSyncedCallback)
genClosure_ClockSynced ClockSyncedCallback
cb = IO (GClosure C_ClockSyncedCallback)
-> m (GClosure C_ClockSyncedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ClockSyncedCallback)
 -> m (GClosure C_ClockSyncedCallback))
-> IO (GClosure C_ClockSyncedCallback)
-> m (GClosure C_ClockSyncedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClockSyncedCallback
cb' = ClockSyncedCallback -> C_ClockSyncedCallback
wrap_ClockSyncedCallback ClockSyncedCallback
cb
    C_ClockSyncedCallback -> IO (FunPtr C_ClockSyncedCallback)
mk_ClockSyncedCallback C_ClockSyncedCallback
cb' IO (FunPtr C_ClockSyncedCallback)
-> (FunPtr C_ClockSyncedCallback
    -> IO (GClosure C_ClockSyncedCallback))
-> IO (GClosure C_ClockSyncedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ClockSyncedCallback -> IO (GClosure C_ClockSyncedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ClockSyncedCallback` into a `C_ClockSyncedCallback`.
wrap_ClockSyncedCallback ::
    ClockSyncedCallback ->
    C_ClockSyncedCallback
wrap_ClockSyncedCallback :: ClockSyncedCallback -> C_ClockSyncedCallback
wrap_ClockSyncedCallback ClockSyncedCallback
_cb Ptr ()
_ CInt
synced Ptr ()
_ = do
    let synced' :: Bool
synced' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
synced
    ClockSyncedCallback
_cb  Bool
synced'


-- | Connect a signal handler for the [synced](#signal:synced) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' clock #synced callback
-- @
-- 
-- 
onClockSynced :: (IsClock a, MonadIO m) => a -> ClockSyncedCallback -> m SignalHandlerId
onClockSynced :: forall a (m :: * -> *).
(IsClock a, MonadIO m) =>
a -> ClockSyncedCallback -> m SignalHandlerId
onClockSynced a
obj ClockSyncedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClockSyncedCallback
cb' = ClockSyncedCallback -> C_ClockSyncedCallback
wrap_ClockSyncedCallback ClockSyncedCallback
cb
    FunPtr C_ClockSyncedCallback
cb'' <- C_ClockSyncedCallback -> IO (FunPtr C_ClockSyncedCallback)
mk_ClockSyncedCallback C_ClockSyncedCallback
cb'
    a
-> Text
-> FunPtr C_ClockSyncedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"synced" FunPtr C_ClockSyncedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [synced](#signal:synced) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' clock #synced callback
-- @
-- 
-- 
afterClockSynced :: (IsClock a, MonadIO m) => a -> ClockSyncedCallback -> m SignalHandlerId
afterClockSynced :: forall a (m :: * -> *).
(IsClock a, MonadIO m) =>
a -> ClockSyncedCallback -> m SignalHandlerId
afterClockSynced a
obj ClockSyncedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClockSyncedCallback
cb' = ClockSyncedCallback -> C_ClockSyncedCallback
wrap_ClockSyncedCallback ClockSyncedCallback
cb
    FunPtr C_ClockSyncedCallback
cb'' <- C_ClockSyncedCallback -> IO (FunPtr C_ClockSyncedCallback)
mk_ClockSyncedCallback C_ClockSyncedCallback
cb'
    a
-> Text
-> FunPtr C_ClockSyncedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"synced" FunPtr C_ClockSyncedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ClockSyncedSignalInfo
instance SignalInfo ClockSyncedSignalInfo where
    type HaskellCallbackType ClockSyncedSignalInfo = ClockSyncedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ClockSyncedCallback cb
        cb'' <- mk_ClockSyncedCallback cb'
        connectSignalFunPtr obj "synced" cb'' connectMode detail

#endif

-- VVV Prop "timeout"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@timeout@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' clock #timeout
-- @
getClockTimeout :: (MonadIO m, IsClock o) => o -> m Word64
getClockTimeout :: forall (m :: * -> *) o. (MonadIO m, IsClock o) => o -> m Word64
getClockTimeout o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj String
"timeout"

-- | Set the value of the “@timeout@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' clock [ #timeout 'Data.GI.Base.Attributes.:=' value ]
-- @
setClockTimeout :: (MonadIO m, IsClock o) => o -> Word64 -> m ()
setClockTimeout :: forall (m :: * -> *) o.
(MonadIO m, IsClock o) =>
o -> Word64 -> m ()
setClockTimeout o
obj Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word64 -> IO ()
forall a. GObject a => a -> String -> Word64 -> IO ()
B.Properties.setObjectPropertyUInt64 o
obj String
"timeout" Word64
val

-- | Construct a `GValueConstruct` with valid value for the “@timeout@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructClockTimeout :: (IsClock o, MIO.MonadIO m) => Word64 -> m (GValueConstruct o)
constructClockTimeout :: forall o (m :: * -> *).
(IsClock o, MonadIO m) =>
Word64 -> m (GValueConstruct o)
constructClockTimeout Word64
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word64 -> IO (GValueConstruct o)
forall o. String -> Word64 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt64 String
"timeout" Word64
val

#if defined(ENABLE_OVERLOADING)
data ClockTimeoutPropertyInfo
instance AttrInfo ClockTimeoutPropertyInfo where
    type AttrAllowedOps ClockTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ClockTimeoutPropertyInfo = IsClock
    type AttrSetTypeConstraint ClockTimeoutPropertyInfo = (~) Word64
    type AttrTransferTypeConstraint ClockTimeoutPropertyInfo = (~) Word64
    type AttrTransferType ClockTimeoutPropertyInfo = Word64
    type AttrGetType ClockTimeoutPropertyInfo = Word64
    type AttrLabel ClockTimeoutPropertyInfo = "timeout"
    type AttrOrigin ClockTimeoutPropertyInfo = Clock
    attrGet = getClockTimeout
    attrSet = setClockTimeout
    attrTransfer _ v = do
        return v
    attrConstruct = constructClockTimeout
    attrClear = undefined
#endif

-- VVV Prop "window-size"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@window-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' clock #windowSize
-- @
getClockWindowSize :: (MonadIO m, IsClock o) => o -> m Int32
getClockWindowSize :: forall (m :: * -> *) o. (MonadIO m, IsClock o) => o -> m Int32
getClockWindowSize o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"window-size"

-- | Set the value of the “@window-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' clock [ #windowSize 'Data.GI.Base.Attributes.:=' value ]
-- @
setClockWindowSize :: (MonadIO m, IsClock o) => o -> Int32 -> m ()
setClockWindowSize :: forall (m :: * -> *) o.
(MonadIO m, IsClock o) =>
o -> Int32 -> m ()
setClockWindowSize o
obj Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"window-size" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@window-size@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructClockWindowSize :: (IsClock o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructClockWindowSize :: forall o (m :: * -> *).
(IsClock o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructClockWindowSize Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"window-size" Int32
val

#if defined(ENABLE_OVERLOADING)
data ClockWindowSizePropertyInfo
instance AttrInfo ClockWindowSizePropertyInfo where
    type AttrAllowedOps ClockWindowSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ClockWindowSizePropertyInfo = IsClock
    type AttrSetTypeConstraint ClockWindowSizePropertyInfo = (~) Int32
    type AttrTransferTypeConstraint ClockWindowSizePropertyInfo = (~) Int32
    type AttrTransferType ClockWindowSizePropertyInfo = Int32
    type AttrGetType ClockWindowSizePropertyInfo = Int32
    type AttrLabel ClockWindowSizePropertyInfo = "window-size"
    type AttrOrigin ClockWindowSizePropertyInfo = Clock
    attrGet = getClockWindowSize
    attrSet = setClockWindowSize
    attrTransfer _ v = do
        return v
    attrConstruct = constructClockWindowSize
    attrClear = undefined
#endif

-- VVV Prop "window-threshold"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@window-threshold@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' clock #windowThreshold
-- @
getClockWindowThreshold :: (MonadIO m, IsClock o) => o -> m Int32
getClockWindowThreshold :: forall (m :: * -> *) o. (MonadIO m, IsClock o) => o -> m Int32
getClockWindowThreshold o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"window-threshold"

-- | Set the value of the “@window-threshold@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' clock [ #windowThreshold 'Data.GI.Base.Attributes.:=' value ]
-- @
setClockWindowThreshold :: (MonadIO m, IsClock o) => o -> Int32 -> m ()
setClockWindowThreshold :: forall (m :: * -> *) o.
(MonadIO m, IsClock o) =>
o -> Int32 -> m ()
setClockWindowThreshold o
obj Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"window-threshold" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@window-threshold@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructClockWindowThreshold :: (IsClock o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructClockWindowThreshold :: forall o (m :: * -> *).
(IsClock o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructClockWindowThreshold Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"window-threshold" Int32
val

#if defined(ENABLE_OVERLOADING)
data ClockWindowThresholdPropertyInfo
instance AttrInfo ClockWindowThresholdPropertyInfo where
    type AttrAllowedOps ClockWindowThresholdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ClockWindowThresholdPropertyInfo = IsClock
    type AttrSetTypeConstraint ClockWindowThresholdPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint ClockWindowThresholdPropertyInfo = (~) Int32
    type AttrTransferType ClockWindowThresholdPropertyInfo = Int32
    type AttrGetType ClockWindowThresholdPropertyInfo = Int32
    type AttrLabel ClockWindowThresholdPropertyInfo = "window-threshold"
    type AttrOrigin ClockWindowThresholdPropertyInfo = Clock
    attrGet = getClockWindowThreshold
    attrSet = setClockWindowThreshold
    attrTransfer _ v = do
        return v
    attrConstruct = constructClockWindowThreshold
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Clock
type instance O.AttributeList Clock = ClockAttributeList
type ClockAttributeList = ('[ '("name", Gst.Object.ObjectNamePropertyInfo), '("parent", Gst.Object.ObjectParentPropertyInfo), '("timeout", ClockTimeoutPropertyInfo), '("windowSize", ClockWindowSizePropertyInfo), '("windowThreshold", ClockWindowThresholdPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
clockTimeout :: AttrLabelProxy "timeout"
clockTimeout = AttrLabelProxy

clockWindowSize :: AttrLabelProxy "windowSize"
clockWindowSize = AttrLabelProxy

clockWindowThreshold :: AttrLabelProxy "windowThreshold"
clockWindowThreshold = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Clock = ClockSignalList
type ClockSignalList = ('[ '("deepNotify", Gst.Object.ObjectDeepNotifySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("synced", ClockSyncedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Clock::add_observation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "slave"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a time on the slave"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "master"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a time on the master"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r_squared"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to hold the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_add_observation" gst_clock_add_observation :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Word64 ->                               -- slave : TBasicType TUInt64
    Word64 ->                               -- master : TBasicType TUInt64
    Ptr CDouble ->                          -- r_squared : TBasicType TDouble
    IO CInt

-- | The time /@master@/ of the master clock and the time /@slave@/ of the slave
-- clock are added to the list of observations. If enough observations
-- are available, a linear regression algorithm is run on the
-- observations and /@clock@/ is recalibrated.
-- 
-- If this functions returns 'P.True', /@rSquared@/ will contain the
-- correlation coefficient of the interpolation. A value of 1.0
-- means a perfect regression was performed. This value can
-- be used to control the sampling frequency of the master and slave
-- clocks.
clockAddObservation ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock'
    -> Word64
    -- ^ /@slave@/: a time on the slave
    -> Word64
    -- ^ /@master@/: a time on the master
    -> m ((Bool, Double))
    -- ^ __Returns:__ 'P.True' if enough observations were added to run the
    -- regression algorithm.
    -- 
    -- MT safe.
clockAddObservation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Word64 -> Word64 -> m (Bool, Double)
clockAddObservation a
clock Word64
slave Word64
master = IO (Bool, Double) -> m (Bool, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double) -> m (Bool, Double))
-> IO (Bool, Double) -> m (Bool, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Ptr CDouble
rSquared <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    CInt
result <- Ptr Clock -> Word64 -> Word64 -> Ptr CDouble -> IO CInt
gst_clock_add_observation Ptr Clock
clock' Word64
slave Word64
master Ptr CDouble
rSquared
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
rSquared' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
rSquared
    let rSquared'' :: Double
rSquared'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
rSquared'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
rSquared
    (Bool, Double) -> IO (Bool, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
rSquared'')

#if defined(ENABLE_OVERLOADING)
data ClockAddObservationMethodInfo
instance (signature ~ (Word64 -> Word64 -> m ((Bool, Double))), MonadIO m, IsClock a) => O.OverloadedMethod ClockAddObservationMethodInfo a signature where
    overloadedMethod = clockAddObservation

instance O.OverloadedMethodInfo ClockAddObservationMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockAddObservation",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockAddObservation"
        }


#endif

-- method Clock::add_observation_unapplied
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "slave"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a time on the slave"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "master"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a time on the master"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "r_squared"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to hold the result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "internal"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the internal time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "external"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the external time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "rate_num"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the rate numerator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "rate_denom"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the rate denominator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_add_observation_unapplied" gst_clock_add_observation_unapplied :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Word64 ->                               -- slave : TBasicType TUInt64
    Word64 ->                               -- master : TBasicType TUInt64
    Ptr CDouble ->                          -- r_squared : TBasicType TDouble
    Ptr Word64 ->                           -- internal : TBasicType TUInt64
    Ptr Word64 ->                           -- external : TBasicType TUInt64
    Ptr Word64 ->                           -- rate_num : TBasicType TUInt64
    Ptr Word64 ->                           -- rate_denom : TBasicType TUInt64
    IO CInt

-- | Add a clock observation to the internal slaving algorithm the same as
-- 'GI.Gst.Objects.Clock.clockAddObservation', and return the result of the master clock
-- estimation, without updating the internal calibration.
-- 
-- The caller can then take the results and call 'GI.Gst.Objects.Clock.clockSetCalibration'
-- with the values, or some modified version of them.
-- 
-- /Since: 1.6/
clockAddObservationUnapplied ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock'
    -> Word64
    -- ^ /@slave@/: a time on the slave
    -> Word64
    -- ^ /@master@/: a time on the master
    -> m ((Bool, Double, Word64, Word64, Word64, Word64))
clockAddObservationUnapplied :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a
-> Word64
-> Word64
-> m (Bool, Double, Word64, Word64, Word64, Word64)
clockAddObservationUnapplied a
clock Word64
slave Word64
master = IO (Bool, Double, Word64, Word64, Word64, Word64)
-> m (Bool, Double, Word64, Word64, Word64, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Double, Word64, Word64, Word64, Word64)
 -> m (Bool, Double, Word64, Word64, Word64, Word64))
-> IO (Bool, Double, Word64, Word64, Word64, Word64)
-> m (Bool, Double, Word64, Word64, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Ptr CDouble
rSquared <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr Word64
internal <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
external <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
rateNum <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
rateDenom <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CInt
result <- Ptr Clock
-> Word64
-> Word64
-> Ptr CDouble
-> Ptr Word64
-> Ptr Word64
-> Ptr Word64
-> Ptr Word64
-> IO CInt
gst_clock_add_observation_unapplied Ptr Clock
clock' Word64
slave Word64
master Ptr CDouble
rSquared Ptr Word64
internal Ptr Word64
external Ptr Word64
rateNum Ptr Word64
rateDenom
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CDouble
rSquared' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
rSquared
    let rSquared'' :: Double
rSquared'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
rSquared'
    Word64
internal' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
internal
    Word64
external' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
external
    Word64
rateNum' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
rateNum
    Word64
rateDenom' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
rateDenom
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
rSquared
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
internal
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
external
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
rateNum
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
rateDenom
    (Bool, Double, Word64, Word64, Word64, Word64)
-> IO (Bool, Double, Word64, Word64, Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Double
rSquared'', Word64
internal', Word64
external', Word64
rateNum', Word64
rateDenom')

#if defined(ENABLE_OVERLOADING)
data ClockAddObservationUnappliedMethodInfo
instance (signature ~ (Word64 -> Word64 -> m ((Bool, Double, Word64, Word64, Word64, Word64))), MonadIO m, IsClock a) => O.OverloadedMethod ClockAddObservationUnappliedMethodInfo a signature where
    overloadedMethod = clockAddObservationUnapplied

instance O.OverloadedMethodInfo ClockAddObservationUnappliedMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockAddObservationUnapplied",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockAddObservationUnapplied"
        }


#endif

-- method Clock::adjust_unlocked
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "internal"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a clock time" , 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_clock_adjust_unlocked" gst_clock_adjust_unlocked :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Word64 ->                               -- internal : TBasicType TUInt64
    IO Word64

-- | Converts the given /@internal@/ clock time to the external time, adjusting for the
-- rate and reference time set with 'GI.Gst.Objects.Clock.clockSetCalibration' and making sure
-- that the returned time is increasing. This function should be called with the
-- clock\'s OBJECT_LOCK held and is mainly used by clock subclasses.
-- 
-- This function is the reverse of 'GI.Gst.Objects.Clock.clockUnadjustUnlocked'.
clockAdjustUnlocked ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock' to use
    -> Word64
    -- ^ /@internal@/: a clock time
    -> m Word64
    -- ^ __Returns:__ the converted time of the clock.
clockAdjustUnlocked :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Word64 -> m Word64
clockAdjustUnlocked a
clock Word64
internal = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Word64
result <- Ptr Clock -> Word64 -> IO Word64
gst_clock_adjust_unlocked Ptr Clock
clock' Word64
internal
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ClockAdjustUnlockedMethodInfo
instance (signature ~ (Word64 -> m Word64), MonadIO m, IsClock a) => O.OverloadedMethod ClockAdjustUnlockedMethodInfo a signature where
    overloadedMethod = clockAdjustUnlocked

instance O.OverloadedMethodInfo ClockAdjustUnlockedMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockAdjustUnlocked",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockAdjustUnlocked"
        }


#endif

-- method Clock::adjust_with_calibration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "internal_target"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a clock time" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cinternal"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a reference internal time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cexternal"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a reference external time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cnum"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the numerator of the rate of the clock relative to its\n       internal time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cdenom"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the denominator of the rate of the clock"
--                 , 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_clock_adjust_with_calibration" gst_clock_adjust_with_calibration :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Word64 ->                               -- internal_target : TBasicType TUInt64
    Word64 ->                               -- cinternal : TBasicType TUInt64
    Word64 ->                               -- cexternal : TBasicType TUInt64
    Word64 ->                               -- cnum : TBasicType TUInt64
    Word64 ->                               -- cdenom : TBasicType TUInt64
    IO Word64

-- | Converts the given /@internalTarget@/ clock time to the external time,
-- using the passed calibration parameters. This function performs the
-- same calculation as 'GI.Gst.Objects.Clock.clockAdjustUnlocked' when called using the
-- current calibration parameters, but doesn\'t ensure a monotonically
-- increasing result as 'GI.Gst.Objects.Clock.clockAdjustUnlocked' does.
-- 
-- Note: The /@clock@/ parameter is unused and can be NULL
-- 
-- /Since: 1.6/
clockAdjustWithCalibration ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock' to use
    -> Word64
    -- ^ /@internalTarget@/: a clock time
    -> Word64
    -- ^ /@cinternal@/: a reference internal time
    -> Word64
    -- ^ /@cexternal@/: a reference external time
    -> Word64
    -- ^ /@cnum@/: the numerator of the rate of the clock relative to its
    --        internal time
    -> Word64
    -- ^ /@cdenom@/: the denominator of the rate of the clock
    -> m Word64
    -- ^ __Returns:__ the converted time of the clock.
clockAdjustWithCalibration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> m Word64
clockAdjustWithCalibration a
clock Word64
internalTarget Word64
cinternal Word64
cexternal Word64
cnum Word64
cdenom = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Word64
result <- Ptr Clock
-> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> IO Word64
gst_clock_adjust_with_calibration Ptr Clock
clock' Word64
internalTarget Word64
cinternal Word64
cexternal Word64
cnum Word64
cdenom
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ClockAdjustWithCalibrationMethodInfo
instance (signature ~ (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> m Word64), MonadIO m, IsClock a) => O.OverloadedMethod ClockAdjustWithCalibrationMethodInfo a signature where
    overloadedMethod = clockAdjustWithCalibration

instance O.OverloadedMethodInfo ClockAdjustWithCalibrationMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockAdjustWithCalibration",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockAdjustWithCalibration"
        }


#endif

-- method Clock::get_calibration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "internal"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the internal time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "external"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the external time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "rate_num"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the rate numerator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "rate_denom"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store the rate denominator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_get_calibration" gst_clock_get_calibration :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Ptr Word64 ->                           -- internal : TBasicType TUInt64
    Ptr Word64 ->                           -- external : TBasicType TUInt64
    Ptr Word64 ->                           -- rate_num : TBasicType TUInt64
    Ptr Word64 ->                           -- rate_denom : TBasicType TUInt64
    IO ()

-- | Gets the internal rate and reference time of /@clock@/. See
-- 'GI.Gst.Objects.Clock.clockSetCalibration' for more information.
-- 
-- /@internal@/, /@external@/, /@rateNum@/, and /@rateDenom@/ can be left 'P.Nothing' if the
-- caller is not interested in the values.
-- 
-- MT safe.
clockGetCalibration ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock'
    -> m ((Word64, Word64, Word64, Word64))
clockGetCalibration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> m (Word64, Word64, Word64, Word64)
clockGetCalibration a
clock = IO (Word64, Word64, Word64, Word64)
-> m (Word64, Word64, Word64, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word64, Word64, Word64, Word64)
 -> m (Word64, Word64, Word64, Word64))
-> IO (Word64, Word64, Word64, Word64)
-> m (Word64, Word64, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Ptr Word64
internal <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
external <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
rateNum <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
rateDenom <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Clock
-> Ptr Word64 -> Ptr Word64 -> Ptr Word64 -> Ptr Word64 -> IO ()
gst_clock_get_calibration Ptr Clock
clock' Ptr Word64
internal Ptr Word64
external Ptr Word64
rateNum Ptr Word64
rateDenom
    Word64
internal' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
internal
    Word64
external' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
external
    Word64
rateNum' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
rateNum
    Word64
rateDenom' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
rateDenom
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
internal
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
external
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
rateNum
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
rateDenom
    (Word64, Word64, Word64, Word64)
-> IO (Word64, Word64, Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
internal', Word64
external', Word64
rateNum', Word64
rateDenom')

#if defined(ENABLE_OVERLOADING)
data ClockGetCalibrationMethodInfo
instance (signature ~ (m ((Word64, Word64, Word64, Word64))), MonadIO m, IsClock a) => O.OverloadedMethod ClockGetCalibrationMethodInfo a signature where
    overloadedMethod = clockGetCalibration

instance O.OverloadedMethodInfo ClockGetCalibrationMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockGetCalibration",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockGetCalibration"
        }


#endif

-- method Clock::get_internal_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock to query"
--                 , 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_clock_get_internal_time" gst_clock_get_internal_time :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO Word64

-- | Gets the current internal time of the given clock. The time is returned
-- unadjusted for the offset and the rate.
clockGetInternalTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock' to query
    -> m Word64
    -- ^ __Returns:__ the internal time of the clock. Or GST_CLOCK_TIME_NONE when
    -- given invalid input.
    -- 
    -- MT safe.
clockGetInternalTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> m Word64
clockGetInternalTime a
clock = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Word64
result <- Ptr Clock -> IO Word64
gst_clock_get_internal_time Ptr Clock
clock'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ClockGetInternalTimeMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsClock a) => O.OverloadedMethod ClockGetInternalTimeMethodInfo a signature where
    overloadedMethod = clockGetInternalTime

instance O.OverloadedMethodInfo ClockGetInternalTimeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockGetInternalTime",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockGetInternalTime"
        }


#endif

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

foreign import ccall "gst_clock_get_master" gst_clock_get_master :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO (Ptr Clock)

-- | Get the master clock that /@clock@/ is slaved to or 'P.Nothing' when the clock is
-- not slaved to any master clock.
clockGetMaster ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock'
    -> m (Maybe Clock)
    -- ^ __Returns:__ a master t'GI.Gst.Objects.Clock.Clock' or 'P.Nothing'
    --     when this clock is not slaved to a master clock. Unref after
    --     usage.
    -- 
    -- MT safe.
clockGetMaster :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> m (Maybe Clock)
clockGetMaster a
clock = IO (Maybe Clock) -> m (Maybe Clock)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Clock) -> m (Maybe Clock))
-> IO (Maybe Clock) -> m (Maybe Clock)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Ptr Clock
result <- Ptr Clock -> IO (Ptr Clock)
gst_clock_get_master Ptr Clock
clock'
    Maybe Clock
maybeResult <- Ptr Clock -> (Ptr Clock -> IO Clock) -> IO (Maybe Clock)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Clock
result ((Ptr Clock -> IO Clock) -> IO (Maybe Clock))
-> (Ptr Clock -> IO Clock) -> IO (Maybe Clock)
forall a b. (a -> b) -> a -> b
$ \Ptr Clock
result' -> do
        Clock
result'' <- ((ManagedPtr Clock -> Clock) -> Ptr Clock -> IO Clock
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Clock -> Clock
Clock) Ptr Clock
result'
        Clock -> IO Clock
forall (m :: * -> *) a. Monad m => a -> m a
return Clock
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Maybe Clock -> IO (Maybe Clock)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Clock
maybeResult

#if defined(ENABLE_OVERLOADING)
data ClockGetMasterMethodInfo
instance (signature ~ (m (Maybe Clock)), MonadIO m, IsClock a) => O.OverloadedMethod ClockGetMasterMethodInfo a signature where
    overloadedMethod = clockGetMaster

instance O.OverloadedMethodInfo ClockGetMasterMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockGetMaster",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockGetMaster"
        }


#endif

-- method Clock::get_resolution
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock" , 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_clock_get_resolution" gst_clock_get_resolution :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO Word64

-- | Get the accuracy of the clock. The accuracy of the clock is the granularity
-- of the values returned by 'GI.Gst.Objects.Clock.clockGetTime'.
clockGetResolution ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock'
    -> m Word64
    -- ^ __Returns:__ the resolution of the clock in units of @/GstClockTime/@.
    -- 
    -- MT safe.
clockGetResolution :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> m Word64
clockGetResolution a
clock = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Word64
result <- Ptr Clock -> IO Word64
gst_clock_get_resolution Ptr Clock
clock'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ClockGetResolutionMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsClock a) => O.OverloadedMethod ClockGetResolutionMethodInfo a signature where
    overloadedMethod = clockGetResolution

instance O.OverloadedMethodInfo ClockGetResolutionMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockGetResolution",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockGetResolution"
        }


#endif

-- method Clock::get_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock to query"
--                 , 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_clock_get_time" gst_clock_get_time :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO Word64

-- | Gets the current time of the given clock. The time is always
-- monotonically increasing and adjusted according to the current
-- offset and rate.
clockGetTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock' to query
    -> m Word64
    -- ^ __Returns:__ the time of the clock. Or GST_CLOCK_TIME_NONE when
    -- given invalid input.
    -- 
    -- MT safe.
clockGetTime :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> m Word64
clockGetTime a
clock = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Word64
result <- Ptr Clock -> IO Word64
gst_clock_get_time Ptr Clock
clock'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ClockGetTimeMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsClock a) => O.OverloadedMethod ClockGetTimeMethodInfo a signature where
    overloadedMethod = clockGetTime

instance O.OverloadedMethodInfo ClockGetTimeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockGetTime",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockGetTime"
        }


#endif

-- method Clock::get_timeout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock" , 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_clock_get_timeout" gst_clock_get_timeout :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO Word64

-- | Get the amount of time that master and slave clocks are sampled.
clockGetTimeout ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock'
    -> m Word64
    -- ^ __Returns:__ the interval between samples.
clockGetTimeout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> m Word64
clockGetTimeout a
clock = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Word64
result <- Ptr Clock -> IO Word64
gst_clock_get_timeout Ptr Clock
clock'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ClockGetTimeoutMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsClock a) => O.OverloadedMethod ClockGetTimeoutMethodInfo a signature where
    overloadedMethod = clockGetTimeout

instance O.OverloadedMethodInfo ClockGetTimeoutMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockGetTimeout",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockGetTimeout"
        }


#endif

-- method Clock::is_synced
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GstClock" , 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_clock_is_synced" gst_clock_is_synced :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO CInt

-- | Checks if the clock is currently synced.
-- 
-- This returns if GST_CLOCK_FLAG_NEEDS_STARTUP_SYNC is not set on the clock.
-- 
-- /Since: 1.6/
clockIsSynced ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a GstClock
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the clock is currently synced
clockIsSynced :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> m Bool
clockIsSynced a
clock = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    CInt
result <- Ptr Clock -> IO CInt
gst_clock_is_synced Ptr Clock
clock'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClockIsSyncedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsClock a) => O.OverloadedMethod ClockIsSyncedMethodInfo a signature where
    overloadedMethod = clockIsSynced

instance O.OverloadedMethodInfo ClockIsSyncedMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockIsSynced",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockIsSynced"
        }


#endif

-- method Clock::new_periodic_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #GstClockID to get a periodic notification id from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the requested start time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the requested interval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_new_periodic_id" gst_clock_new_periodic_id :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Word64 ->                               -- start_time : TBasicType TUInt64
    Word64 ->                               -- interval : TBasicType TUInt64
    IO (Ptr ())

-- | Get an ID from /@clock@/ to trigger a periodic notification.
-- The periodic notifications will start at time /@startTime@/ and
-- will then be fired with the given /@interval@/. /@id@/ should be unreffed
-- after usage.
-- 
-- Free-function: gst_clock_id_unref
clockNewPeriodicId ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: The @/GstClockID/@ to get a periodic notification id from
    -> Word64
    -- ^ /@startTime@/: the requested start time
    -> Word64
    -- ^ /@interval@/: the requested interval
    -> m (Ptr ())
    -- ^ __Returns:__ a @/GstClockID/@ that can be used to request the
    --     time notification.
    -- 
    -- MT safe.
clockNewPeriodicId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Word64 -> Word64 -> m (Ptr ())
clockNewPeriodicId a
clock Word64
startTime Word64
interval = IO (Ptr ()) -> m (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Ptr ()
result <- Ptr Clock -> Word64 -> Word64 -> IO (Ptr ())
gst_clock_new_periodic_id Ptr Clock
clock' Word64
startTime Word64
interval
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data ClockNewPeriodicIdMethodInfo
instance (signature ~ (Word64 -> Word64 -> m (Ptr ())), MonadIO m, IsClock a) => O.OverloadedMethod ClockNewPeriodicIdMethodInfo a signature where
    overloadedMethod = clockNewPeriodicId

instance O.OverloadedMethodInfo ClockNewPeriodicIdMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockNewPeriodicId",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockNewPeriodicId"
        }


#endif

-- method Clock::new_single_shot_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #GstClockID to get a single shot notification from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the requested time" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_new_single_shot_id" gst_clock_new_single_shot_id :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Word64 ->                               -- time : TBasicType TUInt64
    IO (Ptr ())

-- | Get a @/GstClockID/@ from /@clock@/ to trigger a single shot
-- notification at the requested time. The single shot id should be
-- unreffed after usage.
-- 
-- Free-function: gst_clock_id_unref
clockNewSingleShotId ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: The @/GstClockID/@ to get a single shot notification from
    -> Word64
    -- ^ /@time@/: the requested time
    -> m (Ptr ())
    -- ^ __Returns:__ a @/GstClockID/@ that can be used to request the
    --     time notification.
    -- 
    -- MT safe.
clockNewSingleShotId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Word64 -> m (Ptr ())
clockNewSingleShotId a
clock Word64
time = IO (Ptr ()) -> m (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Ptr ()
result <- Ptr Clock -> Word64 -> IO (Ptr ())
gst_clock_new_single_shot_id Ptr Clock
clock' Word64
time
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data ClockNewSingleShotIdMethodInfo
instance (signature ~ (Word64 -> m (Ptr ())), MonadIO m, IsClock a) => O.OverloadedMethod ClockNewSingleShotIdMethodInfo a signature where
    overloadedMethod = clockNewSingleShotId

instance O.OverloadedMethodInfo ClockNewSingleShotIdMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockNewSingleShotId",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockNewSingleShotId"
        }


#endif

-- method Clock::periodic_id_reinit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClockID" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the requested start time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "interval"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the requested interval"
--                 , 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_clock_periodic_id_reinit" gst_clock_periodic_id_reinit :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Ptr () ->                               -- id : TBasicType TPtr
    Word64 ->                               -- start_time : TBasicType TUInt64
    Word64 ->                               -- interval : TBasicType TUInt64
    IO CInt

-- | Reinitializes the provided periodic /@id@/ to the provided start time and
-- interval. Does not modify the reference count.
clockPeriodicIdReinit ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock'
    -> Ptr ()
    -- ^ /@id@/: a @/GstClockID/@
    -> Word64
    -- ^ /@startTime@/: the requested start time
    -> Word64
    -- ^ /@interval@/: the requested interval
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the GstClockID could be reinitialized to the provided
    -- /@time@/, else 'P.False'.
clockPeriodicIdReinit :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Ptr () -> Word64 -> Word64 -> m Bool
clockPeriodicIdReinit a
clock Ptr ()
id Word64
startTime Word64
interval = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    CInt
result <- Ptr Clock -> Ptr () -> Word64 -> Word64 -> IO CInt
gst_clock_periodic_id_reinit Ptr Clock
clock' Ptr ()
id Word64
startTime Word64
interval
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClockPeriodicIdReinitMethodInfo
instance (signature ~ (Ptr () -> Word64 -> Word64 -> m Bool), MonadIO m, IsClock a) => O.OverloadedMethod ClockPeriodicIdReinitMethodInfo a signature where
    overloadedMethod = clockPeriodicIdReinit

instance O.OverloadedMethodInfo ClockPeriodicIdReinitMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockPeriodicIdReinit",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockPeriodicIdReinit"
        }


#endif

-- method Clock::set_calibration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock to calibrate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "internal"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a reference internal time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "external"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a reference external time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rate_num"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the numerator of the rate of the clock relative to its\n           internal time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rate_denom"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the denominator of the rate of the clock"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_set_calibration" gst_clock_set_calibration :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Word64 ->                               -- internal : TBasicType TUInt64
    Word64 ->                               -- external : TBasicType TUInt64
    Word64 ->                               -- rate_num : TBasicType TUInt64
    Word64 ->                               -- rate_denom : TBasicType TUInt64
    IO ()

-- | Adjusts the rate and time of /@clock@/. A rate of 1\/1 is the normal speed of
-- the clock. Values bigger than 1\/1 make the clock go faster.
-- 
-- /@internal@/ and /@external@/ are calibration parameters that arrange that
-- 'GI.Gst.Objects.Clock.clockGetTime' should have been /@external@/ at internal time /@internal@/.
-- This internal time should not be in the future; that is, it should be less
-- than the value of 'GI.Gst.Objects.Clock.clockGetInternalTime' when this function is called.
-- 
-- Subsequent calls to 'GI.Gst.Objects.Clock.clockGetTime' will return clock times computed as
-- follows:
-- 
-- >
-- >  time = (internal_time - internal) * rate_num / rate_denom + external
-- 
-- 
-- This formula is implemented in 'GI.Gst.Objects.Clock.clockAdjustUnlocked'. Of course, it
-- tries to do the integer arithmetic as precisely as possible.
-- 
-- Note that 'GI.Gst.Objects.Clock.clockGetTime' always returns increasing values so when you
-- move the clock backwards, 'GI.Gst.Objects.Clock.clockGetTime' will report the previous value
-- until the clock catches up.
-- 
-- MT safe.
clockSetCalibration ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock' to calibrate
    -> Word64
    -- ^ /@internal@/: a reference internal time
    -> Word64
    -- ^ /@external@/: a reference external time
    -> Word64
    -- ^ /@rateNum@/: the numerator of the rate of the clock relative to its
    --            internal time
    -> Word64
    -- ^ /@rateDenom@/: the denominator of the rate of the clock
    -> m ()
clockSetCalibration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Word64 -> Word64 -> Word64 -> Word64 -> m ()
clockSetCalibration a
clock Word64
internal Word64
external Word64
rateNum Word64
rateDenom = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Ptr Clock -> Word64 -> Word64 -> Word64 -> Word64 -> IO ()
gst_clock_set_calibration Ptr Clock
clock' Word64
internal Word64
external Word64
rateNum Word64
rateDenom
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClockSetCalibrationMethodInfo
instance (signature ~ (Word64 -> Word64 -> Word64 -> Word64 -> m ()), MonadIO m, IsClock a) => O.OverloadedMethod ClockSetCalibrationMethodInfo a signature where
    overloadedMethod = clockSetCalibration

instance O.OverloadedMethodInfo ClockSetCalibrationMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockSetCalibration",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockSetCalibration"
        }


#endif

-- method Clock::set_master
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "master"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a master #GstClock" , 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_clock_set_master" gst_clock_set_master :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Ptr Clock ->                            -- master : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO CInt

-- | Set /@master@/ as the master clock for /@clock@/. /@clock@/ will be automatically
-- calibrated so that 'GI.Gst.Objects.Clock.clockGetTime' reports the same time as the
-- master clock.
-- 
-- A clock provider that slaves its clock to a master can get the current
-- calibration values with 'GI.Gst.Objects.Clock.clockGetCalibration'.
-- 
-- /@master@/ can be 'P.Nothing' in which case /@clock@/ will not be slaved anymore. It will
-- however keep reporting its time adjusted with the last configured rate
-- and time offsets.
clockSetMaster ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a, IsClock b) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock'
    -> Maybe (b)
    -- ^ /@master@/: a master t'GI.Gst.Objects.Clock.Clock'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the clock is capable of being slaved to a master clock.
    -- Trying to set a master on a clock without the
    -- @/GST_CLOCK_FLAG_CAN_SET_MASTER/@ flag will make this function return 'P.False'.
    -- 
    -- MT safe.
clockSetMaster :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClock a, IsClock b) =>
a -> Maybe b -> m Bool
clockSetMaster a
clock Maybe b
master = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Ptr Clock
maybeMaster <- case Maybe b
master of
        Maybe b
Nothing -> Ptr Clock -> IO (Ptr Clock)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Clock
forall a. Ptr a
nullPtr
        Just b
jMaster -> do
            Ptr Clock
jMaster' <- b -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMaster
            Ptr Clock -> IO (Ptr Clock)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Clock
jMaster'
    CInt
result <- Ptr Clock -> Ptr Clock -> IO CInt
gst_clock_set_master Ptr Clock
clock' Ptr Clock
maybeMaster
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
master b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClockSetMasterMethodInfo
instance (signature ~ (Maybe (b) -> m Bool), MonadIO m, IsClock a, IsClock b) => O.OverloadedMethod ClockSetMasterMethodInfo a signature where
    overloadedMethod = clockSetMaster

instance O.OverloadedMethodInfo ClockSetMasterMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockSetMaster",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockSetMaster"
        }


#endif

-- method Clock::set_resolution
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "resolution"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The resolution to set"
--                 , 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_clock_set_resolution" gst_clock_set_resolution :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Word64 ->                               -- resolution : TBasicType TUInt64
    IO Word64

-- | Set the accuracy of the clock. Some clocks have the possibility to operate
-- with different accuracy at the expense of more resource usage. There is
-- normally no need to change the default resolution of a clock. The resolution
-- of a clock can only be changed if the clock has the
-- @/GST_CLOCK_FLAG_CAN_SET_RESOLUTION/@ flag set.
clockSetResolution ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock'
    -> Word64
    -- ^ /@resolution@/: The resolution to set
    -> m Word64
    -- ^ __Returns:__ the new resolution of the clock.
clockSetResolution :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Word64 -> m Word64
clockSetResolution a
clock Word64
resolution = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Word64
result <- Ptr Clock -> Word64 -> IO Word64
gst_clock_set_resolution Ptr Clock
clock' Word64
resolution
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ClockSetResolutionMethodInfo
instance (signature ~ (Word64 -> m Word64), MonadIO m, IsClock a) => O.OverloadedMethod ClockSetResolutionMethodInfo a signature where
    overloadedMethod = clockSetResolution

instance O.OverloadedMethodInfo ClockSetResolutionMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockSetResolution",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockSetResolution"
        }


#endif

-- method Clock::set_synced
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GstClock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "synced"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "if the clock is synced"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_set_synced" gst_clock_set_synced :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    CInt ->                                 -- synced : TBasicType TBoolean
    IO ()

-- | Sets /@clock@/ to synced and emits the GstClock[synced](#g:signal:synced) signal, and wakes up any
-- thread waiting in 'GI.Gst.Objects.Clock.clockWaitForSync'.
-- 
-- This function must only be called if GST_CLOCK_FLAG_NEEDS_STARTUP_SYNC
-- is set on the clock, and is intended to be called by subclasses only.
-- 
-- /Since: 1.6/
clockSetSynced ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a GstClock
    -> Bool
    -- ^ /@synced@/: if the clock is synced
    -> m ()
clockSetSynced :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Bool -> m ()
clockSetSynced a
clock Bool
synced = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    let synced' :: CInt
synced' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
synced
    Ptr Clock -> CInt -> IO ()
gst_clock_set_synced Ptr Clock
clock' CInt
synced'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClockSetSyncedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsClock a) => O.OverloadedMethod ClockSetSyncedMethodInfo a signature where
    overloadedMethod = clockSetSynced

instance O.OverloadedMethodInfo ClockSetSyncedMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockSetSynced",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockSetSynced"
        }


#endif

-- method Clock::set_timeout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timeout" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_set_timeout" gst_clock_set_timeout :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Word64 ->                               -- timeout : TBasicType TUInt64
    IO ()

-- | Set the amount of time, in nanoseconds, to sample master and slave
-- clocks
clockSetTimeout ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock'
    -> Word64
    -- ^ /@timeout@/: a timeout
    -> m ()
clockSetTimeout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Word64 -> m ()
clockSetTimeout a
clock Word64
timeout = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Ptr Clock -> Word64 -> IO ()
gst_clock_set_timeout Ptr Clock
clock' Word64
timeout
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClockSetTimeoutMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsClock a) => O.OverloadedMethod ClockSetTimeoutMethodInfo a signature where
    overloadedMethod = clockSetTimeout

instance O.OverloadedMethodInfo ClockSetTimeoutMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockSetTimeout",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockSetTimeout"
        }


#endif

-- method Clock::single_shot_id_reinit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClockID" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The requested time."
--                 , 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_clock_single_shot_id_reinit" gst_clock_single_shot_id_reinit :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Ptr () ->                               -- id : TBasicType TPtr
    Word64 ->                               -- time : TBasicType TUInt64
    IO CInt

-- | Reinitializes the provided single shot /@id@/ to the provided time. Does not
-- modify the reference count.
clockSingleShotIdReinit ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock'
    -> Ptr ()
    -- ^ /@id@/: a @/GstClockID/@
    -> Word64
    -- ^ /@time@/: The requested time.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the GstClockID could be reinitialized to the provided
    -- /@time@/, else 'P.False'.
clockSingleShotIdReinit :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Ptr () -> Word64 -> m Bool
clockSingleShotIdReinit a
clock Ptr ()
id Word64
time = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    CInt
result <- Ptr Clock -> Ptr () -> Word64 -> IO CInt
gst_clock_single_shot_id_reinit Ptr Clock
clock' Ptr ()
id Word64
time
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClockSingleShotIdReinitMethodInfo
instance (signature ~ (Ptr () -> Word64 -> m Bool), MonadIO m, IsClock a) => O.OverloadedMethod ClockSingleShotIdReinitMethodInfo a signature where
    overloadedMethod = clockSingleShotIdReinit

instance O.OverloadedMethodInfo ClockSingleShotIdReinitMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockSingleShotIdReinit",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockSingleShotIdReinit"
        }


#endif

-- method Clock::unadjust_unlocked
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "external"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an external clock time"
--                 , 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_clock_unadjust_unlocked" gst_clock_unadjust_unlocked :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Word64 ->                               -- external : TBasicType TUInt64
    IO Word64

-- | Converts the given /@external@/ clock time to the internal time of /@clock@/,
-- using the rate and reference time set with 'GI.Gst.Objects.Clock.clockSetCalibration'.
-- This function should be called with the clock\'s OBJECT_LOCK held and
-- is mainly used by clock subclasses.
-- 
-- This function is the reverse of 'GI.Gst.Objects.Clock.clockAdjustUnlocked'.
clockUnadjustUnlocked ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock' to use
    -> Word64
    -- ^ /@external@/: an external clock time
    -> m Word64
    -- ^ __Returns:__ the internal time of the clock corresponding to /@external@/.
clockUnadjustUnlocked :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Word64 -> m Word64
clockUnadjustUnlocked a
clock Word64
external = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Word64
result <- Ptr Clock -> Word64 -> IO Word64
gst_clock_unadjust_unlocked Ptr Clock
clock' Word64
external
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ClockUnadjustUnlockedMethodInfo
instance (signature ~ (Word64 -> m Word64), MonadIO m, IsClock a) => O.OverloadedMethod ClockUnadjustUnlockedMethodInfo a signature where
    overloadedMethod = clockUnadjustUnlocked

instance O.OverloadedMethodInfo ClockUnadjustUnlockedMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockUnadjustUnlocked",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockUnadjustUnlocked"
        }


#endif

-- method Clock::unadjust_with_calibration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "external_target"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a clock time" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cinternal"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a reference internal time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cexternal"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a reference external time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cnum"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the numerator of the rate of the clock relative to its\n       internal time"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cdenom"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the denominator of the rate of the clock"
--                 , 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_clock_unadjust_with_calibration" gst_clock_unadjust_with_calibration :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Word64 ->                               -- external_target : TBasicType TUInt64
    Word64 ->                               -- cinternal : TBasicType TUInt64
    Word64 ->                               -- cexternal : TBasicType TUInt64
    Word64 ->                               -- cnum : TBasicType TUInt64
    Word64 ->                               -- cdenom : TBasicType TUInt64
    IO Word64

-- | Converts the given /@externalTarget@/ clock time to the internal time,
-- using the passed calibration parameters. This function performs the
-- same calculation as 'GI.Gst.Objects.Clock.clockUnadjustUnlocked' when called using the
-- current calibration parameters.
-- 
-- Note: The /@clock@/ parameter is unused and can be NULL
-- 
-- /Since: 1.8/
clockUnadjustWithCalibration ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock' to use
    -> Word64
    -- ^ /@externalTarget@/: a clock time
    -> Word64
    -- ^ /@cinternal@/: a reference internal time
    -> Word64
    -- ^ /@cexternal@/: a reference external time
    -> Word64
    -- ^ /@cnum@/: the numerator of the rate of the clock relative to its
    --        internal time
    -> Word64
    -- ^ /@cdenom@/: the denominator of the rate of the clock
    -> m Word64
    -- ^ __Returns:__ the converted time of the clock.
clockUnadjustWithCalibration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> m Word64
clockUnadjustWithCalibration a
clock Word64
externalTarget Word64
cinternal Word64
cexternal Word64
cnum Word64
cdenom = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    Word64
result <- Ptr Clock
-> Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> IO Word64
gst_clock_unadjust_with_calibration Ptr Clock
clock' Word64
externalTarget Word64
cinternal Word64
cexternal Word64
cnum Word64
cdenom
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data ClockUnadjustWithCalibrationMethodInfo
instance (signature ~ (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> m Word64), MonadIO m, IsClock a) => O.OverloadedMethod ClockUnadjustWithCalibrationMethodInfo a signature where
    overloadedMethod = clockUnadjustWithCalibration

instance O.OverloadedMethodInfo ClockUnadjustWithCalibrationMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockUnadjustWithCalibration",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockUnadjustWithCalibration"
        }


#endif

-- method Clock::wait_for_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GstClock" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "timeout for waiting or %GST_CLOCK_TIME_NONE"
--                 , 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_clock_wait_for_sync" gst_clock_wait_for_sync :: 
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    Word64 ->                               -- timeout : TBasicType TUInt64
    IO CInt

-- | Waits until /@clock@/ is synced for reporting the current time. If /@timeout@/
-- is 'GI.Gst.Constants.CLOCK_TIME_NONE' it will wait forever, otherwise it will time out
-- after /@timeout@/ nanoseconds.
-- 
-- For asynchronous waiting, the GstClock[synced](#g:signal:synced) signal can be used.
-- 
-- This returns immediately with TRUE if GST_CLOCK_FLAG_NEEDS_STARTUP_SYNC
-- is not set on the clock, or if the clock is already synced.
-- 
-- /Since: 1.6/
clockWaitForSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    a
    -- ^ /@clock@/: a GstClock
    -> Word64
    -- ^ /@timeout@/: timeout for waiting or 'GI.Gst.Constants.CLOCK_TIME_NONE'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if waiting was successful, or 'P.False' on timeout
clockWaitForSync :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
a -> Word64 -> m Bool
clockWaitForSync a
clock Word64
timeout = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    CInt
result <- Ptr Clock -> Word64 -> IO CInt
gst_clock_wait_for_sync Ptr Clock
clock' Word64
timeout
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ClockWaitForSyncMethodInfo
instance (signature ~ (Word64 -> m Bool), MonadIO m, IsClock a) => O.OverloadedMethod ClockWaitForSyncMethodInfo a signature where
    overloadedMethod = clockWaitForSync

instance O.OverloadedMethodInfo ClockWaitForSyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gst.Objects.Clock.clockWaitForSync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gst-1.0.24/docs/GI-Gst-Objects-Clock.html#v:clockWaitForSync"
        }


#endif

-- method Clock::id_compare_func
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "id1"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstClockID" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id2"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GstClockID to compare with"
--                 , 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_clock_id_compare_func" gst_clock_id_compare_func :: 
    Ptr () ->                               -- id1 : TBasicType TPtr
    Ptr () ->                               -- id2 : TBasicType TPtr
    IO Int32

-- | Compares the two @/GstClockID/@ instances. This function can be used
-- as a GCompareFunc when sorting ids.
clockIdCompareFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@id1@/: A @/GstClockID/@
    -> Ptr ()
    -- ^ /@id2@/: A @/GstClockID/@ to compare with
    -> m Int32
    -- ^ __Returns:__ negative value if a \< b; zero if a = b; positive value if a > b
    -- 
    -- MT safe.
clockIdCompareFunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr () -> Ptr () -> m Int32
clockIdCompareFunc Ptr ()
id1 Ptr ()
id2 = 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
    Int32
result <- Ptr () -> Ptr () -> IO Int32
gst_clock_id_compare_func Ptr ()
id1 Ptr ()
id2
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
#endif

-- method Clock::id_get_clock
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClockID" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Clock" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_id_get_clock" gst_clock_id_get_clock :: 
    Ptr () ->                               -- id : TBasicType TPtr
    IO (Ptr Clock)

-- | This function returns the underlying clock.
-- 
-- /Since: 1.16/
clockIdGetClock ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@id@/: a @/GstClockID/@
    -> m (Maybe Clock)
    -- ^ __Returns:__ a t'GI.Gst.Objects.Clock.Clock' or 'P.Nothing' when the
    --     underlying clock has been freed.  Unref after usage.
    -- 
    -- MT safe.
clockIdGetClock :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr () -> m (Maybe Clock)
clockIdGetClock Ptr ()
id = IO (Maybe Clock) -> m (Maybe Clock)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Clock) -> m (Maybe Clock))
-> IO (Maybe Clock) -> m (Maybe Clock)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Clock
result <- Ptr () -> IO (Ptr Clock)
gst_clock_id_get_clock Ptr ()
id
    Maybe Clock
maybeResult <- Ptr Clock -> (Ptr Clock -> IO Clock) -> IO (Maybe Clock)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Clock
result ((Ptr Clock -> IO Clock) -> IO (Maybe Clock))
-> (Ptr Clock -> IO Clock) -> IO (Maybe Clock)
forall a b. (a -> b) -> a -> b
$ \Ptr Clock
result' -> do
        Clock
result'' <- ((ManagedPtr Clock -> Clock) -> Ptr Clock -> IO Clock
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Clock -> Clock
Clock) Ptr Clock
result'
        Clock -> IO Clock
forall (m :: * -> *) a. Monad m => a -> m a
return Clock
result''
    Maybe Clock -> IO (Maybe Clock)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Clock
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Clock::id_get_time
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstClockID to query"
--                 , 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_clock_id_get_time" gst_clock_id_get_time :: 
    Ptr () ->                               -- id : TBasicType TPtr
    IO Word64

-- | Get the time of the clock ID
clockIdGetTime ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@id@/: The @/GstClockID/@ to query
    -> m Word64
    -- ^ __Returns:__ the time of the given clock id.
    -- 
    -- MT safe.
clockIdGetTime :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr () -> m Word64
clockIdGetTime Ptr ()
id = 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
    Word64
result <- Ptr () -> IO Word64
gst_clock_id_get_time Ptr ()
id
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
#endif

-- method Clock::id_ref
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstClockID to ref"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_id_ref" gst_clock_id_ref :: 
    Ptr () ->                               -- id : TBasicType TPtr
    IO (Ptr ())

-- | Increase the refcount of given /@id@/.
clockIdRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@id@/: The @/GstClockID/@ to ref
    -> m (Ptr ())
    -- ^ __Returns:__ The same @/GstClockID/@ with increased refcount.
    -- 
    -- MT safe.
clockIdRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr () -> m (Ptr ())
clockIdRef Ptr ()
id = IO (Ptr ()) -> m (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr ()
result <- Ptr () -> IO (Ptr ())
gst_clock_id_ref Ptr ()
id
    Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
#endif

-- method Clock::id_unref
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstClockID to unref"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_id_unref" gst_clock_id_unref :: 
    Ptr () ->                               -- id : TBasicType TPtr
    IO ()

-- | Unref given /@id@/. When the refcount reaches 0 the
-- @/GstClockID/@ will be freed.
-- 
-- MT safe.
clockIdUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@id@/: The @/GstClockID/@ to unref
    -> m ()
clockIdUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Ptr () -> m ()
clockIdUnref Ptr ()
id = 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 () -> IO ()
gst_clock_id_unref Ptr ()
id
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Clock::id_unschedule
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The id to unschedule"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_id_unschedule" gst_clock_id_unschedule :: 
    Ptr () ->                               -- id : TBasicType TPtr
    IO ()

-- | Cancel an outstanding request with /@id@/. This can either
-- be an outstanding async notification or a pending sync notification.
-- After this call, /@id@/ cannot be used anymore to receive sync or
-- async notifications, you need to create a new @/GstClockID/@.
-- 
-- MT safe.
clockIdUnschedule ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@id@/: The id to unschedule
    -> m ()
clockIdUnschedule :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Ptr () -> m ()
clockIdUnschedule Ptr ()
id = 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 () -> IO ()
gst_clock_id_unschedule Ptr ()
id
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method Clock::id_uses_clock
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClockID to check"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "clock"
--           , argType = TInterface Name { namespace = "Gst" , name = "Clock" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClock to compare against"
--                 , 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_clock_id_uses_clock" gst_clock_id_uses_clock :: 
    Ptr () ->                               -- id : TBasicType TPtr
    Ptr Clock ->                            -- clock : TInterface (Name {namespace = "Gst", name = "Clock"})
    IO CInt

-- | This function returns whether /@id@/ uses /@clock@/ as the underlying clock.
-- /@clock@/ can be NULL, in which case the return value indicates whether
-- the underlying clock has been freed.  If this is the case, the /@id@/ is
-- no longer usable and should be freed.
-- 
-- /Since: 1.16/
clockIdUsesClock ::
    (B.CallStack.HasCallStack, MonadIO m, IsClock a) =>
    Ptr ()
    -- ^ /@id@/: a @/GstClockID/@ to check
    -> a
    -- ^ /@clock@/: a t'GI.Gst.Objects.Clock.Clock' to compare against
    -> m Bool
    -- ^ __Returns:__ whether the clock /@id@/ uses the same underlying t'GI.Gst.Objects.Clock.Clock' /@clock@/.
    -- 
    -- MT safe.
clockIdUsesClock :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
Ptr () -> a -> m Bool
clockIdUsesClock Ptr ()
id a
clock = 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 Clock
clock' <- a -> IO (Ptr Clock)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clock
    CInt
result <- Ptr () -> Ptr Clock -> IO CInt
gst_clock_id_uses_clock Ptr ()
id Ptr Clock
clock'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
clock
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Clock::id_wait
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstClockID to wait on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "jitter"
--           , argType = TBasicType TInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a pointer that will contain the jitter,\n    can be %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "ClockReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_id_wait" gst_clock_id_wait :: 
    Ptr () ->                               -- id : TBasicType TPtr
    Ptr Int64 ->                            -- jitter : TBasicType TInt64
    IO CUInt

-- | Perform a blocking wait on /@id@/.
-- /@id@/ should have been created with 'GI.Gst.Objects.Clock.clockNewSingleShotId'
-- or 'GI.Gst.Objects.Clock.clockNewPeriodicId' and should not have been unscheduled
-- with a call to 'GI.Gst.Objects.Clock.clockIdUnschedule'.
-- 
-- If the /@jitter@/ argument is not 'P.Nothing' and this function returns @/GST_CLOCK_OK/@
-- or @/GST_CLOCK_EARLY/@, it will contain the difference
-- against the clock and the time of /@id@/ when this method was
-- called.
-- Positive values indicate how late /@id@/ was relative to the clock
-- (in which case this function will return @/GST_CLOCK_EARLY/@).
-- Negative values indicate how much time was spent waiting on the clock
-- before this function returned.
clockIdWait ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@id@/: The @/GstClockID/@ to wait on
    -> m ((Gst.Enums.ClockReturn, Int64))
    -- ^ __Returns:__ the result of the blocking wait. @/GST_CLOCK_EARLY/@ will be returned
    -- if the current clock time is past the time of /@id@/, @/GST_CLOCK_OK/@ if
    -- /@id@/ was scheduled in time. @/GST_CLOCK_UNSCHEDULED/@ if /@id@/ was
    -- unscheduled with 'GI.Gst.Objects.Clock.clockIdUnschedule'.
    -- 
    -- MT safe.
clockIdWait :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr () -> m (ClockReturn, Int64)
clockIdWait Ptr ()
id = IO (ClockReturn, Int64) -> m (ClockReturn, Int64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ClockReturn, Int64) -> m (ClockReturn, Int64))
-> IO (ClockReturn, Int64) -> m (ClockReturn, Int64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Int64
jitter <- IO (Ptr Int64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int64)
    CUInt
result <- Ptr () -> Ptr Int64 -> IO CUInt
gst_clock_id_wait Ptr ()
id Ptr Int64
jitter
    let result' :: ClockReturn
result' = (Int -> ClockReturn
forall a. Enum a => Int -> a
toEnum (Int -> ClockReturn) -> (CUInt -> Int) -> CUInt -> ClockReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Int64
jitter' <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
jitter
    Ptr Int64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int64
jitter
    (ClockReturn, Int64) -> IO (ClockReturn, Int64)
forall (m :: * -> *) a. Monad m => a -> m a
return (ClockReturn
result', Int64
jitter')

#if defined(ENABLE_OVERLOADING)
#endif

-- method Clock::id_wait_async
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstClockID to wait on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "ClockCallback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "User data passed in the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy_data"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GDestroyNotify for user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "ClockReturn" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_clock_id_wait_async" gst_clock_id_wait_async :: 
    Ptr () ->                               -- id : TBasicType TPtr
    FunPtr Gst.Callbacks.C_ClockCallback -> -- func : TInterface (Name {namespace = "Gst", name = "ClockCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy_data : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO CUInt

-- | Register a callback on the given @/GstClockID/@ /@id@/ with the given
-- function and user_data. When passing a @/GstClockID/@ with an invalid
-- time to this function, the callback will be called immediately
-- with  a time set to GST_CLOCK_TIME_NONE. The callback will
-- be called when the time of /@id@/ has been reached.
-- 
-- The callback /@func@/ can be invoked from any thread, either provided by the
-- core or from a streaming thread. The application should be prepared for this.
clockIdWaitAsync ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ptr ()
    -- ^ /@id@/: a @/GstClockID/@ to wait on
    -> Gst.Callbacks.ClockCallback
    -- ^ /@func@/: The callback function
    -> m Gst.Enums.ClockReturn
    -- ^ __Returns:__ the result of the non blocking wait.
    -- 
    -- MT safe.
clockIdWaitAsync :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ptr () -> ClockCallback -> m ClockReturn
clockIdWaitAsync Ptr ()
id ClockCallback
func = IO ClockReturn -> m ClockReturn
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ClockReturn -> m ClockReturn)
-> IO ClockReturn -> m ClockReturn
forall a b. (a -> b) -> a -> b
$ do
    FunPtr C_ClockCallback
func' <- C_ClockCallback -> IO (FunPtr C_ClockCallback)
Gst.Callbacks.mk_ClockCallback (Maybe (Ptr (FunPtr C_ClockCallback))
-> ClockCallback_WithClosures -> C_ClockCallback
Gst.Callbacks.wrap_ClockCallback Maybe (Ptr (FunPtr C_ClockCallback))
forall a. Maybe a
Nothing (ClockCallback -> ClockCallback_WithClosures
Gst.Callbacks.drop_closures_ClockCallback ClockCallback
func))
    let userData :: Ptr ()
userData = FunPtr C_ClockCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ClockCallback
func'
    let destroyData :: FunPtr (Ptr a -> IO ())
destroyData = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    CUInt
result <- Ptr ()
-> FunPtr C_ClockCallback
-> Ptr ()
-> FunPtr (Ptr () -> IO ())
-> IO CUInt
gst_clock_id_wait_async Ptr ()
id FunPtr C_ClockCallback
func' Ptr ()
userData FunPtr (Ptr () -> IO ())
forall a. FunPtr (Ptr a -> IO ())
destroyData
    let result' :: ClockReturn
result' = (Int -> ClockReturn
forall a. Enum a => Int -> a
toEnum (Int -> ClockReturn) -> (CUInt -> Int) -> CUInt -> ClockReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    ClockReturn -> IO ClockReturn
forall (m :: * -> *) a. Monad m => a -> m a
return ClockReturn
result'

#if defined(ENABLE_OVERLOADING)
#endif