{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @JsonSerializable@ is an interface for controlling the serialization
-- and deserialization of @GObject@ classes.
-- 
-- Implementing this interface allows controlling how the class is going
-- to be serialized or deserialized by [func/@json@/.construct_gobject] and
-- [func/@json@/.serialize_gobject], respectively.

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

module GI.Json.Interfaces.Serializable
    ( 
#if defined(ENABLE_OVERLOADING)
    SerializableListPropertiesMethodInfo    ,
#endif

-- * Exported types
    Serializable(..)                        ,
    IsSerializable                          ,
    toSerializable                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [defaultDeserializeProperty]("GI.Json.Interfaces.Serializable#g:method:defaultDeserializeProperty"), [defaultSerializeProperty]("GI.Json.Interfaces.Serializable#g:method:defaultSerializeProperty"), [deserializeProperty]("GI.Json.Interfaces.Serializable#g:method:deserializeProperty"), [findProperty]("GI.Json.Interfaces.Serializable#g:method:findProperty"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [listProperties]("GI.Json.Interfaces.Serializable#g:method:listProperties"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [serializeProperty]("GI.Json.Interfaces.Serializable#g:method:serializeProperty"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.Json.Interfaces.Serializable#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.Json.Interfaces.Serializable#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveSerializableMethod               ,
#endif

-- ** defaultDeserializeProperty #method:defaultDeserializeProperty#

#if defined(ENABLE_OVERLOADING)
    SerializableDefaultDeserializePropertyMethodInfo,
#endif
    serializableDefaultDeserializeProperty  ,


-- ** defaultSerializeProperty #method:defaultSerializeProperty#

#if defined(ENABLE_OVERLOADING)
    SerializableDefaultSerializePropertyMethodInfo,
#endif
    serializableDefaultSerializeProperty    ,


-- ** deserializeProperty #method:deserializeProperty#

#if defined(ENABLE_OVERLOADING)
    SerializableDeserializePropertyMethodInfo,
#endif
    serializableDeserializeProperty         ,


-- ** findProperty #method:findProperty#

#if defined(ENABLE_OVERLOADING)
    SerializableFindPropertyMethodInfo      ,
#endif
    serializableFindProperty                ,


-- ** getProperty #method:getProperty#

#if defined(ENABLE_OVERLOADING)
    SerializableGetPropertyMethodInfo       ,
#endif
    serializableGetProperty                 ,


-- ** serializeProperty #method:serializeProperty#

#if defined(ENABLE_OVERLOADING)
    SerializableSerializePropertyMethodInfo ,
#endif
    serializableSerializeProperty           ,


-- ** setProperty #method:setProperty#

#if defined(ENABLE_OVERLOADING)
    SerializableSetPropertyMethodInfo       ,
#endif
    serializableSetProperty                 ,




    ) 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.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.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 GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Json.Structs.Node as Json.Node

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

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

foreign import ccall "json_serializable_get_type"
    c_json_serializable_get_type :: IO B.Types.GType

instance B.Types.TypedObject Serializable where
    glibType :: IO GType
glibType = IO GType
c_json_serializable_get_type

instance B.Types.GObject Serializable

-- | Type class for types which can be safely cast to `Serializable`, for instance with `toSerializable`.
class (SP.GObject o, O.IsDescendantOf Serializable o) => IsSerializable o
instance (SP.GObject o, O.IsDescendantOf Serializable o) => IsSerializable o

instance O.HasParentTypes Serializable
type instance O.ParentTypes Serializable = '[GObject.Object.Object]

-- | Cast to `Serializable`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toSerializable :: (MIO.MonadIO m, IsSerializable o) => o -> m Serializable
toSerializable :: forall (m :: * -> *) o.
(MonadIO m, IsSerializable o) =>
o -> m Serializable
toSerializable = IO Serializable -> m Serializable
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Serializable -> m Serializable)
-> (o -> IO Serializable) -> o -> m Serializable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Serializable -> Serializable) -> o -> IO Serializable
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Serializable -> Serializable
Serializable

-- | Convert 'Serializable' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Serializable) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_json_serializable_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Serializable -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Serializable
P.Nothing = Ptr GValue -> Ptr Serializable -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Serializable
forall a. Ptr a
FP.nullPtr :: FP.Ptr Serializable)
    gvalueSet_ Ptr GValue
gv (P.Just Serializable
obj) = Serializable -> (Ptr Serializable -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Serializable
obj (Ptr GValue -> Ptr Serializable -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Serializable)
gvalueGet_ Ptr GValue
gv = do
        Ptr Serializable
ptr <- Ptr GValue -> IO (Ptr Serializable)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Serializable)
        if Ptr Serializable
ptr Ptr Serializable -> Ptr Serializable -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Serializable
forall a. Ptr a
FP.nullPtr
        then Serializable -> Maybe Serializable
forall a. a -> Maybe a
P.Just (Serializable -> Maybe Serializable)
-> IO Serializable -> IO (Maybe Serializable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Serializable -> Serializable)
-> Ptr Serializable -> IO Serializable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Serializable -> Serializable
Serializable Ptr Serializable
ptr
        else Maybe Serializable -> IO (Maybe Serializable)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Serializable
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Serializable
type instance O.AttributeList Serializable = SerializableAttributeList
type SerializableAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSerializableMethod (t :: Symbol) (o :: *) :: * where
    ResolveSerializableMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSerializableMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSerializableMethod "defaultDeserializeProperty" o = SerializableDefaultDeserializePropertyMethodInfo
    ResolveSerializableMethod "defaultSerializeProperty" o = SerializableDefaultSerializePropertyMethodInfo
    ResolveSerializableMethod "deserializeProperty" o = SerializableDeserializePropertyMethodInfo
    ResolveSerializableMethod "findProperty" o = SerializableFindPropertyMethodInfo
    ResolveSerializableMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSerializableMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSerializableMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSerializableMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSerializableMethod "listProperties" o = SerializableListPropertiesMethodInfo
    ResolveSerializableMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSerializableMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSerializableMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSerializableMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSerializableMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSerializableMethod "serializeProperty" o = SerializableSerializePropertyMethodInfo
    ResolveSerializableMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSerializableMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSerializableMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSerializableMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSerializableMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSerializableMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSerializableMethod "getProperty" o = SerializableGetPropertyMethodInfo
    ResolveSerializableMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSerializableMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSerializableMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSerializableMethod "setProperty" o = SerializableSetPropertyMethodInfo
    ResolveSerializableMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveSerializableMethod t Serializable, O.OverloadedMethod info Serializable p) => OL.IsLabel t (Serializable -> 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 ~ ResolveSerializableMethod t Serializable, O.OverloadedMethod info Serializable p, R.HasField t Serializable p) => R.HasField t Serializable p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- method Serializable::default_deserialize_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "serializable"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Serializable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a serializable object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to deserialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to an uninitialized value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pspec"
--           , argType = TParamSpec
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a property description"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the JSON node containing the serialized property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "json_serializable_default_deserialize_property" json_serializable_default_deserialize_property :: 
    Ptr Serializable ->                     -- serializable : TInterface (Name {namespace = "Json", name = "Serializable"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    Ptr GParamSpec ->                       -- pspec : TParamSpec
    Ptr Json.Node.Node ->                   -- property_node : TInterface (Name {namespace = "Json", name = "Node"})
    IO CInt

-- | Calls the default implementation of the [vfunc/@json@/.Serializable.deserialize_property]
-- virtual function.
-- 
-- This function can be used inside a custom implementation of the
-- @deserialize_property()@ virtual function in lieu of calling the
-- default implementation through @g_type_default_interface_peek()@:
-- 
-- \`\`@c
-- JsonSerializable *iface;
-- gboolean res;
-- 
-- iface = g_type_default_interface_peek (JSON_TYPE_SERIALIZABLE);
-- res = iface->deserialize_property (serializable, property_name,
--                                    value,
--                                    pspec,
--                                    property_node);
-- @\`\`
-- 
-- /Since: 0.10/
serializableDefaultDeserializeProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsSerializable a) =>
    a
    -- ^ /@serializable@/: a serializable object
    -> T.Text
    -- ^ /@propertyName@/: the name of the property to deserialize
    -> GValue
    -- ^ /@value@/: a pointer to an uninitialized value
    -> GParamSpec
    -- ^ /@pspec@/: a property description
    -> Json.Node.Node
    -- ^ /@propertyNode@/: the JSON node containing the serialized property
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the property was successfully deserialized
serializableDefaultDeserializeProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSerializable a) =>
a -> Text -> GValue -> GParamSpec -> Node -> m Bool
serializableDefaultDeserializeProperty a
serializable Text
propertyName GValue
value GParamSpec
pspec Node
propertyNode = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Serializable
serializable' <- a -> IO (Ptr Serializable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
serializable
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr GParamSpec
pspec' <- GParamSpec -> IO (Ptr GParamSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GParamSpec
pspec
    Ptr Node
propertyNode' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
propertyNode
    CInt
result <- Ptr Serializable
-> CString -> Ptr GValue -> Ptr GParamSpec -> Ptr Node -> IO CInt
json_serializable_default_deserialize_property Ptr Serializable
serializable' CString
propertyName' Ptr GValue
value' Ptr GParamSpec
pspec' Ptr Node
propertyNode'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
serializable
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    GParamSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GParamSpec
pspec
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
propertyNode
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SerializableDefaultDeserializePropertyMethodInfo
instance (signature ~ (T.Text -> GValue -> GParamSpec -> Json.Node.Node -> m Bool), MonadIO m, IsSerializable a) => O.OverloadedMethod SerializableDefaultDeserializePropertyMethodInfo a signature where
    overloadedMethod = serializableDefaultDeserializeProperty

instance O.OverloadedMethodInfo SerializableDefaultDeserializePropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Interfaces.Serializable.serializableDefaultDeserializeProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Interfaces-Serializable.html#v:serializableDefaultDeserializeProperty"
        })


#endif

-- method Serializable::default_serialize_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "serializable"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Serializable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a serializable object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to serialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the property to serialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pspec"
--           , argType = TParamSpec
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a property description"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Json" , name = "Node" })
-- throws : False
-- Skip return : False

foreign import ccall "json_serializable_default_serialize_property" json_serializable_default_serialize_property :: 
    Ptr Serializable ->                     -- serializable : TInterface (Name {namespace = "Json", name = "Serializable"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    Ptr GParamSpec ->                       -- pspec : TParamSpec
    IO (Ptr Json.Node.Node)

-- | Calls the default implementation of the [vfunc/@json@/.Serializable.serialize_property]
-- virtual function.
-- 
-- This function can be used inside a custom implementation of the
-- @serialize_property()@ virtual function in lieu of calling the
-- default implementation through @g_type_default_interface_peek()@:
-- 
-- \`\`@c
-- JsonSerializable *iface;
-- JsonNode *node;
-- 
-- iface = g_type_default_interface_peek (JSON_TYPE_SERIALIZABLE);
-- node = iface->serialize_property (serializable, property_name,
--                                   value,
--                                   pspec);
-- @\`@
-- 
-- This function will return @NULL\` if the property could not be
-- serialized.
-- 
-- /Since: 0.10/
serializableDefaultSerializeProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsSerializable a) =>
    a
    -- ^ /@serializable@/: a serializable object
    -> T.Text
    -- ^ /@propertyName@/: the name of the property to serialize
    -> GValue
    -- ^ /@value@/: the value of the property to serialize
    -> GParamSpec
    -- ^ /@pspec@/: a property description
    -> m (Maybe Json.Node.Node)
    -- ^ __Returns:__ a node containing the
    --   serialized property
serializableDefaultSerializeProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSerializable a) =>
a -> Text -> GValue -> GParamSpec -> m (Maybe Node)
serializableDefaultSerializeProperty a
serializable Text
propertyName GValue
value GParamSpec
pspec = IO (Maybe Node) -> m (Maybe Node)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Node) -> m (Maybe Node))
-> IO (Maybe Node) -> m (Maybe Node)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Serializable
serializable' <- a -> IO (Ptr Serializable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
serializable
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr GParamSpec
pspec' <- GParamSpec -> IO (Ptr GParamSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GParamSpec
pspec
    Ptr Node
result <- Ptr Serializable
-> CString -> Ptr GValue -> Ptr GParamSpec -> IO (Ptr Node)
json_serializable_default_serialize_property Ptr Serializable
serializable' CString
propertyName' Ptr GValue
value' Ptr GParamSpec
pspec'
    Maybe Node
maybeResult <- Ptr Node -> (Ptr Node -> IO Node) -> IO (Maybe Node)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Node
result ((Ptr Node -> IO Node) -> IO (Maybe Node))
-> (Ptr Node -> IO Node) -> IO (Maybe Node)
forall a b. (a -> b) -> a -> b
$ \Ptr Node
result' -> do
        Node
result'' <- ((ManagedPtr Node -> Node) -> Ptr Node -> IO Node
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Node -> Node
Json.Node.Node) Ptr Node
result'
        Node -> IO Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
serializable
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    GParamSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GParamSpec
pspec
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Maybe Node -> IO (Maybe Node)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Node
maybeResult

#if defined(ENABLE_OVERLOADING)
data SerializableDefaultSerializePropertyMethodInfo
instance (signature ~ (T.Text -> GValue -> GParamSpec -> m (Maybe Json.Node.Node)), MonadIO m, IsSerializable a) => O.OverloadedMethod SerializableDefaultSerializePropertyMethodInfo a signature where
    overloadedMethod = serializableDefaultSerializeProperty

instance O.OverloadedMethodInfo SerializableDefaultSerializePropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Interfaces.Serializable.serializableDefaultSerializeProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Interfaces-Serializable.html#v:serializableDefaultSerializeProperty"
        })


#endif

-- method Serializable::deserialize_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "serializable"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Serializable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a serializable object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to serialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a pointer to an uninitialized value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pspec"
--           , argType = TParamSpec
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a property description"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the JSON node containing the serialized property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "json_serializable_deserialize_property" json_serializable_deserialize_property :: 
    Ptr Serializable ->                     -- serializable : TInterface (Name {namespace = "Json", name = "Serializable"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    Ptr GParamSpec ->                       -- pspec : TParamSpec
    Ptr Json.Node.Node ->                   -- property_node : TInterface (Name {namespace = "Json", name = "Node"})
    IO CInt

-- | Asks a @JsonSerializable@ implementation to deserialize the
-- property contained inside @property_node@ and place its value
-- into @value@.
-- 
-- The @value@ can be:
-- 
-- * an empty @GValue@ initialized by @G_VALUE_INIT@, which will be automatically
-- initialized with the expected type of the property by using the given
-- property description (since JSON-GLib 1.6)
-- * a @GValue@ initialized with the expected type of the property
serializableDeserializeProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsSerializable a) =>
    a
    -- ^ /@serializable@/: a serializable object
    -> T.Text
    -- ^ /@propertyName@/: the name of the property to serialize
    -> GParamSpec
    -- ^ /@pspec@/: a property description
    -> Json.Node.Node
    -- ^ /@propertyNode@/: the JSON node containing the serialized property
    -> m ((Bool, GValue))
    -- ^ __Returns:__ @TRUE@ if the property was successfully deserialized
serializableDeserializeProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSerializable a) =>
a -> Text -> GParamSpec -> Node -> m (Bool, GValue)
serializableDeserializeProperty a
serializable Text
propertyName GParamSpec
pspec Node
propertyNode = IO (Bool, GValue) -> m (Bool, GValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, GValue) -> m (Bool, GValue))
-> IO (Bool, GValue) -> m (Bool, GValue)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Serializable
serializable' <- a -> IO (Ptr Serializable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
serializable
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GValue
value <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    Ptr GParamSpec
pspec' <- GParamSpec -> IO (Ptr GParamSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GParamSpec
pspec
    Ptr Node
propertyNode' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
propertyNode
    CInt
result <- Ptr Serializable
-> CString -> Ptr GValue -> Ptr GParamSpec -> Ptr Node -> IO CInt
json_serializable_deserialize_property Ptr Serializable
serializable' CString
propertyName' Ptr GValue
value Ptr GParamSpec
pspec' Ptr Node
propertyNode'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
serializable
    GParamSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GParamSpec
pspec
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
propertyNode
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    (Bool, GValue) -> IO (Bool, GValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', GValue
value')

#if defined(ENABLE_OVERLOADING)
data SerializableDeserializePropertyMethodInfo
instance (signature ~ (T.Text -> GParamSpec -> Json.Node.Node -> m ((Bool, GValue))), MonadIO m, IsSerializable a) => O.OverloadedMethod SerializableDeserializePropertyMethodInfo a signature where
    overloadedMethod = serializableDeserializeProperty

instance O.OverloadedMethodInfo SerializableDeserializePropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Interfaces.Serializable.serializableDeserializeProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Interfaces-Serializable.html#v:serializableDeserializeProperty"
        })


#endif

-- method Serializable::find_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "serializable"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Serializable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a serializable object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TParamSpec
-- throws : False
-- Skip return : False

foreign import ccall "json_serializable_find_property" json_serializable_find_property :: 
    Ptr Serializable ->                     -- serializable : TInterface (Name {namespace = "Json", name = "Serializable"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GParamSpec)

-- | Calls the [vfunc/@json@/.Serializable.find_property] implementation on
-- the @JsonSerializable@ instance, which will return the property
-- description for the given name.
-- 
-- /Since: 0.14/
serializableFindProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsSerializable a) =>
    a
    -- ^ /@serializable@/: a serializable object
    -> T.Text
    -- ^ /@name@/: the name of the property
    -> m (Maybe GParamSpec)
    -- ^ __Returns:__ the property description
serializableFindProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSerializable a) =>
a -> Text -> m (Maybe GParamSpec)
serializableFindProperty a
serializable Text
name = IO (Maybe GParamSpec) -> m (Maybe GParamSpec)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GParamSpec) -> m (Maybe GParamSpec))
-> IO (Maybe GParamSpec) -> m (Maybe GParamSpec)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Serializable
serializable' <- a -> IO (Ptr Serializable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
serializable
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GParamSpec
result <- Ptr Serializable -> CString -> IO (Ptr GParamSpec)
json_serializable_find_property Ptr Serializable
serializable' CString
name'
    Maybe GParamSpec
maybeResult <- Ptr GParamSpec
-> (Ptr GParamSpec -> IO GParamSpec) -> IO (Maybe GParamSpec)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GParamSpec
result ((Ptr GParamSpec -> IO GParamSpec) -> IO (Maybe GParamSpec))
-> (Ptr GParamSpec -> IO GParamSpec) -> IO (Maybe GParamSpec)
forall a b. (a -> b) -> a -> b
$ \Ptr GParamSpec
result' -> do
        GParamSpec
result'' <- Ptr GParamSpec -> IO GParamSpec
B.GParamSpec.newGParamSpecFromPtr Ptr GParamSpec
result'
        GParamSpec -> IO GParamSpec
forall (m :: * -> *) a. Monad m => a -> m a
return GParamSpec
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
serializable
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe GParamSpec -> IO (Maybe GParamSpec)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GParamSpec
maybeResult

#if defined(ENABLE_OVERLOADING)
data SerializableFindPropertyMethodInfo
instance (signature ~ (T.Text -> m (Maybe GParamSpec)), MonadIO m, IsSerializable a) => O.OverloadedMethod SerializableFindPropertyMethodInfo a signature where
    overloadedMethod = serializableFindProperty

instance O.OverloadedMethodInfo SerializableFindPropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Interfaces.Serializable.serializableFindProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Interfaces-Serializable.html#v:serializableFindProperty"
        })


#endif

-- method Serializable::get_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "serializable"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Serializable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a serializable object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pspec"
--           , argType = TParamSpec
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a property description"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the property value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_serializable_get_property" json_serializable_get_property :: 
    Ptr Serializable ->                     -- serializable : TInterface (Name {namespace = "Json", name = "Serializable"})
    Ptr GParamSpec ->                       -- pspec : TParamSpec
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Calls the [vfunc/@json@/.Serializable.get_property] implementation
-- on the @JsonSerializable@ instance, which will get the value of
-- the given property.
-- 
-- /Since: 0.14/
serializableGetProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsSerializable a) =>
    a
    -- ^ /@serializable@/: a serializable object
    -> GParamSpec
    -- ^ /@pspec@/: a property description
    -> m (GValue)
serializableGetProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSerializable a) =>
a -> GParamSpec -> m GValue
serializableGetProperty a
serializable GParamSpec
pspec = 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 Serializable
serializable' <- a -> IO (Ptr Serializable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
serializable
    Ptr GParamSpec
pspec' <- GParamSpec -> IO (Ptr GParamSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GParamSpec
pspec
    Ptr GValue
value <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    Ptr Serializable -> Ptr GParamSpec -> Ptr GValue -> IO ()
json_serializable_get_property Ptr Serializable
serializable' Ptr GParamSpec
pspec' Ptr GValue
value
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
serializable
    GParamSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GParamSpec
pspec
    GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
value'

#if defined(ENABLE_OVERLOADING)
data SerializableGetPropertyMethodInfo
instance (signature ~ (GParamSpec -> m (GValue)), MonadIO m, IsSerializable a) => O.OverloadedMethod SerializableGetPropertyMethodInfo a signature where
    overloadedMethod = serializableGetProperty

instance O.OverloadedMethodInfo SerializableGetPropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Interfaces.Serializable.serializableGetProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Interfaces-Serializable.html#v:serializableGetProperty"
        })


#endif

-- XXX Could not generate method Serializable::list_properties
-- Not implemented: unpackCArray : Don't know how to unpack C Array of type TParamSpec
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data SerializableListPropertiesMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "listProperties" Serializable) => O.OverloadedMethod SerializableListPropertiesMethodInfo o p where
    overloadedMethod = undefined

instance (o ~ O.UnsupportedMethodError "listProperties" Serializable) => O.OverloadedMethodInfo SerializableListPropertiesMethodInfo o where
    overloadedMethodInfo = undefined

#endif

-- method Serializable::serialize_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "serializable"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Serializable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a serializable object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to serialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the property to serialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pspec"
--           , argType = TParamSpec
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a property description"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Json" , name = "Node" })
-- throws : False
-- Skip return : False

foreign import ccall "json_serializable_serialize_property" json_serializable_serialize_property :: 
    Ptr Serializable ->                     -- serializable : TInterface (Name {namespace = "Json", name = "Serializable"})
    CString ->                              -- property_name : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    Ptr GParamSpec ->                       -- pspec : TParamSpec
    IO (Ptr Json.Node.Node)

-- | Asks a @JsonSerializable@ implementation to serialize an object
-- property into a JSON node.
serializableSerializeProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsSerializable a) =>
    a
    -- ^ /@serializable@/: a serializable object
    -> T.Text
    -- ^ /@propertyName@/: the name of the property to serialize
    -> GValue
    -- ^ /@value@/: the value of the property to serialize
    -> GParamSpec
    -- ^ /@pspec@/: a property description
    -> m Json.Node.Node
    -- ^ __Returns:__ a node containing the serialized property
serializableSerializeProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSerializable a) =>
a -> Text -> GValue -> GParamSpec -> m Node
serializableSerializeProperty a
serializable Text
propertyName GValue
value GParamSpec
pspec = IO Node -> m Node
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Node -> m Node) -> IO Node -> m Node
forall a b. (a -> b) -> a -> b
$ do
    Ptr Serializable
serializable' <- a -> IO (Ptr Serializable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
serializable
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr GParamSpec
pspec' <- GParamSpec -> IO (Ptr GParamSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GParamSpec
pspec
    Ptr Node
result <- Ptr Serializable
-> CString -> Ptr GValue -> Ptr GParamSpec -> IO (Ptr Node)
json_serializable_serialize_property Ptr Serializable
serializable' CString
propertyName' Ptr GValue
value' Ptr GParamSpec
pspec'
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"serializableSerializeProperty" Ptr Node
result
    Node
result' <- ((ManagedPtr Node -> Node) -> Ptr Node -> IO Node
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Node -> Node
Json.Node.Node) Ptr Node
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
serializable
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    GParamSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GParamSpec
pspec
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    Node -> IO Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

#if defined(ENABLE_OVERLOADING)
data SerializableSerializePropertyMethodInfo
instance (signature ~ (T.Text -> GValue -> GParamSpec -> m Json.Node.Node), MonadIO m, IsSerializable a) => O.OverloadedMethod SerializableSerializePropertyMethodInfo a signature where
    overloadedMethod = serializableSerializeProperty

instance O.OverloadedMethodInfo SerializableSerializePropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Interfaces.Serializable.serializableSerializeProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Interfaces-Serializable.html#v:serializableSerializeProperty"
        })


#endif

-- method Serializable::set_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "serializable"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Serializable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a serializable object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pspec"
--           , argType = TParamSpec
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a property description"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the property value to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_serializable_set_property" json_serializable_set_property :: 
    Ptr Serializable ->                     -- serializable : TInterface (Name {namespace = "Json", name = "Serializable"})
    Ptr GParamSpec ->                       -- pspec : TParamSpec
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Calls the [vfunc/@json@/.Serializable.set_property] implementation
-- on the @JsonSerializable@ instance, which will set the property
-- with the given value.
-- 
-- /Since: 0.14/
serializableSetProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsSerializable a) =>
    a
    -- ^ /@serializable@/: a serializable object
    -> GParamSpec
    -- ^ /@pspec@/: a property description
    -> GValue
    -- ^ /@value@/: the property value to set
    -> m ()
serializableSetProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSerializable a) =>
a -> GParamSpec -> GValue -> m ()
serializableSetProperty a
serializable GParamSpec
pspec GValue
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Serializable
serializable' <- a -> IO (Ptr Serializable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
serializable
    Ptr GParamSpec
pspec' <- GParamSpec -> IO (Ptr GParamSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GParamSpec
pspec
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Serializable -> Ptr GParamSpec -> Ptr GValue -> IO ()
json_serializable_set_property Ptr Serializable
serializable' Ptr GParamSpec
pspec' Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
serializable
    GParamSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GParamSpec
pspec
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SerializableSetPropertyMethodInfo
instance (signature ~ (GParamSpec -> GValue -> m ()), MonadIO m, IsSerializable a) => O.OverloadedMethod SerializableSetPropertyMethodInfo a signature where
    overloadedMethod = serializableSetProperty

instance O.OverloadedMethodInfo SerializableSetPropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Interfaces.Serializable.serializableSetProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Interfaces-Serializable.html#v:serializableSetProperty"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Serializable = SerializableSignalList
type SerializableSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif