{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

Structure for saving a timestamp and a value.
-}

module GI.Gst.Structs.TimedValue
    ( 

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


 -- * Properties
-- ** timestamp #attr:timestamp#
    getTimedValueTimestamp                  ,
    setTimedValueTimestamp                  ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    timedValue_timestamp                    ,
#endif


-- ** value #attr:value#
    getTimedValueValue                      ,
    setTimedValueValue                      ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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


newtype TimedValue = TimedValue (ManagedPtr TimedValue)
instance WrappedPtr TimedValue where
    wrappedPtrCalloc = callocBytes 16
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 16 >=> wrapPtr TimedValue)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `TimedValue` struct initialized to zero.
newZeroTimedValue :: MonadIO m => m TimedValue
newZeroTimedValue = liftIO $ wrappedPtrCalloc >>= wrapPtr TimedValue

instance tag ~ 'AttrSet => Constructible TimedValue tag where
    new _ attrs = do
        o <- newZeroTimedValue
        GI.Attributes.set o attrs
        return o


noTimedValue :: Maybe TimedValue
noTimedValue = Nothing

getTimedValueTimestamp :: MonadIO m => TimedValue -> m Word64
getTimedValueTimestamp s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO Word64
    return val

setTimedValueTimestamp :: MonadIO m => TimedValue -> Word64 -> m ()
setTimedValueTimestamp s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Word64)

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

timedValue_timestamp :: AttrLabelProxy "timestamp"
timedValue_timestamp = AttrLabelProxy

#endif


getTimedValueValue :: MonadIO m => TimedValue -> m Double
getTimedValueValue s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CDouble
    let val' = realToFrac val
    return val'

setTimedValueValue :: MonadIO m => TimedValue -> Double -> m ()
setTimedValueValue s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 8) (val' :: CDouble)

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

timedValue_value :: AttrLabelProxy "value"
timedValue_value = AttrLabelProxy

#endif



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

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

instance (info ~ ResolveTimedValueMethod t TimedValue, O.MethodInfo info TimedValue p) => O.IsLabelProxy t (TimedValue -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

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

#endif