{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A union holding one collected value.

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

module GI.GObject.Unions.TypeCValue
    ( 

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


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveTypeCValueMethod                 ,
#endif



 -- * Properties


-- ** vDouble #attr:vDouble#
-- | the field for holding floating point values

    getTypeCValueVDouble                    ,
    setTypeCValueVDouble                    ,
#if defined(ENABLE_OVERLOADING)
    typeCValue_vDouble                      ,
#endif


-- ** vInt #attr:vInt#
-- | the field for holding integer values

    getTypeCValueVInt                       ,
    setTypeCValueVInt                       ,
#if defined(ENABLE_OVERLOADING)
    typeCValue_vInt                         ,
#endif


-- ** vInt64 #attr:vInt64#
-- | the field for holding 64 bit integer values

    getTypeCValueVInt64                     ,
    setTypeCValueVInt64                     ,
#if defined(ENABLE_OVERLOADING)
    typeCValue_vInt64                       ,
#endif


-- ** vLong #attr:vLong#
-- | the field for holding long integer values

    getTypeCValueVLong                      ,
    setTypeCValueVLong                      ,
#if defined(ENABLE_OVERLOADING)
    typeCValue_vLong                        ,
#endif


-- ** vPointer #attr:vPointer#
-- | the field for holding pointers

    clearTypeCValueVPointer                 ,
    getTypeCValueVPointer                   ,
    setTypeCValueVPointer                   ,
#if defined(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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)

#else

#endif

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

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

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


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

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


-- | 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 :: forall (m :: * -> *). MonadIO m => TypeCValue -> m Int32
getTypeCValueVInt TypeCValue
s = IO Int32 -> m Int32
forall a. IO a -> m a
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
$ TypeCValue -> (Ptr TypeCValue -> IO Int32) -> IO Int32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeCValue
s ((Ptr TypeCValue -> IO Int32) -> IO Int32)
-> (Ptr TypeCValue -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ \Ptr TypeCValue
ptr -> do
    Int32
val <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek (Ptr TypeCValue
ptr Ptr TypeCValue -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO Int32
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
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 :: forall (m :: * -> *). MonadIO m => TypeCValue -> Int32 -> m ()
setTypeCValueVInt TypeCValue
s Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeCValue -> (Ptr TypeCValue -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeCValue
s ((Ptr TypeCValue -> IO ()) -> IO ())
-> (Ptr TypeCValue -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeCValue
ptr -> do
    Ptr Int32 -> Int32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TypeCValue
ptr Ptr TypeCValue -> Int -> Ptr Int32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Int32
val :: Int32)

#if defined(ENABLE_OVERLOADING)
data TypeCValueVIntFieldInfo
instance AttrInfo TypeCValueVIntFieldInfo where
    type AttrBaseTypeConstraint TypeCValueVIntFieldInfo = (~) TypeCValue
    type AttrAllowedOps TypeCValueVIntFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TypeCValueVIntFieldInfo = (~) Int32
    type AttrTransferTypeConstraint TypeCValueVIntFieldInfo = (~)Int32
    type AttrTransferType TypeCValueVIntFieldInfo = Int32
    type AttrGetType TypeCValueVIntFieldInfo = Int32
    type AttrLabel TypeCValueVIntFieldInfo = "v_int"
    type AttrOrigin TypeCValueVIntFieldInfo = TypeCValue
    attrGet = getTypeCValueVInt
    attrSet = setTypeCValueVInt
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GObject.Unions.TypeCValue.vInt"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gobject-2.0.31/docs/GI-GObject-Unions-TypeCValue.html#g:attr:vInt"
        })

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 FCT.CLong
getTypeCValueVLong :: forall (m :: * -> *). MonadIO m => TypeCValue -> m CLong
getTypeCValueVLong TypeCValue
s = IO CLong -> m CLong
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CLong -> m CLong) -> IO CLong -> m CLong
forall a b. (a -> b) -> a -> b
$ TypeCValue -> (Ptr TypeCValue -> IO CLong) -> IO CLong
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeCValue
s ((Ptr TypeCValue -> IO CLong) -> IO CLong)
-> (Ptr TypeCValue -> IO CLong) -> IO CLong
forall a b. (a -> b) -> a -> b
$ \Ptr TypeCValue
ptr -> do
    CLong
val <- Ptr CLong -> IO CLong
forall a. Storable a => Ptr a -> IO a
peek (Ptr TypeCValue
ptr Ptr TypeCValue -> Int -> Ptr CLong
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO FCT.CLong
    CLong -> IO CLong
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CLong
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 -> FCT.CLong -> m ()
setTypeCValueVLong :: forall (m :: * -> *). MonadIO m => TypeCValue -> CLong -> m ()
setTypeCValueVLong TypeCValue
s CLong
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeCValue -> (Ptr TypeCValue -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeCValue
s ((Ptr TypeCValue -> IO ()) -> IO ())
-> (Ptr TypeCValue -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeCValue
ptr -> do
    Ptr CLong -> CLong -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TypeCValue
ptr Ptr TypeCValue -> Int -> Ptr CLong
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CLong
val :: FCT.CLong)

#if defined(ENABLE_OVERLOADING)
data TypeCValueVLongFieldInfo
instance AttrInfo TypeCValueVLongFieldInfo where
    type AttrBaseTypeConstraint TypeCValueVLongFieldInfo = (~) TypeCValue
    type AttrAllowedOps TypeCValueVLongFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TypeCValueVLongFieldInfo = (~) FCT.CLong
    type AttrTransferTypeConstraint TypeCValueVLongFieldInfo = (~)FCT.CLong
    type AttrTransferType TypeCValueVLongFieldInfo = FCT.CLong
    type AttrGetType TypeCValueVLongFieldInfo = FCT.CLong
    type AttrLabel TypeCValueVLongFieldInfo = "v_long"
    type AttrOrigin TypeCValueVLongFieldInfo = TypeCValue
    attrGet = getTypeCValueVLong
    attrSet = setTypeCValueVLong
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GObject.Unions.TypeCValue.vLong"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gobject-2.0.31/docs/GI-GObject-Unions-TypeCValue.html#g:attr:vLong"
        })

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 :: forall (m :: * -> *). MonadIO m => TypeCValue -> m Int64
getTypeCValueVInt64 TypeCValue
s = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ TypeCValue -> (Ptr TypeCValue -> IO Int64) -> IO Int64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeCValue
s ((Ptr TypeCValue -> IO Int64) -> IO Int64)
-> (Ptr TypeCValue -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \Ptr TypeCValue
ptr -> do
    Int64
val <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek (Ptr TypeCValue
ptr Ptr TypeCValue -> Int -> Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO Int64
    Int64 -> IO Int64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
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 :: forall (m :: * -> *). MonadIO m => TypeCValue -> Int64 -> m ()
setTypeCValueVInt64 TypeCValue
s Int64
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeCValue -> (Ptr TypeCValue -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeCValue
s ((Ptr TypeCValue -> IO ()) -> IO ())
-> (Ptr TypeCValue -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeCValue
ptr -> do
    Ptr Int64 -> Int64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TypeCValue
ptr Ptr TypeCValue -> Int -> Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Int64
val :: Int64)

#if defined(ENABLE_OVERLOADING)
data TypeCValueVInt64FieldInfo
instance AttrInfo TypeCValueVInt64FieldInfo where
    type AttrBaseTypeConstraint TypeCValueVInt64FieldInfo = (~) TypeCValue
    type AttrAllowedOps TypeCValueVInt64FieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TypeCValueVInt64FieldInfo = (~) Int64
    type AttrTransferTypeConstraint TypeCValueVInt64FieldInfo = (~)Int64
    type AttrTransferType TypeCValueVInt64FieldInfo = Int64
    type AttrGetType TypeCValueVInt64FieldInfo = Int64
    type AttrLabel TypeCValueVInt64FieldInfo = "v_int64"
    type AttrOrigin TypeCValueVInt64FieldInfo = TypeCValue
    attrGet = getTypeCValueVInt64
    attrSet = setTypeCValueVInt64
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GObject.Unions.TypeCValue.vInt64"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gobject-2.0.31/docs/GI-GObject-Unions-TypeCValue.html#g:attr:vInt64"
        })

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 :: forall (m :: * -> *). MonadIO m => TypeCValue -> m Double
getTypeCValueVDouble TypeCValue
s = IO Double -> m Double
forall a. IO a -> m a
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
$ TypeCValue -> (Ptr TypeCValue -> IO Double) -> IO Double
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeCValue
s ((Ptr TypeCValue -> IO Double) -> IO Double)
-> (Ptr TypeCValue -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr TypeCValue
ptr -> do
    CDouble
val <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek (Ptr TypeCValue
ptr Ptr TypeCValue -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CDouble
    let val' :: Double
val' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
val
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
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 :: forall (m :: * -> *). MonadIO m => TypeCValue -> Double -> m ()
setTypeCValueVDouble TypeCValue
s Double
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeCValue -> (Ptr TypeCValue -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeCValue
s ((Ptr TypeCValue -> IO ()) -> IO ())
-> (Ptr TypeCValue -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeCValue
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 TypeCValue
ptr Ptr TypeCValue -> Int -> Ptr CDouble
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CDouble
val' :: CDouble)

#if defined(ENABLE_OVERLOADING)
data TypeCValueVDoubleFieldInfo
instance AttrInfo TypeCValueVDoubleFieldInfo where
    type AttrBaseTypeConstraint TypeCValueVDoubleFieldInfo = (~) TypeCValue
    type AttrAllowedOps TypeCValueVDoubleFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TypeCValueVDoubleFieldInfo = (~) Double
    type AttrTransferTypeConstraint TypeCValueVDoubleFieldInfo = (~)Double
    type AttrTransferType TypeCValueVDoubleFieldInfo = Double
    type AttrGetType TypeCValueVDoubleFieldInfo = Double
    type AttrLabel TypeCValueVDoubleFieldInfo = "v_double"
    type AttrOrigin TypeCValueVDoubleFieldInfo = TypeCValue
    attrGet = getTypeCValueVDouble
    attrSet = setTypeCValueVDouble
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GObject.Unions.TypeCValue.vDouble"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gobject-2.0.31/docs/GI-GObject-Unions-TypeCValue.html#g:attr:vDouble"
        })

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 :: forall (m :: * -> *). MonadIO m => TypeCValue -> m (Ptr ())
getTypeCValueVPointer TypeCValue
s = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
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
$ TypeCValue -> (Ptr TypeCValue -> IO (Ptr ())) -> IO (Ptr ())
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeCValue
s ((Ptr TypeCValue -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr TypeCValue -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr TypeCValue
ptr -> do
    Ptr ()
val <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek (Ptr TypeCValue
ptr Ptr TypeCValue -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO (Ptr ())
    Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
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 :: forall (m :: * -> *). MonadIO m => TypeCValue -> Ptr () -> m ()
setTypeCValueVPointer TypeCValue
s Ptr ()
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeCValue -> (Ptr TypeCValue -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeCValue
s ((Ptr TypeCValue -> IO ()) -> IO ())
-> (Ptr TypeCValue -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeCValue
ptr -> do
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TypeCValue
ptr Ptr TypeCValue -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr ()
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 :: forall (m :: * -> *). MonadIO m => TypeCValue -> m ()
clearTypeCValueVPointer TypeCValue
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ TypeCValue -> (Ptr TypeCValue -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr TypeCValue
s ((Ptr TypeCValue -> IO ()) -> IO ())
-> (Ptr TypeCValue -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TypeCValue
ptr -> do
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr TypeCValue
ptr Ptr TypeCValue -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (Ptr ()
forall a. Ptr a
FP.nullPtr :: Ptr ())

#if defined(ENABLE_OVERLOADING)
data TypeCValueVPointerFieldInfo
instance AttrInfo TypeCValueVPointerFieldInfo where
    type AttrBaseTypeConstraint TypeCValueVPointerFieldInfo = (~) TypeCValue
    type AttrAllowedOps TypeCValueVPointerFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TypeCValueVPointerFieldInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint TypeCValueVPointerFieldInfo = (~)(Ptr ())
    type AttrTransferType TypeCValueVPointerFieldInfo = (Ptr ())
    type AttrGetType TypeCValueVPointerFieldInfo = Ptr ()
    type AttrLabel TypeCValueVPointerFieldInfo = "v_pointer"
    type AttrOrigin TypeCValueVPointerFieldInfo = TypeCValue
    attrGet = getTypeCValueVPointer
    attrSet = setTypeCValueVPointer
    attrConstruct = undefined
    attrClear = clearTypeCValueVPointer
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GObject.Unions.TypeCValue.vPointer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gobject-2.0.31/docs/GI-GObject-Unions-TypeCValue.html#g:attr:vPointer"
        })

typeCValue_vPointer :: AttrLabelProxy "vPointer"
typeCValue_vPointer = AttrLabelProxy

#endif



#if defined(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, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTypeCValueMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTypeCValueMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveTypeCValueMethod t TypeCValue, O.OverloadedMethod info TypeCValue p, R.HasField t TypeCValue p) => R.HasField t TypeCValue p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveTypeCValueMethod t TypeCValue, O.OverloadedMethodInfo info TypeCValue) => OL.IsLabel t (O.MethodProxy info TypeCValue) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif