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

A union holding one collected value.
-}

module GI.GObject.Unions.TypeCValue
    ( 

-- * Exported types
    TypeCValue(..)                          ,
    newZeroTypeCValue                       ,
    noTypeCValue                            ,


 -- * Properties
-- ** vDouble #attr:vDouble#
    getTypeCValueVDouble                    ,
    setTypeCValueVDouble                    ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeCValue_vDouble                      ,
#endif


-- ** vInt #attr:vInt#
    getTypeCValueVInt                       ,
    setTypeCValueVInt                       ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeCValue_vInt                         ,
#endif


-- ** vInt64 #attr:vInt64#
    getTypeCValueVInt64                     ,
    setTypeCValueVInt64                     ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeCValue_vInt64                       ,
#endif


-- ** vLong #attr:vLong#
    getTypeCValueVLong                      ,
    setTypeCValueVLong                      ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeCValue_vLong                        ,
#endif


-- ** vPointer #attr:vPointer#
    clearTypeCValueVPointer                 ,
    getTypeCValueVPointer                   ,
    setTypeCValueVPointer                   ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    typeCValue_vPointer                     ,
#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 TypeCValue = TypeCValue (ManagedPtr TypeCValue)
instance WrappedPtr TypeCValue where
    wrappedPtrCalloc = callocBytes 8
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 8 >=> wrapPtr TypeCValue)
    wrappedPtrFree = Just ptr_to_g_free

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

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


noTypeCValue :: Maybe TypeCValue
noTypeCValue = Nothing

getTypeCValueVInt :: MonadIO m => TypeCValue -> m Int32
getTypeCValueVInt s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO Int32
    return val

setTypeCValueVInt :: MonadIO m => TypeCValue -> Int32 -> m ()
setTypeCValueVInt s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Int32)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeCValueVIntFieldInfo
instance AttrInfo TypeCValueVIntFieldInfo where
    type AttrAllowedOps TypeCValueVIntFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TypeCValueVIntFieldInfo = (~) Int32
    type AttrBaseTypeConstraint TypeCValueVIntFieldInfo = (~) TypeCValue
    type AttrGetType TypeCValueVIntFieldInfo = Int32
    type AttrLabel TypeCValueVIntFieldInfo = "v_int"
    type AttrOrigin TypeCValueVIntFieldInfo = TypeCValue
    attrGet _ = getTypeCValueVInt
    attrSet _ = setTypeCValueVInt
    attrConstruct = undefined
    attrClear _ = undefined

typeCValue_vInt :: AttrLabelProxy "vInt"
typeCValue_vInt = AttrLabelProxy

#endif


getTypeCValueVLong :: MonadIO m => TypeCValue -> m CLong
getTypeCValueVLong s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CLong
    return val

setTypeCValueVLong :: MonadIO m => TypeCValue -> CLong -> m ()
setTypeCValueVLong s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: CLong)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeCValueVLongFieldInfo
instance AttrInfo TypeCValueVLongFieldInfo where
    type AttrAllowedOps TypeCValueVLongFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TypeCValueVLongFieldInfo = (~) CLong
    type AttrBaseTypeConstraint TypeCValueVLongFieldInfo = (~) TypeCValue
    type AttrGetType TypeCValueVLongFieldInfo = CLong
    type AttrLabel TypeCValueVLongFieldInfo = "v_long"
    type AttrOrigin TypeCValueVLongFieldInfo = TypeCValue
    attrGet _ = getTypeCValueVLong
    attrSet _ = setTypeCValueVLong
    attrConstruct = undefined
    attrClear _ = undefined

typeCValue_vLong :: AttrLabelProxy "vLong"
typeCValue_vLong = AttrLabelProxy

#endif


getTypeCValueVInt64 :: MonadIO m => TypeCValue -> m Int64
getTypeCValueVInt64 s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO Int64
    return val

setTypeCValueVInt64 :: MonadIO m => TypeCValue -> Int64 -> m ()
setTypeCValueVInt64 s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Int64)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeCValueVInt64FieldInfo
instance AttrInfo TypeCValueVInt64FieldInfo where
    type AttrAllowedOps TypeCValueVInt64FieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TypeCValueVInt64FieldInfo = (~) Int64
    type AttrBaseTypeConstraint TypeCValueVInt64FieldInfo = (~) TypeCValue
    type AttrGetType TypeCValueVInt64FieldInfo = Int64
    type AttrLabel TypeCValueVInt64FieldInfo = "v_int64"
    type AttrOrigin TypeCValueVInt64FieldInfo = TypeCValue
    attrGet _ = getTypeCValueVInt64
    attrSet _ = setTypeCValueVInt64
    attrConstruct = undefined
    attrClear _ = undefined

typeCValue_vInt64 :: AttrLabelProxy "vInt64"
typeCValue_vInt64 = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeCValueVDoubleFieldInfo
instance AttrInfo TypeCValueVDoubleFieldInfo where
    type AttrAllowedOps TypeCValueVDoubleFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TypeCValueVDoubleFieldInfo = (~) Double
    type AttrBaseTypeConstraint TypeCValueVDoubleFieldInfo = (~) TypeCValue
    type AttrGetType TypeCValueVDoubleFieldInfo = Double
    type AttrLabel TypeCValueVDoubleFieldInfo = "v_double"
    type AttrOrigin TypeCValueVDoubleFieldInfo = TypeCValue
    attrGet _ = getTypeCValueVDouble
    attrSet _ = setTypeCValueVDouble
    attrConstruct = undefined
    attrClear _ = undefined

typeCValue_vDouble :: AttrLabelProxy "vDouble"
typeCValue_vDouble = AttrLabelProxy

#endif


getTypeCValueVPointer :: MonadIO m => TypeCValue -> m (Ptr ())
getTypeCValueVPointer s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO (Ptr ())
    return val

setTypeCValueVPointer :: MonadIO m => TypeCValue -> Ptr () -> m ()
setTypeCValueVPointer s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Ptr ())

clearTypeCValueVPointer :: MonadIO m => TypeCValue -> m ()
clearTypeCValueVPointer s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullPtr :: Ptr ())

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data TypeCValueVPointerFieldInfo
instance AttrInfo TypeCValueVPointerFieldInfo where
    type AttrAllowedOps TypeCValueVPointerFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeCValueVPointerFieldInfo = (~) (Ptr ())
    type AttrBaseTypeConstraint TypeCValueVPointerFieldInfo = (~) TypeCValue
    type AttrGetType TypeCValueVPointerFieldInfo = Ptr ()
    type AttrLabel TypeCValueVPointerFieldInfo = "v_pointer"
    type AttrOrigin TypeCValueVPointerFieldInfo = TypeCValue
    attrGet _ = getTypeCValueVPointer
    attrSet _ = setTypeCValueVPointer
    attrConstruct = undefined
    attrClear _ = clearTypeCValueVPointer

typeCValue_vPointer :: AttrLabelProxy "vPointer"
typeCValue_vPointer = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList TypeCValue
type instance O.AttributeList TypeCValue = TypeCValueAttributeList
type TypeCValueAttributeList = ('[ '("vInt", TypeCValueVIntFieldInfo), '("vLong", TypeCValueVLongFieldInfo), '("vInt64", TypeCValueVInt64FieldInfo), '("vDouble", TypeCValueVDoubleFieldInfo), '("vPointer", TypeCValueVPointerFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveTypeCValueMethod t TypeCValue, O.MethodInfo info TypeCValue p) => O.IsLabel t (TypeCValue -> 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