{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Clutter.Interfaces.Scriptable.Scriptable' is an opaque structure whose members cannot be directly
-- accessed
-- 
-- /Since: 0.6/

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

module GI.Clutter.Interfaces.Scriptable
    ( 

-- * Exported types
    Scriptable(..)                          ,
    IsScriptable                            ,
    toScriptable                            ,


 -- * 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"), [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"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [parseCustomNode]("GI.Clutter.Interfaces.Scriptable#g:method:parseCustomNode"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [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"), [getId]("GI.Clutter.Interfaces.Scriptable#g:method:getId"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setCustomProperty]("GI.Clutter.Interfaces.Scriptable#g:method:setCustomProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setId]("GI.Clutter.Interfaces.Scriptable#g:method:setId"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveScriptableMethod                 ,
#endif

-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    ScriptableGetIdMethodInfo               ,
#endif
    scriptableGetId                         ,


-- ** parseCustomNode #method:parseCustomNode#

#if defined(ENABLE_OVERLOADING)
    ScriptableParseCustomNodeMethodInfo     ,
#endif
    scriptableParseCustomNode               ,


-- ** setCustomProperty #method:setCustomProperty#

#if defined(ENABLE_OVERLOADING)
    ScriptableSetCustomPropertyMethodInfo   ,
#endif
    scriptableSetCustomProperty             ,


-- ** setId #method:setId#

#if defined(ENABLE_OVERLOADING)
    ScriptableSetIdMethodInfo               ,
#endif
    scriptableSetId                         ,




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

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

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

foreign import ccall "clutter_scriptable_get_type"
    c_clutter_scriptable_get_type :: IO B.Types.GType

instance B.Types.TypedObject Scriptable where
    glibType :: IO GType
glibType = IO GType
c_clutter_scriptable_get_type

instance B.Types.GObject Scriptable

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

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

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

-- | Convert 'Scriptable' 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 Scriptable) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_scriptable_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Scriptable -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Scriptable
P.Nothing = Ptr GValue -> Ptr Scriptable -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Scriptable
forall a. Ptr a
FP.nullPtr :: FP.Ptr Scriptable)
    gvalueSet_ Ptr GValue
gv (P.Just Scriptable
obj) = Scriptable -> (Ptr Scriptable -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Scriptable
obj (Ptr GValue -> Ptr Scriptable -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Scriptable)
gvalueGet_ Ptr GValue
gv = do
        Ptr Scriptable
ptr <- Ptr GValue -> IO (Ptr Scriptable)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Scriptable)
        if Ptr Scriptable
ptr Ptr Scriptable -> Ptr Scriptable -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Scriptable
forall a. Ptr a
FP.nullPtr
        then Scriptable -> Maybe Scriptable
forall a. a -> Maybe a
P.Just (Scriptable -> Maybe Scriptable)
-> IO Scriptable -> IO (Maybe Scriptable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Scriptable -> Scriptable)
-> Ptr Scriptable -> IO Scriptable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Scriptable -> Scriptable
Scriptable Ptr Scriptable
ptr
        else Maybe Scriptable -> IO (Maybe Scriptable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Scriptable
forall a. Maybe a
P.Nothing
        
    

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveScriptableMethod (t :: Symbol) (o :: *) :: * where
    ResolveScriptableMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveScriptableMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveScriptableMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveScriptableMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveScriptableMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveScriptableMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveScriptableMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveScriptableMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveScriptableMethod "parseCustomNode" o = ScriptableParseCustomNodeMethodInfo
    ResolveScriptableMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveScriptableMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveScriptableMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveScriptableMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveScriptableMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveScriptableMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveScriptableMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveScriptableMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveScriptableMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveScriptableMethod "getId" o = ScriptableGetIdMethodInfo
    ResolveScriptableMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveScriptableMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveScriptableMethod "setCustomProperty" o = ScriptableSetCustomPropertyMethodInfo
    ResolveScriptableMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveScriptableMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveScriptableMethod "setId" o = ScriptableSetIdMethodInfo
    ResolveScriptableMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveScriptableMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method Scriptable::get_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "scriptable"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Scriptable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScriptable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_scriptable_get_id" clutter_scriptable_get_id :: 
    Ptr Scriptable ->                       -- scriptable : TInterface (Name {namespace = "Clutter", name = "Scriptable"})
    IO CString

-- | Retrieves the id of /@scriptable@/ set using 'GI.Clutter.Interfaces.Scriptable.scriptableSetId'.
-- 
-- /Since: 0.6/
scriptableGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsScriptable a) =>
    a
    -- ^ /@scriptable@/: a t'GI.Clutter.Interfaces.Scriptable.Scriptable'
    -> m T.Text
    -- ^ __Returns:__ the id of the object. The returned string is owned by
    --   the scriptable object and should never be modified of freed
scriptableGetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScriptable a) =>
a -> m Text
scriptableGetId a
scriptable = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Scriptable
scriptable' <- a -> IO (Ptr Scriptable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
scriptable
    CString
result <- Ptr Scriptable -> IO CString
clutter_scriptable_get_id Ptr Scriptable
scriptable'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"scriptableGetId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
scriptable
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ScriptableGetIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsScriptable a) => O.OverloadedMethod ScriptableGetIdMethodInfo a signature where
    overloadedMethod = scriptableGetId

instance O.OverloadedMethodInfo ScriptableGetIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Scriptable.scriptableGetId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Interfaces-Scriptable.html#v:scriptableGetId"
        })


#endif

-- method Scriptable::parse_custom_node
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "scriptable"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Scriptable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScriptable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #ClutterScript creating the scriptable instance"
--                 , 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 generic value to be set"
--                 , 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 node"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the JSON node to be parsed"
--                 , 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 "clutter_scriptable_parse_custom_node" clutter_scriptable_parse_custom_node :: 
    Ptr Scriptable ->                       -- scriptable : TInterface (Name {namespace = "Clutter", name = "Scriptable"})
    Ptr Clutter.Script.Script ->            -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    Ptr GValue ->                           -- value : TGValue
    CString ->                              -- name : TBasicType TUTF8
    Ptr Json.Node.Node ->                   -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO CInt

-- | Parses the passed JSON node. The implementation must set the type
-- of the passed t'GI.GObject.Structs.Value.Value' pointer using 'GI.GObject.Structs.Value.valueInit'.
-- 
-- /Since: 0.6/
scriptableParseCustomNode ::
    (B.CallStack.HasCallStack, MonadIO m, IsScriptable a, Clutter.Script.IsScript b) =>
    a
    -- ^ /@scriptable@/: a t'GI.Clutter.Interfaces.Scriptable.Scriptable'
    -> b
    -- ^ /@script@/: the t'GI.Clutter.Objects.Script.Script' creating the scriptable instance
    -> GValue
    -- ^ /@value@/: the generic value to be set
    -> T.Text
    -- ^ /@name@/: the name of the node
    -> Json.Node.Node
    -- ^ /@node@/: the JSON node to be parsed
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the node was successfully parsed, 'P.False' otherwise.
scriptableParseCustomNode :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsScriptable a, IsScript b) =>
a -> b -> GValue -> Text -> Node -> m Bool
scriptableParseCustomNode a
scriptable b
script GValue
value Text
name Node
node = IO Bool -> m Bool
forall a. IO a -> m a
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 Scriptable
scriptable' <- a -> IO (Ptr Scriptable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
scriptable
    Ptr Script
script' <- b -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
script
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    CInt
result <- Ptr Scriptable
-> Ptr Script -> Ptr GValue -> CString -> Ptr Node -> IO CInt
clutter_scriptable_parse_custom_node Ptr Scriptable
scriptable' Ptr Script
script' Ptr GValue
value' CString
name' Ptr Node
node'
    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
scriptable
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
script
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ScriptableParseCustomNodeMethodInfo
instance (signature ~ (b -> GValue -> T.Text -> Json.Node.Node -> m Bool), MonadIO m, IsScriptable a, Clutter.Script.IsScript b) => O.OverloadedMethod ScriptableParseCustomNodeMethodInfo a signature where
    overloadedMethod = scriptableParseCustomNode

instance O.OverloadedMethodInfo ScriptableParseCustomNodeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Scriptable.scriptableParseCustomNode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Interfaces-Scriptable.html#v:scriptableParseCustomNode"
        })


#endif

-- method Scriptable::set_custom_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "scriptable"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Scriptable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScriptable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #ClutterScript creating the scriptable instance"
--                 , 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
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_scriptable_set_custom_property" clutter_scriptable_set_custom_property :: 
    Ptr Scriptable ->                       -- scriptable : TInterface (Name {namespace = "Clutter", name = "Scriptable"})
    Ptr Clutter.Script.Script ->            -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Overrides the common properties setting. The underlying virtual
-- function should be used when implementing custom properties.
-- 
-- /Since: 0.6/
scriptableSetCustomProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsScriptable a, Clutter.Script.IsScript b) =>
    a
    -- ^ /@scriptable@/: a t'GI.Clutter.Interfaces.Scriptable.Scriptable'
    -> b
    -- ^ /@script@/: the t'GI.Clutter.Objects.Script.Script' creating the scriptable instance
    -> T.Text
    -- ^ /@name@/: the name of the property
    -> GValue
    -- ^ /@value@/: the value of the property
    -> m ()
scriptableSetCustomProperty :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsScriptable a, IsScript b) =>
a -> b -> Text -> GValue -> m ()
scriptableSetCustomProperty a
scriptable b
script Text
name GValue
value = 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
$ do
    Ptr Scriptable
scriptable' <- a -> IO (Ptr Scriptable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
scriptable
    Ptr Script
script' <- b -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
script
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Scriptable -> Ptr Script -> CString -> Ptr GValue -> IO ()
clutter_scriptable_set_custom_property Ptr Scriptable
scriptable' Ptr Script
script' CString
name' Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
scriptable
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
script
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScriptableSetCustomPropertyMethodInfo
instance (signature ~ (b -> T.Text -> GValue -> m ()), MonadIO m, IsScriptable a, Clutter.Script.IsScript b) => O.OverloadedMethod ScriptableSetCustomPropertyMethodInfo a signature where
    overloadedMethod = scriptableSetCustomProperty

instance O.OverloadedMethodInfo ScriptableSetCustomPropertyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Scriptable.scriptableSetCustomProperty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Interfaces-Scriptable.html#v:scriptableSetCustomProperty"
        })


#endif

-- method Scriptable::set_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "scriptable"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Scriptable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScriptable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "id_"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #ClutterScript id of the object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_scriptable_set_id" clutter_scriptable_set_id :: 
    Ptr Scriptable ->                       -- scriptable : TInterface (Name {namespace = "Clutter", name = "Scriptable"})
    CString ->                              -- id_ : TBasicType TUTF8
    IO ()

-- | Sets /@id_@/ as the unique Clutter script it for this instance of
-- t'GI.Clutter.Structs.ScriptableIface.ScriptableIface'.
-- 
-- This name can be used by user interface designer applications to
-- define a unique name for an object constructable using the UI
-- definition language parsed by t'GI.Clutter.Objects.Script.Script'.
-- 
-- /Since: 0.6/
scriptableSetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsScriptable a) =>
    a
    -- ^ /@scriptable@/: a t'GI.Clutter.Interfaces.Scriptable.Scriptable'
    -> T.Text
    -- ^ /@id_@/: the t'GI.Clutter.Objects.Script.Script' id of the object
    -> m ()
scriptableSetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScriptable a) =>
a -> Text -> m ()
scriptableSetId a
scriptable Text
id_ = 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
$ do
    Ptr Scriptable
scriptable' <- a -> IO (Ptr Scriptable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
scriptable
    CString
id_' <- Text -> IO CString
textToCString Text
id_
    Ptr Scriptable -> CString -> IO ()
clutter_scriptable_set_id Ptr Scriptable
scriptable' CString
id_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
scriptable
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
id_'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScriptableSetIdMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsScriptable a) => O.OverloadedMethod ScriptableSetIdMethodInfo a signature where
    overloadedMethod = scriptableSetId

instance O.OverloadedMethodInfo ScriptableSetIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Interfaces.Scriptable.scriptableSetId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Interfaces-Scriptable.html#v:scriptableSetId"
        })


#endif

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

#endif