{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- All pending timeouts or periodic notifies are converted into
-- an entry.
-- Note that GstClockEntry should be treated as an opaque structure. It must
-- not be extended or allocated using a custom allocator.

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

module GI.Gst.Structs.ClockEntry
    ( 

-- * Exported types
    ClockEntry(..)                          ,
    newZeroClockEntry                       ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveClockEntryMethod                 ,
#endif




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

    clearClockEntryClock                    ,
#if defined(ENABLE_OVERLOADING)
    clockEntry_clock                        ,
#endif
    getClockEntryClock                      ,
    setClockEntryClock                      ,


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

    clearClockEntryDestroyData              ,
#if defined(ENABLE_OVERLOADING)
    clockEntry_destroyData                  ,
#endif
    getClockEntryDestroyData                ,
    setClockEntryDestroyData                ,


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

    clearClockEntryFunc                     ,
#if defined(ENABLE_OVERLOADING)
    clockEntry_func                         ,
#endif
    getClockEntryFunc                       ,
    setClockEntryFunc                       ,


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

#if defined(ENABLE_OVERLOADING)
    clockEntry_interval                     ,
#endif
    getClockEntryInterval                   ,
    setClockEntryInterval                   ,


-- ** refcount #attr:refcount#
-- | reference counter (read-only)

#if defined(ENABLE_OVERLOADING)
    clockEntry_refcount                     ,
#endif
    getClockEntryRefcount                   ,
    setClockEntryRefcount                   ,


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

#if defined(ENABLE_OVERLOADING)
    clockEntry_status                       ,
#endif
    getClockEntryStatus                     ,
    setClockEntryStatus                     ,


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

#if defined(ENABLE_OVERLOADING)
    clockEntry_time                         ,
#endif
    getClockEntryTime                       ,
    setClockEntryTime                       ,


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

#if defined(ENABLE_OVERLOADING)
    clockEntry_type                         ,
#endif
    getClockEntryType                       ,
    setClockEntryType                       ,


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

#if defined(ENABLE_OVERLOADING)
    clockEntry_unscheduled                  ,
#endif
    getClockEntryUnscheduled                ,
    setClockEntryUnscheduled                ,


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

    clearClockEntryUserData                 ,
#if defined(ENABLE_OVERLOADING)
    clockEntry_userData                     ,
#endif
    getClockEntryUserData                   ,
    setClockEntryUserData                   ,


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

#if defined(ENABLE_OVERLOADING)
    clockEntry_wokenUp                      ,
#endif
    getClockEntryWokenUp                    ,
    setClockEntryWokenUp                    ,




    ) 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.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 GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums
import {-# SOURCE #-} qualified GI.Gst.Objects.Clock as Gst.Clock

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

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

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


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

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


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

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

#if defined(ENABLE_OVERLOADING)
data ClockEntryRefcountFieldInfo
instance AttrInfo ClockEntryRefcountFieldInfo where
    type AttrBaseTypeConstraint ClockEntryRefcountFieldInfo = (~) ClockEntry
    type AttrAllowedOps ClockEntryRefcountFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ClockEntryRefcountFieldInfo = (~) Int32
    type AttrTransferTypeConstraint ClockEntryRefcountFieldInfo = (~)Int32
    type AttrTransferType ClockEntryRefcountFieldInfo = Int32
    type AttrGetType ClockEntryRefcountFieldInfo = Int32
    type AttrLabel ClockEntryRefcountFieldInfo = "refcount"
    type AttrOrigin ClockEntryRefcountFieldInfo = ClockEntry
    attrGet = getClockEntryRefcount
    attrSet = setClockEntryRefcount
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

clockEntry_refcount :: AttrLabelProxy "refcount"
clockEntry_refcount = AttrLabelProxy

#endif


-- | Get the value of the “@clock@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' clockEntry #clock
-- @
getClockEntryClock :: MonadIO m => ClockEntry -> m (Maybe Gst.Clock.Clock)
getClockEntryClock :: ClockEntry -> m (Maybe Clock)
getClockEntryClock ClockEntry
s = 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
$ ClockEntry
-> (Ptr ClockEntry -> IO (Maybe Clock)) -> IO (Maybe Clock)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ClockEntry
s ((Ptr ClockEntry -> IO (Maybe Clock)) -> IO (Maybe Clock))
-> (Ptr ClockEntry -> IO (Maybe Clock)) -> IO (Maybe Clock)
forall a b. (a -> b) -> a -> b
$ \Ptr ClockEntry
ptr -> do
    Ptr Clock
val <- Ptr (Ptr Clock) -> IO (Ptr Clock)
forall a. Storable a => Ptr a -> IO a
peek (Ptr ClockEntry
ptr Ptr ClockEntry -> Int -> Ptr (Ptr Clock)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO (Ptr Gst.Clock.Clock)
    Maybe Clock
result <- Ptr Clock -> (Ptr Clock -> IO Clock) -> IO (Maybe Clock)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Clock
val ((Ptr Clock -> IO Clock) -> IO (Maybe Clock))
-> (Ptr Clock -> IO Clock) -> IO (Maybe Clock)
forall a b. (a -> b) -> a -> b
$ \Ptr Clock
val' -> do
        Clock
val'' <- ((ManagedPtr Clock -> Clock) -> Ptr Clock -> IO Clock
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Clock -> Clock
Gst.Clock.Clock) Ptr Clock
val'
        Clock -> IO Clock
forall (m :: * -> *) a. Monad m => a -> m a
return Clock
val''
    Maybe Clock -> IO (Maybe Clock)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Clock
result

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

-- | Set the value of the “@clock@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #clock
-- @
clearClockEntryClock :: MonadIO m => ClockEntry -> m ()
clearClockEntryClock :: ClockEntry -> m ()
clearClockEntryClock ClockEntry
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClockEntry -> (Ptr ClockEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ClockEntry
s ((Ptr ClockEntry -> IO ()) -> IO ())
-> (Ptr ClockEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ClockEntry
ptr -> do
    Ptr (Ptr Clock) -> Ptr Clock -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ClockEntry
ptr Ptr ClockEntry -> Int -> Ptr (Ptr Clock)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Ptr Clock
forall a. Ptr a
FP.nullPtr :: Ptr Gst.Clock.Clock)

#if defined(ENABLE_OVERLOADING)
data ClockEntryClockFieldInfo
instance AttrInfo ClockEntryClockFieldInfo where
    type AttrBaseTypeConstraint ClockEntryClockFieldInfo = (~) ClockEntry
    type AttrAllowedOps ClockEntryClockFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ClockEntryClockFieldInfo = (~) (Ptr Gst.Clock.Clock)
    type AttrTransferTypeConstraint ClockEntryClockFieldInfo = (~)(Ptr Gst.Clock.Clock)
    type AttrTransferType ClockEntryClockFieldInfo = (Ptr Gst.Clock.Clock)
    type AttrGetType ClockEntryClockFieldInfo = Maybe Gst.Clock.Clock
    type AttrLabel ClockEntryClockFieldInfo = "clock"
    type AttrOrigin ClockEntryClockFieldInfo = ClockEntry
    attrGet = getClockEntryClock
    attrSet = setClockEntryClock
    attrConstruct = undefined
    attrClear = clearClockEntryClock
    attrTransfer _ v = do
        return v

clockEntry_clock :: AttrLabelProxy "clock"
clockEntry_clock = AttrLabelProxy

#endif


-- | Get the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' clockEntry #type
-- @
getClockEntryType :: MonadIO m => ClockEntry -> m Gst.Enums.ClockEntryType
getClockEntryType :: ClockEntry -> m ClockEntryType
getClockEntryType ClockEntry
s = IO ClockEntryType -> m ClockEntryType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ClockEntryType -> m ClockEntryType)
-> IO ClockEntryType -> m ClockEntryType
forall a b. (a -> b) -> a -> b
$ ClockEntry
-> (Ptr ClockEntry -> IO ClockEntryType) -> IO ClockEntryType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ClockEntry
s ((Ptr ClockEntry -> IO ClockEntryType) -> IO ClockEntryType)
-> (Ptr ClockEntry -> IO ClockEntryType) -> IO ClockEntryType
forall a b. (a -> b) -> a -> b
$ \Ptr ClockEntry
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr ClockEntry
ptr Ptr ClockEntry -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO CUInt
    let val' :: ClockEntryType
val' = (Int -> ClockEntryType
forall a. Enum a => Int -> a
toEnum (Int -> ClockEntryType)
-> (CUInt -> Int) -> CUInt -> ClockEntryType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    ClockEntryType -> IO ClockEntryType
forall (m :: * -> *) a. Monad m => a -> m a
return ClockEntryType
val'

-- | Set the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' clockEntry [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setClockEntryType :: MonadIO m => ClockEntry -> Gst.Enums.ClockEntryType -> m ()
setClockEntryType :: ClockEntry -> ClockEntryType -> m ()
setClockEntryType ClockEntry
s ClockEntryType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClockEntry -> (Ptr ClockEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ClockEntry
s ((Ptr ClockEntry -> IO ()) -> IO ())
-> (Ptr ClockEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ClockEntry
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (ClockEntryType -> Int) -> ClockEntryType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClockEntryType -> Int
forall a. Enum a => a -> Int
fromEnum) ClockEntryType
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ClockEntry
ptr Ptr ClockEntry -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data ClockEntryTypeFieldInfo
instance AttrInfo ClockEntryTypeFieldInfo where
    type AttrBaseTypeConstraint ClockEntryTypeFieldInfo = (~) ClockEntry
    type AttrAllowedOps ClockEntryTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ClockEntryTypeFieldInfo = (~) Gst.Enums.ClockEntryType
    type AttrTransferTypeConstraint ClockEntryTypeFieldInfo = (~)Gst.Enums.ClockEntryType
    type AttrTransferType ClockEntryTypeFieldInfo = Gst.Enums.ClockEntryType
    type AttrGetType ClockEntryTypeFieldInfo = Gst.Enums.ClockEntryType
    type AttrLabel ClockEntryTypeFieldInfo = "type"
    type AttrOrigin ClockEntryTypeFieldInfo = ClockEntry
    attrGet = getClockEntryType
    attrSet = setClockEntryType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

clockEntry_type :: AttrLabelProxy "type"
clockEntry_type = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data ClockEntryTimeFieldInfo
instance AttrInfo ClockEntryTimeFieldInfo where
    type AttrBaseTypeConstraint ClockEntryTimeFieldInfo = (~) ClockEntry
    type AttrAllowedOps ClockEntryTimeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ClockEntryTimeFieldInfo = (~) Word64
    type AttrTransferTypeConstraint ClockEntryTimeFieldInfo = (~)Word64
    type AttrTransferType ClockEntryTimeFieldInfo = Word64
    type AttrGetType ClockEntryTimeFieldInfo = Word64
    type AttrLabel ClockEntryTimeFieldInfo = "time"
    type AttrOrigin ClockEntryTimeFieldInfo = ClockEntry
    attrGet = getClockEntryTime
    attrSet = setClockEntryTime
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

clockEntry_time :: AttrLabelProxy "time"
clockEntry_time = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data ClockEntryIntervalFieldInfo
instance AttrInfo ClockEntryIntervalFieldInfo where
    type AttrBaseTypeConstraint ClockEntryIntervalFieldInfo = (~) ClockEntry
    type AttrAllowedOps ClockEntryIntervalFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ClockEntryIntervalFieldInfo = (~) Word64
    type AttrTransferTypeConstraint ClockEntryIntervalFieldInfo = (~)Word64
    type AttrTransferType ClockEntryIntervalFieldInfo = Word64
    type AttrGetType ClockEntryIntervalFieldInfo = Word64
    type AttrLabel ClockEntryIntervalFieldInfo = "interval"
    type AttrOrigin ClockEntryIntervalFieldInfo = ClockEntry
    attrGet = getClockEntryInterval
    attrSet = setClockEntryInterval
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

clockEntry_interval :: AttrLabelProxy "interval"
clockEntry_interval = AttrLabelProxy

#endif


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

-- | Set the value of the “@status@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' clockEntry [ #status 'Data.GI.Base.Attributes.:=' value ]
-- @
setClockEntryStatus :: MonadIO m => ClockEntry -> Gst.Enums.ClockReturn -> m ()
setClockEntryStatus :: ClockEntry -> ClockReturn -> m ()
setClockEntryStatus ClockEntry
s ClockReturn
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClockEntry -> (Ptr ClockEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ClockEntry
s ((Ptr ClockEntry -> IO ()) -> IO ())
-> (Ptr ClockEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ClockEntry
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ClockReturn -> Int) -> ClockReturn -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClockReturn -> Int
forall a. Enum a => a -> Int
fromEnum) ClockReturn
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ClockEntry
ptr Ptr ClockEntry -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data ClockEntryStatusFieldInfo
instance AttrInfo ClockEntryStatusFieldInfo where
    type AttrBaseTypeConstraint ClockEntryStatusFieldInfo = (~) ClockEntry
    type AttrAllowedOps ClockEntryStatusFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ClockEntryStatusFieldInfo = (~) Gst.Enums.ClockReturn
    type AttrTransferTypeConstraint ClockEntryStatusFieldInfo = (~)Gst.Enums.ClockReturn
    type AttrTransferType ClockEntryStatusFieldInfo = Gst.Enums.ClockReturn
    type AttrGetType ClockEntryStatusFieldInfo = Gst.Enums.ClockReturn
    type AttrLabel ClockEntryStatusFieldInfo = "status"
    type AttrOrigin ClockEntryStatusFieldInfo = ClockEntry
    attrGet = getClockEntryStatus
    attrSet = setClockEntryStatus
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

clockEntry_status :: AttrLabelProxy "status"
clockEntry_status = AttrLabelProxy

#endif


-- | Get the value of the “@func@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' clockEntry #func
-- @
getClockEntryFunc :: MonadIO m => ClockEntry -> m (Maybe Gst.Callbacks.ClockCallback_WithClosures)
getClockEntryFunc :: ClockEntry -> m (Maybe ClockCallback_WithClosures)
getClockEntryFunc ClockEntry
s = IO (Maybe ClockCallback_WithClosures)
-> m (Maybe ClockCallback_WithClosures)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ClockCallback_WithClosures)
 -> m (Maybe ClockCallback_WithClosures))
-> IO (Maybe ClockCallback_WithClosures)
-> m (Maybe ClockCallback_WithClosures)
forall a b. (a -> b) -> a -> b
$ ClockEntry
-> (Ptr ClockEntry -> IO (Maybe ClockCallback_WithClosures))
-> IO (Maybe ClockCallback_WithClosures)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ClockEntry
s ((Ptr ClockEntry -> IO (Maybe ClockCallback_WithClosures))
 -> IO (Maybe ClockCallback_WithClosures))
-> (Ptr ClockEntry -> IO (Maybe ClockCallback_WithClosures))
-> IO (Maybe ClockCallback_WithClosures)
forall a b. (a -> b) -> a -> b
$ \Ptr ClockEntry
ptr -> do
    FunPtr C_ClockCallback
val <- Ptr (FunPtr C_ClockCallback) -> IO (FunPtr C_ClockCallback)
forall a. Storable a => Ptr a -> IO a
peek (Ptr ClockEntry
ptr Ptr ClockEntry -> Int -> Ptr (FunPtr C_ClockCallback)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) :: IO (FunPtr Gst.Callbacks.C_ClockCallback)
    Maybe ClockCallback_WithClosures
result <- FunPtr C_ClockCallback
-> (FunPtr C_ClockCallback -> IO ClockCallback_WithClosures)
-> IO (Maybe ClockCallback_WithClosures)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_ClockCallback
val ((FunPtr C_ClockCallback -> IO ClockCallback_WithClosures)
 -> IO (Maybe ClockCallback_WithClosures))
-> (FunPtr C_ClockCallback -> IO ClockCallback_WithClosures)
-> IO (Maybe ClockCallback_WithClosures)
forall a b. (a -> b) -> a -> b
$ \FunPtr C_ClockCallback
val' -> do
        let val'' :: ClockCallback_WithClosures
val'' = FunPtr C_ClockCallback -> ClockCallback_WithClosures
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClock a) =>
FunPtr C_ClockCallback -> a -> Word64 -> Ptr () -> Ptr () -> m Bool
Gst.Callbacks.dynamic_ClockCallback FunPtr C_ClockCallback
val'
        ClockCallback_WithClosures -> IO ClockCallback_WithClosures
forall (m :: * -> *) a. Monad m => a -> m a
return ClockCallback_WithClosures
val''
    Maybe ClockCallback_WithClosures
-> IO (Maybe ClockCallback_WithClosures)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ClockCallback_WithClosures
result

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

-- | Set the value of the “@func@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #func
-- @
clearClockEntryFunc :: MonadIO m => ClockEntry -> m ()
clearClockEntryFunc :: ClockEntry -> m ()
clearClockEntryFunc ClockEntry
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClockEntry -> (Ptr ClockEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ClockEntry
s ((Ptr ClockEntry -> IO ()) -> IO ())
-> (Ptr ClockEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ClockEntry
ptr -> do
    Ptr (FunPtr C_ClockCallback) -> FunPtr C_ClockCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ClockEntry
ptr Ptr ClockEntry -> Int -> Ptr (FunPtr C_ClockCallback)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (FunPtr C_ClockCallback
forall a. FunPtr a
FP.nullFunPtr :: FunPtr Gst.Callbacks.C_ClockCallback)

#if defined(ENABLE_OVERLOADING)
data ClockEntryFuncFieldInfo
instance AttrInfo ClockEntryFuncFieldInfo where
    type AttrBaseTypeConstraint ClockEntryFuncFieldInfo = (~) ClockEntry
    type AttrAllowedOps ClockEntryFuncFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ClockEntryFuncFieldInfo = (~) (FunPtr Gst.Callbacks.C_ClockCallback)
    type AttrTransferTypeConstraint ClockEntryFuncFieldInfo = (~)Gst.Callbacks.ClockCallback_WithClosures
    type AttrTransferType ClockEntryFuncFieldInfo = (FunPtr Gst.Callbacks.C_ClockCallback)
    type AttrGetType ClockEntryFuncFieldInfo = Maybe Gst.Callbacks.ClockCallback_WithClosures
    type AttrLabel ClockEntryFuncFieldInfo = "func"
    type AttrOrigin ClockEntryFuncFieldInfo = ClockEntry
    attrGet = getClockEntryFunc
    attrSet = setClockEntryFunc
    attrConstruct = undefined
    attrClear = clearClockEntryFunc
    attrTransfer _ v = do
        Gst.Callbacks.mk_ClockCallback (Gst.Callbacks.wrap_ClockCallback Nothing v)

clockEntry_func :: AttrLabelProxy "func"
clockEntry_func = AttrLabelProxy

#endif


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

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

-- | Set the value of the “@user_data@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #userData
-- @
clearClockEntryUserData :: MonadIO m => ClockEntry -> m ()
clearClockEntryUserData :: ClockEntry -> m ()
clearClockEntryUserData ClockEntry
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClockEntry -> (Ptr ClockEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ClockEntry
s ((Ptr ClockEntry -> IO ()) -> IO ())
-> (Ptr ClockEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ClockEntry
ptr -> do
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ClockEntry
ptr Ptr ClockEntry -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) (Ptr ()
forall a. Ptr a
FP.nullPtr :: Ptr ())

#if defined(ENABLE_OVERLOADING)
data ClockEntryUserDataFieldInfo
instance AttrInfo ClockEntryUserDataFieldInfo where
    type AttrBaseTypeConstraint ClockEntryUserDataFieldInfo = (~) ClockEntry
    type AttrAllowedOps ClockEntryUserDataFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ClockEntryUserDataFieldInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint ClockEntryUserDataFieldInfo = (~)(Ptr ())
    type AttrTransferType ClockEntryUserDataFieldInfo = (Ptr ())
    type AttrGetType ClockEntryUserDataFieldInfo = Ptr ()
    type AttrLabel ClockEntryUserDataFieldInfo = "user_data"
    type AttrOrigin ClockEntryUserDataFieldInfo = ClockEntry
    attrGet = getClockEntryUserData
    attrSet = setClockEntryUserData
    attrConstruct = undefined
    attrClear = clearClockEntryUserData
    attrTransfer _ v = do
        return v

clockEntry_userData :: AttrLabelProxy "userData"
clockEntry_userData = AttrLabelProxy

#endif


-- | Get the value of the “@destroy_data@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' clockEntry #destroyData
-- @
getClockEntryDestroyData :: MonadIO m => ClockEntry -> m (Maybe GLib.Callbacks.DestroyNotify)
getClockEntryDestroyData :: ClockEntry -> m (Maybe (Ptr () -> IO ()))
getClockEntryDestroyData ClockEntry
s = IO (Maybe (Ptr () -> IO ())) -> m (Maybe (Ptr () -> IO ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Ptr () -> IO ())) -> m (Maybe (Ptr () -> IO ())))
-> IO (Maybe (Ptr () -> IO ())) -> m (Maybe (Ptr () -> IO ()))
forall a b. (a -> b) -> a -> b
$ ClockEntry
-> (Ptr ClockEntry -> IO (Maybe (Ptr () -> IO ())))
-> IO (Maybe (Ptr () -> IO ()))
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ClockEntry
s ((Ptr ClockEntry -> IO (Maybe (Ptr () -> IO ())))
 -> IO (Maybe (Ptr () -> IO ())))
-> (Ptr ClockEntry -> IO (Maybe (Ptr () -> IO ())))
-> IO (Maybe (Ptr () -> IO ()))
forall a b. (a -> b) -> a -> b
$ \Ptr ClockEntry
ptr -> do
    FunPtr (Ptr () -> IO ())
val <- Ptr (FunPtr (Ptr () -> IO ())) -> IO (FunPtr (Ptr () -> IO ()))
forall a. Storable a => Ptr a -> IO a
peek (Ptr ClockEntry
ptr Ptr ClockEntry -> Int -> Ptr (FunPtr (Ptr () -> IO ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) :: IO (FunPtr GLib.Callbacks.C_DestroyNotify)
    Maybe (Ptr () -> IO ())
result <- FunPtr (Ptr () -> IO ())
-> (FunPtr (Ptr () -> IO ()) -> IO (Ptr () -> IO ()))
-> IO (Maybe (Ptr () -> IO ()))
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr (Ptr () -> IO ())
val ((FunPtr (Ptr () -> IO ()) -> IO (Ptr () -> IO ()))
 -> IO (Maybe (Ptr () -> IO ())))
-> (FunPtr (Ptr () -> IO ()) -> IO (Ptr () -> IO ()))
-> IO (Maybe (Ptr () -> IO ()))
forall a b. (a -> b) -> a -> b
$ \FunPtr (Ptr () -> IO ())
val' -> do
        let val'' :: Ptr () -> IO ()
val'' = FunPtr (Ptr () -> IO ()) -> Ptr () -> IO ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FunPtr (Ptr () -> IO ()) -> Ptr () -> m ()
GLib.Callbacks.dynamic_DestroyNotify FunPtr (Ptr () -> IO ())
val'
        (Ptr () -> IO ()) -> IO (Ptr () -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr () -> IO ()
val''
    Maybe (Ptr () -> IO ()) -> IO (Maybe (Ptr () -> IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Ptr () -> IO ())
result

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

-- | Set the value of the “@destroy_data@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #destroyData
-- @
clearClockEntryDestroyData :: MonadIO m => ClockEntry -> m ()
clearClockEntryDestroyData :: ClockEntry -> m ()
clearClockEntryDestroyData ClockEntry
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClockEntry -> (Ptr ClockEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ClockEntry
s ((Ptr ClockEntry -> IO ()) -> IO ())
-> (Ptr ClockEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ClockEntry
ptr -> do
    Ptr (FunPtr (Ptr () -> IO ())) -> FunPtr (Ptr () -> IO ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ClockEntry
ptr Ptr ClockEntry -> Int -> Ptr (FunPtr (Ptr () -> IO ()))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) (FunPtr (Ptr () -> IO ())
forall a. FunPtr a
FP.nullFunPtr :: FunPtr GLib.Callbacks.C_DestroyNotify)

#if defined(ENABLE_OVERLOADING)
data ClockEntryDestroyDataFieldInfo
instance AttrInfo ClockEntryDestroyDataFieldInfo where
    type AttrBaseTypeConstraint ClockEntryDestroyDataFieldInfo = (~) ClockEntry
    type AttrAllowedOps ClockEntryDestroyDataFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ClockEntryDestroyDataFieldInfo = (~) (FunPtr GLib.Callbacks.C_DestroyNotify)
    type AttrTransferTypeConstraint ClockEntryDestroyDataFieldInfo = (~)GLib.Callbacks.DestroyNotify
    type AttrTransferType ClockEntryDestroyDataFieldInfo = (FunPtr GLib.Callbacks.C_DestroyNotify)
    type AttrGetType ClockEntryDestroyDataFieldInfo = Maybe GLib.Callbacks.DestroyNotify
    type AttrLabel ClockEntryDestroyDataFieldInfo = "destroy_data"
    type AttrOrigin ClockEntryDestroyDataFieldInfo = ClockEntry
    attrGet = getClockEntryDestroyData
    attrSet = setClockEntryDestroyData
    attrConstruct = undefined
    attrClear = clearClockEntryDestroyData
    attrTransfer _ v = do
        GLib.Callbacks.mk_DestroyNotify (GLib.Callbacks.wrap_DestroyNotify Nothing v)

clockEntry_destroyData :: AttrLabelProxy "destroyData"
clockEntry_destroyData = AttrLabelProxy

#endif


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

-- | Set the value of the “@unscheduled@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' clockEntry [ #unscheduled 'Data.GI.Base.Attributes.:=' value ]
-- @
setClockEntryUnscheduled :: MonadIO m => ClockEntry -> Bool -> m ()
setClockEntryUnscheduled :: ClockEntry -> Bool -> m ()
setClockEntryUnscheduled ClockEntry
s Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClockEntry -> (Ptr ClockEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ClockEntry
s ((Ptr ClockEntry -> IO ()) -> IO ())
-> (Ptr ClockEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ClockEntry
ptr -> do
    let val' :: CInt
val' = (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
val
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ClockEntry
ptr Ptr ClockEntry -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72) (CInt
val' :: CInt)

#if defined(ENABLE_OVERLOADING)
data ClockEntryUnscheduledFieldInfo
instance AttrInfo ClockEntryUnscheduledFieldInfo where
    type AttrBaseTypeConstraint ClockEntryUnscheduledFieldInfo = (~) ClockEntry
    type AttrAllowedOps ClockEntryUnscheduledFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ClockEntryUnscheduledFieldInfo = (~) Bool
    type AttrTransferTypeConstraint ClockEntryUnscheduledFieldInfo = (~)Bool
    type AttrTransferType ClockEntryUnscheduledFieldInfo = Bool
    type AttrGetType ClockEntryUnscheduledFieldInfo = Bool
    type AttrLabel ClockEntryUnscheduledFieldInfo = "unscheduled"
    type AttrOrigin ClockEntryUnscheduledFieldInfo = ClockEntry
    attrGet = getClockEntryUnscheduled
    attrSet = setClockEntryUnscheduled
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

clockEntry_unscheduled :: AttrLabelProxy "unscheduled"
clockEntry_unscheduled = AttrLabelProxy

#endif


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

-- | Set the value of the “@woken_up@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' clockEntry [ #wokenUp 'Data.GI.Base.Attributes.:=' value ]
-- @
setClockEntryWokenUp :: MonadIO m => ClockEntry -> Bool -> m ()
setClockEntryWokenUp :: ClockEntry -> Bool -> m ()
setClockEntryWokenUp ClockEntry
s Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ClockEntry -> (Ptr ClockEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ClockEntry
s ((Ptr ClockEntry -> IO ()) -> IO ())
-> (Ptr ClockEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ClockEntry
ptr -> do
    let val' :: CInt
val' = (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
val
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ClockEntry
ptr Ptr ClockEntry -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
76) (CInt
val' :: CInt)

#if defined(ENABLE_OVERLOADING)
data ClockEntryWokenUpFieldInfo
instance AttrInfo ClockEntryWokenUpFieldInfo where
    type AttrBaseTypeConstraint ClockEntryWokenUpFieldInfo = (~) ClockEntry
    type AttrAllowedOps ClockEntryWokenUpFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ClockEntryWokenUpFieldInfo = (~) Bool
    type AttrTransferTypeConstraint ClockEntryWokenUpFieldInfo = (~)Bool
    type AttrTransferType ClockEntryWokenUpFieldInfo = Bool
    type AttrGetType ClockEntryWokenUpFieldInfo = Bool
    type AttrLabel ClockEntryWokenUpFieldInfo = "woken_up"
    type AttrOrigin ClockEntryWokenUpFieldInfo = ClockEntry
    attrGet = getClockEntryWokenUp
    attrSet = setClockEntryWokenUp
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

clockEntry_wokenUp :: AttrLabelProxy "wokenUp"
clockEntry_wokenUp = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ClockEntry
type instance O.AttributeList ClockEntry = ClockEntryAttributeList
type ClockEntryAttributeList = ('[ '("refcount", ClockEntryRefcountFieldInfo), '("clock", ClockEntryClockFieldInfo), '("type", ClockEntryTypeFieldInfo), '("time", ClockEntryTimeFieldInfo), '("interval", ClockEntryIntervalFieldInfo), '("status", ClockEntryStatusFieldInfo), '("func", ClockEntryFuncFieldInfo), '("userData", ClockEntryUserDataFieldInfo), '("destroyData", ClockEntryDestroyDataFieldInfo), '("unscheduled", ClockEntryUnscheduledFieldInfo), '("wokenUp", ClockEntryWokenUpFieldInfo)] :: [(Symbol, *)])
#endif

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

instance (info ~ ResolveClockEntryMethod t ClockEntry, O.MethodInfo info ClockEntry p) => OL.IsLabel t (ClockEntry -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif