{- |
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.
-}

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

module GI.GObject.Unions.TypeCValue
    (

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


 -- * Properties
-- ** vDouble #attr:vDouble#
{- | the field for holding floating point values
-}
    getTypeCValueVDouble                    ,
    setTypeCValueVDouble                    ,
#if ENABLE_OVERLOADING
    typeCValue_vDouble                      ,
#endif


-- ** vInt #attr:vInt#
{- | the field for holding integer values
-}
    getTypeCValueVInt                       ,
    setTypeCValueVInt                       ,
#if ENABLE_OVERLOADING
    typeCValue_vInt                         ,
#endif


-- ** vInt64 #attr:vInt64#
{- | the field for holding 64 bit integer values
-}
    getTypeCValueVInt64                     ,
    setTypeCValueVInt64                     ,
#if ENABLE_OVERLOADING
    typeCValue_vInt64                       ,
#endif


-- ** vLong #attr:vLong#
{- | the field for holding long integer values
-}
    getTypeCValueVLong                      ,
    setTypeCValueVLong                      ,
#if ENABLE_OVERLOADING
    typeCValue_vLong                        ,
#endif


-- ** vPointer #attr:vPointer#
{- | the field for holding pointers
-}
    clearTypeCValueVPointer                 ,
    getTypeCValueVPointer                   ,
    setTypeCValueVPointer                   ,
#if ENABLE_OVERLOADING
    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.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.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP


-- | Memory-managed wrapper type.
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


-- | A convenience alias for `Nothing` :: `Maybe` `TypeCValue`.
noTypeCValue :: Maybe TypeCValue
noTypeCValue = Nothing

{- |
Get the value of the “@v_int@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' typeCValue #vInt
@
-}
getTypeCValueVInt :: MonadIO m => TypeCValue -> m Int32
getTypeCValueVInt s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO Int32
    return val

{- |
Set the value of the “@v_int@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' typeCValue [ #vInt 'Data.GI.Base.Attributes.:=' value ]
@
-}
setTypeCValueVInt :: MonadIO m => TypeCValue -> Int32 -> m ()
setTypeCValueVInt s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Int32)

#if ENABLE_OVERLOADING
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


{- |
Get the value of the “@v_long@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' typeCValue #vLong
@
-}
getTypeCValueVLong :: MonadIO m => TypeCValue -> m CLong
getTypeCValueVLong s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CLong
    return val

{- |
Set the value of the “@v_long@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' typeCValue [ #vLong 'Data.GI.Base.Attributes.:=' value ]
@
-}
setTypeCValueVLong :: MonadIO m => TypeCValue -> CLong -> m ()
setTypeCValueVLong s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: CLong)

#if ENABLE_OVERLOADING
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


{- |
Get the value of the “@v_int64@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' typeCValue #vInt64
@
-}
getTypeCValueVInt64 :: MonadIO m => TypeCValue -> m Int64
getTypeCValueVInt64 s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO Int64
    return val

{- |
Set the value of the “@v_int64@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' typeCValue [ #vInt64 'Data.GI.Base.Attributes.:=' value ]
@
-}
setTypeCValueVInt64 :: MonadIO m => TypeCValue -> Int64 -> m ()
setTypeCValueVInt64 s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Int64)

#if ENABLE_OVERLOADING
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


{- |
Get the value of the “@v_double@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' typeCValue #vDouble
@
-}
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'

{- |
Set the value of the “@v_double@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' typeCValue [ #vDouble 'Data.GI.Base.Attributes.:=' value ]
@
-}
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 ENABLE_OVERLOADING
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


{- |
Get the value of the “@v_pointer@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' typeCValue #vPointer
@
-}
getTypeCValueVPointer :: MonadIO m => TypeCValue -> m (Ptr ())
getTypeCValueVPointer s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO (Ptr ())
    return val

{- |
Set the value of the “@v_pointer@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' typeCValue [ #vPointer 'Data.GI.Base.Attributes.:=' value ]
@
-}
setTypeCValueVPointer :: MonadIO m => TypeCValue -> Ptr () -> m ()
setTypeCValueVPointer s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Ptr ())

{- |
Set the value of the “@v_pointer@” 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' #vPointer
@
-}
clearTypeCValueVPointer :: MonadIO m => TypeCValue -> m ()
clearTypeCValueVPointer s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullPtr :: Ptr ())

#if ENABLE_OVERLOADING
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 ENABLE_OVERLOADING
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 ENABLE_OVERLOADING
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