{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Structure for saving a timestamp and a value.

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

module GI.Gst.Structs.TimedValue
    ( 

-- * Exported types
    TimedValue(..)                          ,
    newZeroTimedValue                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveTimedValueMethod                 ,
#endif




 -- * Properties
-- ** timestamp #attr:timestamp#
-- | timestamp of the value change

    getTimedValueTimestamp                  ,
    setTimedValueTimestamp                  ,
#if defined(ENABLE_OVERLOADING)
    timedValue_timestamp                    ,
#endif


-- ** value #attr:value#
-- | the corresponding value

    getTimedValueValue                      ,
    setTimedValueValue                      ,
#if defined(ENABLE_OVERLOADING)
    timedValue_value                        ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.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


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

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

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


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

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


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

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

#if defined(ENABLE_OVERLOADING)
data TimedValueTimestampFieldInfo
instance AttrInfo TimedValueTimestampFieldInfo where
    type AttrBaseTypeConstraint TimedValueTimestampFieldInfo = (~) TimedValue
    type AttrAllowedOps TimedValueTimestampFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TimedValueTimestampFieldInfo = (~) Word64
    type AttrTransferTypeConstraint TimedValueTimestampFieldInfo = (~)Word64
    type AttrTransferType TimedValueTimestampFieldInfo = Word64
    type AttrGetType TimedValueTimestampFieldInfo = Word64
    type AttrLabel TimedValueTimestampFieldInfo = "timestamp"
    type AttrOrigin TimedValueTimestampFieldInfo = TimedValue
    attrGet = getTimedValueTimestamp
    attrSet = setTimedValueTimestamp
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

timedValue_timestamp :: AttrLabelProxy "timestamp"
timedValue_timestamp = AttrLabelProxy

#endif


-- | Get the value of the “@value@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' timedValue #value
-- @
getTimedValueValue :: MonadIO m => TimedValue -> m Double
getTimedValueValue :: TimedValue -> m Double
getTimedValueValue TimedValue
s = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ TimedValue -> (Ptr TimedValue -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TimedValue
s ((Ptr TimedValue -> IO Double) -> IO Double)
-> (Ptr TimedValue -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr TimedValue
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr TimedValue
ptr Ptr TimedValue -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
val'

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

#if defined(ENABLE_OVERLOADING)
data TimedValueValueFieldInfo
instance AttrInfo TimedValueValueFieldInfo where
    type AttrBaseTypeConstraint TimedValueValueFieldInfo = (~) TimedValue
    type AttrAllowedOps TimedValueValueFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TimedValueValueFieldInfo = (~) Double
    type AttrTransferTypeConstraint TimedValueValueFieldInfo = (~)Double
    type AttrTransferType TimedValueValueFieldInfo = Double
    type AttrGetType TimedValueValueFieldInfo = Double
    type AttrLabel TimedValueValueFieldInfo = "value"
    type AttrOrigin TimedValueValueFieldInfo = TimedValue
    attrGet = getTimedValueValue
    attrSet = setTimedValueValue
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

timedValue_value :: AttrLabelProxy "value"
timedValue_value = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TimedValue
type instance O.AttributeList TimedValue = TimedValueAttributeList
type TimedValueAttributeList = ('[ '("timestamp", TimedValueTimestampFieldInfo), '("value", TimedValueValueFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif