{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds, TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}

module Data.GI.Base.GValue
    (
    -- * Constructing GValues
      GValue(..)
    , IsGValue(..)
    , toGValue
    , fromGValue
    , GValueConstruct(..)

    , newGValue
    , buildGValue
    , disownGValue
    , noGValue
    , newGValueFromPtr
    , wrapGValuePtr
    , unsetGValue
    , gvalueType

    -- * Packing GValues into arrays
    , packGValueArray
    , unpackGValueArrayWithLength
    , mapGValueArrayWithLength

    -- * Setters and getters
    , set_object
    , get_object
    , set_boxed
    , get_boxed
    , set_variant
    , get_variant
    , set_enum
    , get_enum
    , set_flags
    , get_flags
    , set_stablePtr
    , get_stablePtr
    , take_stablePtr

    ) where

import Control.Monad.IO.Class (MonadIO, liftIO)

import Data.Coerce (coerce)
import Data.Word
import Data.Int
import Data.Text (Text, pack, unpack)

import Foreign.C.Types (CInt(..), CUInt(..), CFloat(..), CDouble(..),
                        CLong(..), CULong(..))
import Foreign.C.String (CString)
import Foreign.Ptr (Ptr, nullPtr, plusPtr)
import Foreign.StablePtr (StablePtr, castStablePtrToPtr, castPtrToStablePtr)

import Data.GI.Base.BasicTypes
import Data.GI.Base.BasicConversions (cstringToText, textToCString)
import Data.GI.Base.GType
import Data.GI.Base.ManagedPtr
import Data.GI.Base.Overloading (HasParentTypes, ParentTypes)
import Data.GI.Base.Utils (callocBytes, freeMem)
import Data.GI.Base.Internal.CTypes (cgvalueSize)

-- | Haskell-side representation of a @GValue@.
newtype GValue = GValue (ManagedPtr GValue)

-- | A convenience alias for @`Nothing` :: `Maybe` `GValue`@.
noGValue :: Maybe GValue
noGValue :: Maybe GValue
noGValue = Maybe GValue
forall a. Maybe a
Nothing

foreign import ccall unsafe "g_value_get_type" c_g_value_get_type ::
    IO GType

-- | There are no types in the bindings that a `GValue` can be safely
-- cast to.
type instance ParentTypes GValue = '[]
instance HasParentTypes GValue

-- | Find the associated `GType` for `GValue`.
instance TypedObject GValue where
  glibType :: IO GType
glibType = IO GType
c_g_value_get_type

-- | `GValue`s are registered as boxed in the GLib type system.
instance GBoxed GValue

foreign import ccall "g_value_init" g_value_init ::
    Ptr GValue -> CGType -> IO (Ptr GValue)

-- | A type holding a `GValue` with an associated label. It is
-- parameterized by a phantom type encoding the target type for the
-- `GValue` (useful when constructing properties).
data GValueConstruct o = GValueConstruct String GValue

-- | Build a new, empty, `GValue` of the given type.
newGValue :: GType -> IO GValue
newGValue :: GType -> IO GValue
newGValue (GType CGType
gtype) = do
  Ptr GValue
gvptr <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
callocBytes Int
cgvalueSize
  Ptr GValue
_ <- Ptr GValue -> CGType -> IO (Ptr GValue)
g_value_init Ptr GValue
gvptr CGType
gtype
  GValue
gv <- (ManagedPtr GValue -> GValue) -> Ptr GValue -> IO GValue
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GValue -> GValue
GValue Ptr GValue
gvptr
  GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GValue -> IO GValue) -> GValue -> IO GValue
forall a b. (a -> b) -> a -> b
$! GValue
gv

-- | Take ownership of a passed in 'Ptr'.
wrapGValuePtr :: Ptr GValue -> IO GValue
wrapGValuePtr :: Ptr GValue -> IO GValue
wrapGValuePtr Ptr GValue
ptr = (ManagedPtr GValue -> GValue) -> Ptr GValue -> IO GValue
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GValue -> GValue
GValue Ptr GValue
ptr

-- | Construct a Haskell wrapper for the given 'GValue', making a
-- copy.
newGValueFromPtr :: Ptr GValue -> IO GValue
newGValueFromPtr :: Ptr GValue -> IO GValue
newGValueFromPtr Ptr GValue
ptr = (ManagedPtr GValue -> GValue) -> Ptr GValue -> IO GValue
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr GValue -> GValue
GValue Ptr GValue
ptr

-- | A convenience function for building a new GValue and setting the
-- initial value.
buildGValue :: GType -> (Ptr GValue -> a -> IO ()) -> a -> IO GValue
buildGValue :: GType -> (Ptr GValue -> a -> IO ()) -> a -> IO GValue
buildGValue GType
gtype Ptr GValue -> a -> IO ()
setter a
val = do
  GValue
gv <- GType -> IO GValue
newGValue GType
gtype
  GValue -> (Ptr GValue -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GValue
gv ((Ptr GValue -> IO ()) -> IO ()) -> (Ptr GValue -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GValue
gvPtr -> Ptr GValue -> a -> IO ()
setter Ptr GValue
gvPtr a
val
  GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
gv

-- | Disown a `GValue`, i.e. do not unref the underlying object when
-- the Haskell object is garbage collected.
disownGValue :: GValue -> IO (Ptr GValue)
disownGValue :: GValue -> IO (Ptr GValue)
disownGValue = GValue -> IO (Ptr GValue)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
disownManagedPtr

foreign import ccall "_haskell_gi_g_value_get_type" g_value_get_type :: Ptr GValue -> IO CGType

-- | Return the `GType` contained by a `GValue`.
gvalueType :: GValue -> IO GType
gvalueType :: GValue -> IO GType
gvalueType GValue
gv = GValue -> (Ptr GValue -> IO GType) -> IO GType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GValue
gv ((Ptr GValue -> IO GType) -> IO GType)
-> (Ptr GValue -> IO GType) -> IO GType
forall a b. (a -> b) -> a -> b
$ \Ptr GValue
gvptr -> do
  CGType
cgtype <- Ptr GValue -> IO CGType
g_value_get_type Ptr GValue
gvptr
  GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return (CGType -> GType
GType CGType
cgtype)

foreign import ccall "g_value_unset" g_value_unset :: Ptr GValue -> IO ()

-- | Unset the `GValue`, freeing all resources associated to it.
unsetGValue :: Ptr GValue -> IO ()
unsetGValue :: Ptr GValue -> IO ()
unsetGValue = Ptr GValue -> IO ()
g_value_unset

-- | Class for types that can be marshaled back and forth between
-- Haskell values and `GValue`s. These are low-level methods, you
-- might want to use `toGValue` and `fromGValue` instead for a higher
-- level interface.
class IsGValue a where
  gvalueGType_ :: IO GType     -- ^ `GType` for the `GValue`
                               -- containing values of this type.
  gvalueSet_   :: Ptr GValue -> a -> IO ()  -- ^ Set the `GValue` to
                                            -- the given Haskell
                                            -- value.
  gvalueGet_   :: Ptr GValue -> IO a -- ^ Get the Haskel value inside
                                     -- the `GValue`.

-- | Create a `GValue` from the given Haskell value.
toGValue :: forall a m. (IsGValue a, MonadIO m) => a -> m GValue
toGValue :: a -> m GValue
toGValue a
val = IO GValue -> m GValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
  Ptr GValue
gvptr <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
callocBytes Int
cgvalueSize
  GType CGType
gtype <- IsGValue a => IO GType
forall a. IsGValue a => IO GType
gvalueGType_ @a
  Ptr GValue
_ <- Ptr GValue -> CGType -> IO (Ptr GValue)
g_value_init Ptr GValue
gvptr CGType
gtype
  Ptr GValue -> a -> IO ()
forall a. IsGValue a => Ptr GValue -> a -> IO ()
gvalueSet_ Ptr GValue
gvptr a
val
  GValue
gv <- (ManagedPtr GValue -> GValue) -> Ptr GValue -> IO GValue
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr GValue -> GValue
GValue Ptr GValue
gvptr
  GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return (GValue -> IO GValue) -> GValue -> IO GValue
forall a b. (a -> b) -> a -> b
$! GValue
gv

-- | Create a Haskell object out of the given `GValue`.
fromGValue :: (IsGValue a, MonadIO m) => GValue -> m a
fromGValue :: GValue -> m a
fromGValue GValue
gv = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ GValue -> (Ptr GValue -> IO a) -> IO a
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr GValue
gv Ptr GValue -> IO a
forall a. IsGValue a => Ptr GValue -> IO a
gvalueGet_

instance IsGValue (Maybe String) where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeString
  gvalueSet_ :: Ptr GValue -> Maybe String -> IO ()
gvalueSet_ Ptr GValue
gvPtr Maybe String
mstr = Ptr GValue -> Maybe Text -> IO ()
set_string Ptr GValue
gvPtr (String -> Text
pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
mstr)
  gvalueGet_ :: Ptr GValue -> IO (Maybe String)
gvalueGet_ Ptr GValue
v = ((Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
unpack) (Maybe Text -> Maybe String)
-> IO (Maybe Text) -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr GValue -> IO (Maybe Text)
get_string Ptr GValue
v

instance IsGValue (Maybe Text) where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeString
  gvalueSet_ :: Ptr GValue -> Maybe Text -> IO ()
gvalueSet_ = Ptr GValue -> Maybe Text -> IO ()
set_string
  gvalueGet_ :: Ptr GValue -> IO (Maybe Text)
gvalueGet_ = Ptr GValue -> IO (Maybe Text)
get_string

instance IsGValue (Ptr a) where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypePointer
  gvalueSet_ :: Ptr GValue -> Ptr a -> IO ()
gvalueSet_ = Ptr GValue -> Ptr a -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
set_pointer
  gvalueGet_ :: Ptr GValue -> IO (Ptr a)
gvalueGet_ = Ptr GValue -> IO (Ptr a)
forall a. Ptr GValue -> IO (Ptr a)
get_pointer

instance IsGValue Int32 where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeInt
  gvalueSet_ :: Ptr GValue -> Int32 -> IO ()
gvalueSet_ = Ptr GValue -> Int32 -> IO ()
set_int32
  gvalueGet_ :: Ptr GValue -> IO Int32
gvalueGet_ = Ptr GValue -> IO Int32
get_int32

instance IsGValue Word32 where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeUInt
  gvalueSet_ :: Ptr GValue -> Word32 -> IO ()
gvalueSet_ = Ptr GValue -> Word32 -> IO ()
set_uint32
  gvalueGet_ :: Ptr GValue -> IO Word32
gvalueGet_ = Ptr GValue -> IO Word32
get_uint32

instance IsGValue CInt where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeInt
  gvalueSet_ :: Ptr GValue -> CInt -> IO ()
gvalueSet_ = Ptr GValue -> CInt -> IO ()
set_int
  gvalueGet_ :: Ptr GValue -> IO CInt
gvalueGet_ = Ptr GValue -> IO CInt
get_int

instance IsGValue CUInt where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeUInt
  gvalueSet_ :: Ptr GValue -> CUInt -> IO ()
gvalueSet_ = Ptr GValue -> CUInt -> IO ()
set_uint
  gvalueGet_ :: Ptr GValue -> IO CUInt
gvalueGet_ = Ptr GValue -> IO CUInt
get_uint

instance IsGValue CLong where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeLong
  gvalueSet_ :: Ptr GValue -> CLong -> IO ()
gvalueSet_ = Ptr GValue -> CLong -> IO ()
set_long
  gvalueGet_ :: Ptr GValue -> IO CLong
gvalueGet_ = Ptr GValue -> IO CLong
get_long

instance IsGValue CULong where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeULong
  gvalueSet_ :: Ptr GValue -> CULong -> IO ()
gvalueSet_ = Ptr GValue -> CULong -> IO ()
set_ulong
  gvalueGet_ :: Ptr GValue -> IO CULong
gvalueGet_ = Ptr GValue -> IO CULong
get_ulong

instance IsGValue Int64 where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeInt64
  gvalueSet_ :: Ptr GValue -> Int64 -> IO ()
gvalueSet_ = Ptr GValue -> Int64 -> IO ()
set_int64
  gvalueGet_ :: Ptr GValue -> IO Int64
gvalueGet_ = Ptr GValue -> IO Int64
get_int64

instance IsGValue Word64 where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeUInt64
  gvalueSet_ :: Ptr GValue -> CGType -> IO ()
gvalueSet_ = Ptr GValue -> CGType -> IO ()
set_uint64
  gvalueGet_ :: Ptr GValue -> IO CGType
gvalueGet_ = Ptr GValue -> IO CGType
get_uint64

instance IsGValue Float where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeFloat
  gvalueSet_ :: Ptr GValue -> Float -> IO ()
gvalueSet_ = Ptr GValue -> Float -> IO ()
set_float
  gvalueGet_ :: Ptr GValue -> IO Float
gvalueGet_ = Ptr GValue -> IO Float
get_float

instance IsGValue Double where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeDouble
  gvalueSet_ :: Ptr GValue -> Double -> IO ()
gvalueSet_ = Ptr GValue -> Double -> IO ()
set_double
  gvalueGet_ :: Ptr GValue -> IO Double
gvalueGet_ = Ptr GValue -> IO Double
get_double

instance IsGValue Bool where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeBoolean
  gvalueSet_ :: Ptr GValue -> Bool -> IO ()
gvalueSet_ = Ptr GValue -> Bool -> IO ()
set_boolean
  gvalueGet_ :: Ptr GValue -> IO Bool
gvalueGet_ = Ptr GValue -> IO Bool
get_boolean

instance IsGValue GType where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeGType
  gvalueSet_ :: Ptr GValue -> GType -> IO ()
gvalueSet_ = Ptr GValue -> GType -> IO ()
set_gtype
  gvalueGet_ :: Ptr GValue -> IO GType
gvalueGet_ = Ptr GValue -> IO GType
get_gtype

instance IsGValue (StablePtr a) where
  gvalueGType_ :: IO GType
gvalueGType_ = GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
gtypeStablePtr
  gvalueSet_ :: Ptr GValue -> StablePtr a -> IO ()
gvalueSet_ = Ptr GValue -> StablePtr a -> IO ()
forall a. Ptr GValue -> StablePtr a -> IO ()
set_stablePtr
  gvalueGet_ :: Ptr GValue -> IO (StablePtr a)
gvalueGet_ = Ptr GValue -> IO (StablePtr a)
forall a. Ptr GValue -> IO (StablePtr a)
get_stablePtr

foreign import ccall "g_value_set_string" _set_string ::
    Ptr GValue -> CString -> IO ()
foreign import ccall "g_value_get_string" _get_string ::
    Ptr GValue -> IO CString

set_string :: Ptr GValue -> Maybe Text -> IO ()
set_string :: Ptr GValue -> Maybe Text -> IO ()
set_string Ptr GValue
ptr Maybe Text
maybeStr = do
  CString
cstr <- case Maybe Text
maybeStr of
            Just Text
str -> Text -> IO CString
textToCString Text
str
            Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
  Ptr GValue -> CString -> IO ()
_set_string Ptr GValue
ptr CString
cstr
  CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
cstr

get_string :: Ptr GValue -> IO (Maybe Text)
get_string :: Ptr GValue -> IO (Maybe Text)
get_string Ptr GValue
gvptr = do
  CString
cstr <- Ptr GValue -> IO CString
_get_string Ptr GValue
gvptr
  if CString
cstr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr
    then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
cstr
    else Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing

foreign import ccall unsafe "g_value_set_pointer" set_pointer ::
    Ptr GValue -> Ptr a -> IO ()
foreign import ccall unsafe "g_value_get_pointer" get_pointer ::
    Ptr GValue -> IO (Ptr b)

foreign import ccall unsafe "g_value_set_int" set_int ::
    Ptr GValue -> CInt -> IO ()
foreign import ccall unsafe "g_value_get_int" get_int ::
    Ptr GValue -> IO CInt

set_int32 :: Ptr GValue -> Int32 -> IO ()
set_int32 :: Ptr GValue -> Int32 -> IO ()
set_int32 Ptr GValue
gv Int32
n = Ptr GValue -> CInt -> IO ()
set_int Ptr GValue
gv (Int32 -> CInt
coerce Int32
n)

get_int32 :: Ptr GValue -> IO Int32
get_int32 :: Ptr GValue -> IO Int32
get_int32 Ptr GValue
gv = CInt -> Int32
coerce (CInt -> Int32) -> IO CInt -> IO Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr GValue -> IO CInt
get_int Ptr GValue
gv

foreign import ccall unsafe "g_value_set_uint" set_uint ::
    Ptr GValue -> CUInt -> IO ()
foreign import ccall unsafe "g_value_get_uint" get_uint ::
    Ptr GValue -> IO CUInt

set_uint32 :: Ptr GValue -> Word32 -> IO ()
set_uint32 :: Ptr GValue -> Word32 -> IO ()
set_uint32 Ptr GValue
gv Word32
n = Ptr GValue -> CUInt -> IO ()
set_uint Ptr GValue
gv (Word32 -> CUInt
coerce Word32
n)

get_uint32 :: Ptr GValue -> IO Word32
get_uint32 :: Ptr GValue -> IO Word32
get_uint32 Ptr GValue
gv = CUInt -> Word32
coerce (CUInt -> Word32) -> IO CUInt -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr GValue -> IO CUInt
get_uint Ptr GValue
gv

foreign import ccall unsafe "g_value_set_long" set_long ::
    Ptr GValue -> CLong -> IO ()
foreign import ccall unsafe "g_value_get_long" get_long ::
    Ptr GValue -> IO CLong

foreign import ccall unsafe "g_value_set_ulong" set_ulong ::
    Ptr GValue -> CULong -> IO ()
foreign import ccall unsafe "g_value_get_ulong" get_ulong ::
    Ptr GValue -> IO CULong

foreign import ccall unsafe "g_value_set_int64" set_int64 ::
    Ptr GValue -> Int64 -> IO ()
foreign import ccall unsafe "g_value_get_int64" get_int64 ::
    Ptr GValue -> IO Int64

foreign import ccall unsafe "g_value_set_uint64" set_uint64 ::
    Ptr GValue -> Word64 -> IO ()
foreign import ccall unsafe "g_value_get_uint64" get_uint64 ::
    Ptr GValue -> IO Word64

foreign import ccall unsafe "g_value_set_float" _set_float ::
    Ptr GValue -> CFloat -> IO ()
foreign import ccall unsafe "g_value_get_float" _get_float ::
    Ptr GValue -> IO CFloat

set_float :: Ptr GValue -> Float -> IO ()
set_float :: Ptr GValue -> Float -> IO ()
set_float Ptr GValue
gv Float
f = Ptr GValue -> CFloat -> IO ()
_set_float Ptr GValue
gv (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
f)

get_float :: Ptr GValue -> IO Float
get_float :: Ptr GValue -> IO Float
get_float Ptr GValue
gv = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFloat -> Float) -> IO CFloat -> IO Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr GValue -> IO CFloat
_get_float Ptr GValue
gv

foreign import ccall unsafe "g_value_set_double" _set_double ::
    Ptr GValue -> CDouble -> IO ()
foreign import ccall unsafe "g_value_get_double" _get_double ::
    Ptr GValue -> IO CDouble

set_double :: Ptr GValue -> Double -> IO ()
set_double :: Ptr GValue -> Double -> IO ()
set_double Ptr GValue
gv Double
d = Ptr GValue -> CDouble -> IO ()
_set_double Ptr GValue
gv (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
d)

get_double :: Ptr GValue -> IO Double
get_double :: Ptr GValue -> IO Double
get_double Ptr GValue
gv = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> IO CDouble -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr GValue -> IO CDouble
_get_double Ptr GValue
gv

foreign import ccall unsafe "g_value_set_boolean" _set_boolean ::
    Ptr GValue -> CInt -> IO ()
foreign import ccall unsafe "g_value_get_boolean" _get_boolean ::
    Ptr GValue -> IO CInt

set_boolean :: Ptr GValue -> Bool -> IO ()
set_boolean :: Ptr GValue -> Bool -> IO ()
set_boolean Ptr GValue
gv Bool
b = Ptr GValue -> CInt -> IO ()
_set_boolean Ptr GValue
gv (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
b)

get_boolean :: Ptr GValue -> IO Bool
get_boolean :: Ptr GValue -> IO Bool
get_boolean Ptr GValue
gv = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr GValue -> IO CInt
_get_boolean Ptr GValue
gv

foreign import ccall unsafe "g_value_set_gtype" _set_gtype ::
    Ptr GValue -> CGType -> IO ()
foreign import ccall unsafe "g_value_get_gtype" _get_gtype ::
    Ptr GValue -> IO CGType

set_gtype :: Ptr GValue -> GType -> IO ()
set_gtype :: Ptr GValue -> GType -> IO ()
set_gtype Ptr GValue
gv (GType CGType
g) = Ptr GValue -> CGType -> IO ()
_set_gtype Ptr GValue
gv CGType
g

get_gtype :: Ptr GValue -> IO GType
get_gtype :: Ptr GValue -> IO GType
get_gtype Ptr GValue
gv = CGType -> GType
GType (CGType -> GType) -> IO CGType -> IO GType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr GValue -> IO CGType
_get_gtype Ptr GValue
gv

foreign import ccall "g_value_set_object" _set_object ::
    Ptr GValue -> Ptr a -> IO ()
foreign import ccall "g_value_get_object" _get_object ::
    Ptr GValue -> IO (Ptr a)

set_object :: GObject a => Ptr GValue -> Ptr a -> IO ()
set_object :: Ptr GValue -> Ptr a -> IO ()
set_object = Ptr GValue -> Ptr a -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
_set_object

get_object :: GObject a => Ptr GValue -> IO (Ptr a)
get_object :: Ptr GValue -> IO (Ptr a)
get_object = Ptr GValue -> IO (Ptr a)
forall a. Ptr GValue -> IO (Ptr a)
_get_object

foreign import ccall "g_value_set_boxed" set_boxed ::
    Ptr GValue -> Ptr a -> IO ()
foreign import ccall "g_value_get_boxed" get_boxed ::
    Ptr GValue -> IO (Ptr b)

foreign import ccall "g_value_set_variant" set_variant ::
    Ptr GValue -> Ptr GVariant -> IO ()
foreign import ccall "g_value_get_variant" get_variant ::
    Ptr GValue -> IO (Ptr GVariant)

foreign import ccall unsafe "g_value_set_enum" set_enum ::
    Ptr GValue -> CUInt -> IO ()
foreign import ccall unsafe "g_value_get_enum" get_enum ::
    Ptr GValue -> IO CUInt

foreign import ccall unsafe "g_value_set_flags" set_flags ::
    Ptr GValue -> CUInt -> IO ()
foreign import ccall unsafe "g_value_get_flags" get_flags ::
    Ptr GValue -> IO CUInt

-- | Set the value of `GValue` containing a `StablePtr`
set_stablePtr :: Ptr GValue -> StablePtr a -> IO ()
set_stablePtr :: Ptr GValue -> StablePtr a -> IO ()
set_stablePtr Ptr GValue
gv StablePtr a
ptr = Ptr GValue -> Ptr () -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
set_boxed Ptr GValue
gv (StablePtr a -> Ptr ()
forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr a
ptr)

foreign import ccall g_value_take_boxed :: Ptr GValue -> StablePtr a -> IO ()

-- | Like `set_stablePtr`, but the `GValue` takes ownership of the `StablePtr`
take_stablePtr :: Ptr GValue -> StablePtr a -> IO ()
take_stablePtr :: Ptr GValue -> StablePtr a -> IO ()
take_stablePtr = Ptr GValue -> StablePtr a -> IO ()
forall a. Ptr GValue -> StablePtr a -> IO ()
g_value_take_boxed

-- | Get the value of a `GValue` containing a `StablePtr`
get_stablePtr :: Ptr GValue -> IO (StablePtr a)
get_stablePtr :: Ptr GValue -> IO (StablePtr a)
get_stablePtr Ptr GValue
gv = Ptr () -> StablePtr a
forall a. Ptr () -> StablePtr a
castPtrToStablePtr (Ptr () -> StablePtr a) -> IO (Ptr ()) -> IO (StablePtr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr GValue -> IO (Ptr ())
forall a. Ptr GValue -> IO (Ptr a)
get_boxed Ptr GValue
gv

foreign import ccall g_value_copy :: Ptr GValue -> Ptr GValue -> IO ()

-- | Pack the given list of GValues contiguously into a C array
packGValueArray :: [GValue] -> IO (Ptr GValue)
packGValueArray :: [GValue] -> IO (Ptr GValue)
packGValueArray [GValue]
gvalues = [GValue] -> ([Ptr GValue] -> IO (Ptr GValue)) -> IO (Ptr GValue)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
[a] -> ([Ptr a] -> IO c) -> IO c
withManagedPtrList [GValue]
gvalues (([Ptr GValue] -> IO (Ptr GValue)) -> IO (Ptr GValue))
-> ([Ptr GValue] -> IO (Ptr GValue)) -> IO (Ptr GValue)
forall a b. (a -> b) -> a -> b
$ \[Ptr GValue]
ptrs -> do
  let nitems :: Int
nitems = [Ptr GValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr GValue]
ptrs
  Ptr GValue
mem <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
callocBytes (Int -> IO (Ptr GValue)) -> Int -> IO (Ptr GValue)
forall a b. (a -> b) -> a -> b
$ Int
cgvalueSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nitems
  Ptr GValue -> [Ptr GValue] -> IO ()
fill Ptr GValue
mem [Ptr GValue]
ptrs
  Ptr GValue -> IO (Ptr GValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GValue
mem
  where fill :: Ptr GValue -> [Ptr GValue] -> IO ()
        fill :: Ptr GValue -> [Ptr GValue] -> IO ()
fill Ptr GValue
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        fill Ptr GValue
ptr (Ptr GValue
x:[Ptr GValue]
xs) = do
          CGType
gtype <- Ptr GValue -> IO CGType
g_value_get_type Ptr GValue
x
          Ptr GValue
_ <- Ptr GValue -> CGType -> IO (Ptr GValue)
g_value_init Ptr GValue
ptr CGType
gtype
          Ptr GValue -> Ptr GValue -> IO ()
g_value_copy Ptr GValue
x Ptr GValue
ptr
          Ptr GValue -> [Ptr GValue] -> IO ()
fill (Ptr GValue
ptr Ptr GValue -> Int -> Ptr GValue
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
cgvalueSize) [Ptr GValue]
xs

-- | Unpack an array of contiguous GValues into a list of GValues.
unpackGValueArrayWithLength :: Integral a =>
                               a -> Ptr GValue -> IO [GValue]
unpackGValueArrayWithLength :: a -> Ptr GValue -> IO [GValue]
unpackGValueArrayWithLength a
nitems Ptr GValue
gvalues = Int -> Ptr GValue -> IO [GValue]
go (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
nitems) Ptr GValue
gvalues
  where go :: Int -> Ptr GValue -> IO [GValue]
        go :: Int -> Ptr GValue -> IO [GValue]
go Int
0 Ptr GValue
_ = [GValue] -> IO [GValue]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        go Int
n Ptr GValue
ptr = do
          Ptr GValue
gv <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
callocBytes Int
cgvalueSize
          CGType
gtype <- Ptr GValue -> IO CGType
g_value_get_type Ptr GValue
ptr
          Ptr GValue
_ <- Ptr GValue -> CGType -> IO (Ptr GValue)
g_value_init Ptr GValue
gv CGType
gtype
          Ptr GValue -> Ptr GValue -> IO ()
g_value_copy Ptr GValue
ptr Ptr GValue
gv
          GValue
wrapped <- Ptr GValue -> IO GValue
wrapGValuePtr Ptr GValue
gv
          (GValue
wrapped GValue -> [GValue] -> [GValue]
forall a. a -> [a] -> [a]
:) ([GValue] -> [GValue]) -> IO [GValue] -> IO [GValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr GValue -> IO [GValue]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Ptr GValue
ptr Ptr GValue -> Int -> Ptr GValue
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
cgvalueSize)

-- | Map over the `GValue`s inside a C array.
mapGValueArrayWithLength :: Integral a =>
                            a -> (Ptr GValue -> IO c) -> Ptr GValue -> IO ()
mapGValueArrayWithLength :: a -> (Ptr GValue -> IO c) -> Ptr GValue -> IO ()
mapGValueArrayWithLength a
nvalues Ptr GValue -> IO c
f Ptr GValue
arrayPtr
  | (Ptr GValue
arrayPtr Ptr GValue -> Ptr GValue -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr GValue
forall a. Ptr a
nullPtr) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | (a
nvalues a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = Int -> Ptr GValue -> IO ()
go (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
nvalues) Ptr GValue
arrayPtr
  where go :: Int -> Ptr GValue -> IO ()
        go :: Int -> Ptr GValue -> IO ()
go Int
0 Ptr GValue
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        go Int
n Ptr GValue
ptr = do
          c
_ <- Ptr GValue -> IO c
f Ptr GValue
ptr
          Int -> Ptr GValue -> IO ()
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Ptr GValue
ptr Ptr GValue -> Int -> Ptr GValue
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
cgvalueSize)