{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Clutter.Objects.Script.Script' structure contains only private data
-- and should be accessed using the provided API
-- 
-- /Since: 0.6/

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

module GI.Clutter.Objects.Script
    ( 

-- * Exported types
    Script(..)                              ,
    IsScript                                ,
    toScript                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addSearchPaths]("GI.Clutter.Objects.Script#g:method:addSearchPaths"), [addStates]("GI.Clutter.Objects.Script#g:method:addStates"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [connectSignals]("GI.Clutter.Objects.Script#g:method:connectSignals"), [connectSignalsFull]("GI.Clutter.Objects.Script#g:method:connectSignalsFull"), [ensureObjects]("GI.Clutter.Objects.Script#g:method:ensureObjects"), [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"), [listObjects]("GI.Clutter.Objects.Script#g:method:listObjects"), [loadFromData]("GI.Clutter.Objects.Script#g:method:loadFromData"), [loadFromFile]("GI.Clutter.Objects.Script#g:method:loadFromFile"), [loadFromResource]("GI.Clutter.Objects.Script#g:method:loadFromResource"), [lookupFilename]("GI.Clutter.Objects.Script#g:method:lookupFilename"), [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"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unmergeObjects]("GI.Clutter.Objects.Script#g:method:unmergeObjects"), [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"), [getObject]("GI.Clutter.Objects.Script#g:method:getObject"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getStates]("GI.Clutter.Objects.Script#g:method:getStates"), [getTranslationDomain]("GI.Clutter.Objects.Script#g:method:getTranslationDomain"), [getTypeFromName]("GI.Clutter.Objects.Script#g:method:getTypeFromName").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTranslationDomain]("GI.Clutter.Objects.Script#g:method:setTranslationDomain").

#if defined(ENABLE_OVERLOADING)
    ResolveScriptMethod                     ,
#endif

-- ** addSearchPaths #method:addSearchPaths#

#if defined(ENABLE_OVERLOADING)
    ScriptAddSearchPathsMethodInfo          ,
#endif
    scriptAddSearchPaths                    ,


-- ** addStates #method:addStates#

#if defined(ENABLE_OVERLOADING)
    ScriptAddStatesMethodInfo               ,
#endif
    scriptAddStates                         ,


-- ** connectSignals #method:connectSignals#

#if defined(ENABLE_OVERLOADING)
    ScriptConnectSignalsMethodInfo          ,
#endif
    scriptConnectSignals                    ,


-- ** connectSignalsFull #method:connectSignalsFull#

#if defined(ENABLE_OVERLOADING)
    ScriptConnectSignalsFullMethodInfo      ,
#endif
    scriptConnectSignalsFull                ,


-- ** ensureObjects #method:ensureObjects#

#if defined(ENABLE_OVERLOADING)
    ScriptEnsureObjectsMethodInfo           ,
#endif
    scriptEnsureObjects                     ,


-- ** getObject #method:getObject#

#if defined(ENABLE_OVERLOADING)
    ScriptGetObjectMethodInfo               ,
#endif
    scriptGetObject                         ,


-- ** getStates #method:getStates#

#if defined(ENABLE_OVERLOADING)
    ScriptGetStatesMethodInfo               ,
#endif
    scriptGetStates                         ,


-- ** getTranslationDomain #method:getTranslationDomain#

#if defined(ENABLE_OVERLOADING)
    ScriptGetTranslationDomainMethodInfo    ,
#endif
    scriptGetTranslationDomain              ,


-- ** getTypeFromName #method:getTypeFromName#

#if defined(ENABLE_OVERLOADING)
    ScriptGetTypeFromNameMethodInfo         ,
#endif
    scriptGetTypeFromName                   ,


-- ** listObjects #method:listObjects#

#if defined(ENABLE_OVERLOADING)
    ScriptListObjectsMethodInfo             ,
#endif
    scriptListObjects                       ,


-- ** loadFromData #method:loadFromData#

#if defined(ENABLE_OVERLOADING)
    ScriptLoadFromDataMethodInfo            ,
#endif
    scriptLoadFromData                      ,


-- ** loadFromFile #method:loadFromFile#

#if defined(ENABLE_OVERLOADING)
    ScriptLoadFromFileMethodInfo            ,
#endif
    scriptLoadFromFile                      ,


-- ** loadFromResource #method:loadFromResource#

#if defined(ENABLE_OVERLOADING)
    ScriptLoadFromResourceMethodInfo        ,
#endif
    scriptLoadFromResource                  ,


-- ** lookupFilename #method:lookupFilename#

#if defined(ENABLE_OVERLOADING)
    ScriptLookupFilenameMethodInfo          ,
#endif
    scriptLookupFilename                    ,


-- ** new #method:new#

    scriptNew                               ,


-- ** setTranslationDomain #method:setTranslationDomain#

#if defined(ENABLE_OVERLOADING)
    ScriptSetTranslationDomainMethodInfo    ,
#endif
    scriptSetTranslationDomain              ,


-- ** unmergeObjects #method:unmergeObjects#

#if defined(ENABLE_OVERLOADING)
    ScriptUnmergeObjectsMethodInfo          ,
#endif
    scriptUnmergeObjects                    ,




 -- * Properties


-- ** filename #attr:filename#
-- | The path of the currently parsed file. If [Script:filenameSet]("GI.Clutter.Objects.Script#g:attr:filenameSet")
-- is 'P.False' then the value of this property is undefined.
-- 
-- /Since: 0.6/

#if defined(ENABLE_OVERLOADING)
    ScriptFilenamePropertyInfo              ,
#endif
    getScriptFilename                       ,
#if defined(ENABLE_OVERLOADING)
    scriptFilename                          ,
#endif


-- ** filenameSet #attr:filenameSet#
-- | Whether the [Script:filename]("GI.Clutter.Objects.Script#g:attr:filename") property is set. If this property
-- is 'P.True' then the currently parsed data comes from a file, and the
-- file name is stored inside the [Script:filename]("GI.Clutter.Objects.Script#g:attr:filename") property.
-- 
-- /Since: 0.6/

#if defined(ENABLE_OVERLOADING)
    ScriptFilenameSetPropertyInfo           ,
#endif
    getScriptFilenameSet                    ,
#if defined(ENABLE_OVERLOADING)
    scriptFilenameSet                       ,
#endif


-- ** translationDomain #attr:translationDomain#
-- | The translation domain, used to localize strings marked as translatable
-- inside a UI definition.
-- 
-- If [Script:translationDomain]("GI.Clutter.Objects.Script#g:attr:translationDomain") is set to 'P.Nothing', t'GI.Clutter.Objects.Script.Script'
-- will use @/gettext()/@, otherwise 'GI.GLib.Functions.dgettext' will be used.
-- 
-- /Since: 1.10/

#if defined(ENABLE_OVERLOADING)
    ScriptTranslationDomainPropertyInfo     ,
#endif
    clearScriptTranslationDomain            ,
    constructScriptTranslationDomain        ,
    getScriptTranslationDomain              ,
#if defined(ENABLE_OVERLOADING)
    scriptTranslationDomain                 ,
#endif
    setScriptTranslationDomain              ,




    ) 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 qualified GI.Clutter.Callbacks as Clutter.Callbacks
import {-# SOURCE #-} qualified GI.Clutter.Objects.State as Clutter.State
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_script_get_type"
    c_clutter_script_get_type :: IO B.Types.GType

instance B.Types.TypedObject Script where
    glibType :: IO GType
glibType = IO GType
c_clutter_script_get_type

instance B.Types.GObject Script

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveScriptMethod (t :: Symbol) (o :: *) :: * where
    ResolveScriptMethod "addSearchPaths" o = ScriptAddSearchPathsMethodInfo
    ResolveScriptMethod "addStates" o = ScriptAddStatesMethodInfo
    ResolveScriptMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveScriptMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveScriptMethod "connectSignals" o = ScriptConnectSignalsMethodInfo
    ResolveScriptMethod "connectSignalsFull" o = ScriptConnectSignalsFullMethodInfo
    ResolveScriptMethod "ensureObjects" o = ScriptEnsureObjectsMethodInfo
    ResolveScriptMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveScriptMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveScriptMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveScriptMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveScriptMethod "listObjects" o = ScriptListObjectsMethodInfo
    ResolveScriptMethod "loadFromData" o = ScriptLoadFromDataMethodInfo
    ResolveScriptMethod "loadFromFile" o = ScriptLoadFromFileMethodInfo
    ResolveScriptMethod "loadFromResource" o = ScriptLoadFromResourceMethodInfo
    ResolveScriptMethod "lookupFilename" o = ScriptLookupFilenameMethodInfo
    ResolveScriptMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveScriptMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveScriptMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveScriptMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveScriptMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveScriptMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveScriptMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveScriptMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveScriptMethod "unmergeObjects" o = ScriptUnmergeObjectsMethodInfo
    ResolveScriptMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveScriptMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveScriptMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveScriptMethod "getObject" o = ScriptGetObjectMethodInfo
    ResolveScriptMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveScriptMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveScriptMethod "getStates" o = ScriptGetStatesMethodInfo
    ResolveScriptMethod "getTranslationDomain" o = ScriptGetTranslationDomainMethodInfo
    ResolveScriptMethod "getTypeFromName" o = ScriptGetTypeFromNameMethodInfo
    ResolveScriptMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveScriptMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveScriptMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveScriptMethod "setTranslationDomain" o = ScriptSetTranslationDomainMethodInfo
    ResolveScriptMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "filename"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@filename@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' script #filename
-- @
getScriptFilename :: (MonadIO m, IsScript o) => o -> m (Maybe T.Text)
getScriptFilename :: forall (m :: * -> *) o.
(MonadIO m, IsScript o) =>
o -> m (Maybe Text)
getScriptFilename o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"filename"

#if defined(ENABLE_OVERLOADING)
data ScriptFilenamePropertyInfo
instance AttrInfo ScriptFilenamePropertyInfo where
    type AttrAllowedOps ScriptFilenamePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ScriptFilenamePropertyInfo = IsScript
    type AttrSetTypeConstraint ScriptFilenamePropertyInfo = (~) ()
    type AttrTransferTypeConstraint ScriptFilenamePropertyInfo = (~) ()
    type AttrTransferType ScriptFilenamePropertyInfo = ()
    type AttrGetType ScriptFilenamePropertyInfo = (Maybe T.Text)
    type AttrLabel ScriptFilenamePropertyInfo = "filename"
    type AttrOrigin ScriptFilenamePropertyInfo = Script
    attrGet = getScriptFilename
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Script.filename"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Script.html#g:attr:filename"
        })
#endif

-- VVV Prop "filename-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@filename-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' script #filenameSet
-- @
getScriptFilenameSet :: (MonadIO m, IsScript o) => o -> m Bool
getScriptFilenameSet :: forall (m :: * -> *) o. (MonadIO m, IsScript o) => o -> m Bool
getScriptFilenameSet o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"filename-set"

#if defined(ENABLE_OVERLOADING)
data ScriptFilenameSetPropertyInfo
instance AttrInfo ScriptFilenameSetPropertyInfo where
    type AttrAllowedOps ScriptFilenameSetPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ScriptFilenameSetPropertyInfo = IsScript
    type AttrSetTypeConstraint ScriptFilenameSetPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ScriptFilenameSetPropertyInfo = (~) ()
    type AttrTransferType ScriptFilenameSetPropertyInfo = ()
    type AttrGetType ScriptFilenameSetPropertyInfo = Bool
    type AttrLabel ScriptFilenameSetPropertyInfo = "filename-set"
    type AttrOrigin ScriptFilenameSetPropertyInfo = Script
    attrGet = getScriptFilenameSet
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Script.filenameSet"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Script.html#g:attr:filenameSet"
        })
#endif

-- VVV Prop "translation-domain"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just True)

-- | Get the value of the “@translation-domain@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' script #translationDomain
-- @
getScriptTranslationDomain :: (MonadIO m, IsScript o) => o -> m T.Text
getScriptTranslationDomain :: forall (m :: * -> *) o. (MonadIO m, IsScript o) => o -> m Text
getScriptTranslationDomain o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getScriptTranslationDomain" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"translation-domain"

-- | Set the value of the “@translation-domain@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' script [ #translationDomain 'Data.GI.Base.Attributes.:=' value ]
-- @
setScriptTranslationDomain :: (MonadIO m, IsScript o) => o -> T.Text -> m ()
setScriptTranslationDomain :: forall (m :: * -> *) o.
(MonadIO m, IsScript o) =>
o -> Text -> m ()
setScriptTranslationDomain o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"translation-domain" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@translation-domain@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructScriptTranslationDomain :: (IsScript o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructScriptTranslationDomain :: forall o (m :: * -> *).
(IsScript o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructScriptTranslationDomain Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"translation-domain" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@translation-domain@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #translationDomain
-- @
clearScriptTranslationDomain :: (MonadIO m, IsScript o) => o -> m ()
clearScriptTranslationDomain :: forall (m :: * -> *) o. (MonadIO m, IsScript o) => o -> m ()
clearScriptTranslationDomain o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"translation-domain" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data ScriptTranslationDomainPropertyInfo
instance AttrInfo ScriptTranslationDomainPropertyInfo where
    type AttrAllowedOps ScriptTranslationDomainPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ScriptTranslationDomainPropertyInfo = IsScript
    type AttrSetTypeConstraint ScriptTranslationDomainPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ScriptTranslationDomainPropertyInfo = (~) T.Text
    type AttrTransferType ScriptTranslationDomainPropertyInfo = T.Text
    type AttrGetType ScriptTranslationDomainPropertyInfo = T.Text
    type AttrLabel ScriptTranslationDomainPropertyInfo = "translation-domain"
    type AttrOrigin ScriptTranslationDomainPropertyInfo = Script
    attrGet = getScriptTranslationDomain
    attrSet = setScriptTranslationDomain
    attrTransfer _ v = do
        return v
    attrConstruct = constructScriptTranslationDomain
    attrClear = clearScriptTranslationDomain
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Script.translationDomain"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Script.html#g:attr:translationDomain"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Script
type instance O.AttributeList Script = ScriptAttributeList
type ScriptAttributeList = ('[ '("filename", ScriptFilenamePropertyInfo), '("filenameSet", ScriptFilenameSetPropertyInfo), '("translationDomain", ScriptTranslationDomainPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
scriptFilename :: AttrLabelProxy "filename"
scriptFilename = AttrLabelProxy

scriptFilenameSet :: AttrLabelProxy "filenameSet"
scriptFilenameSet = AttrLabelProxy

scriptTranslationDomain :: AttrLabelProxy "translationDomain"
scriptTranslationDomain = AttrLabelProxy

#endif

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

#endif

-- method Script::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Script" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_script_new" clutter_script_new :: 
    IO (Ptr Script)

-- | Creates a new t'GI.Clutter.Objects.Script.Script' instance. t'GI.Clutter.Objects.Script.Script' can be used
-- to load objects definitions for scenegraph elements, like actors,
-- or behavioural elements, like behaviours and timelines. The
-- definitions must be encoded using the JavaScript Object Notation (JSON)
-- language.
-- 
-- /Since: 0.6/
scriptNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Script
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.Script.Script' instance. Use
    --   'GI.GObject.Objects.Object.objectUnref' when done.
scriptNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Script
scriptNew  = IO Script -> m Script
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Script -> m Script) -> IO Script -> m Script
forall a b. (a -> b) -> a -> b
$ do
    Ptr Script
result <- IO (Ptr Script)
clutter_script_new
    Text -> Ptr Script -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"scriptNew" Ptr Script
result
    Script
result' <- ((ManagedPtr Script -> Script) -> Ptr Script -> IO Script
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Script -> Script
Script) Ptr Script
result
    Script -> IO Script
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Script
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Script::add_search_paths
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "paths"
--           , argType = TCArray False (-1) 2 (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "an array of strings containing\n  different search paths"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_paths"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of the passed array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_paths"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of the passed array"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_script_add_search_paths" clutter_script_add_search_paths :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    Ptr CString ->                          -- paths : TCArray False (-1) 2 (TBasicType TUTF8)
    Word64 ->                               -- n_paths : TBasicType TUInt64
    IO ()

-- | Adds /@paths@/ to the list of search paths held by /@script@/.
-- 
-- The search paths are used by 'GI.Clutter.Objects.Script.scriptLookupFilename', which
-- can be used to define search paths for the textures source file name
-- or other custom, file-based properties.
-- 
-- /Since: 0.8/
scriptAddSearchPaths ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> [T.Text]
    -- ^ /@paths@/: an array of strings containing
    --   different search paths
    -> m ()
scriptAddSearchPaths :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> [Text] -> m ()
scriptAddSearchPaths a
script [Text]
paths = 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
    let nPaths :: Word64
nPaths = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Text]
paths
    Ptr Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr (Ptr CChar)
paths' <- [Text] -> IO (Ptr (Ptr CChar))
packUTF8CArray [Text]
paths
    Ptr Script -> Ptr (Ptr CChar) -> Word64 -> IO ()
clutter_script_add_search_paths Ptr Script
script' Ptr (Ptr CChar)
paths' Word64
nPaths
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    (Word64 -> (Ptr CChar -> IO ()) -> Ptr (Ptr CChar) -> IO ()
forall a b c.
(Storable a, Integral b) =>
b -> (a -> IO c) -> Ptr a -> IO ()
mapCArrayWithLength Word64
nPaths) Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
paths'
    Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
paths'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScriptAddSearchPathsMethodInfo
instance (signature ~ ([T.Text] -> m ()), MonadIO m, IsScript a) => O.OverloadedMethod ScriptAddSearchPathsMethodInfo a signature where
    overloadedMethod = scriptAddSearchPaths

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


#endif

-- method Script::add_states
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a name for the @state, or %NULL to\n  set the default #ClutterState"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "State" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterState" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_script_add_states" clutter_script_add_states :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr Clutter.State.State ->              -- state : TInterface (Name {namespace = "Clutter", name = "State"})
    IO ()

{-# DEPRECATED scriptAddStates ["(Since version 1.12)"] #-}
-- | Associates a t'GI.Clutter.Objects.State.State' to the t'GI.Clutter.Objects.Script.Script' instance using the given
-- name.
-- 
-- The t'GI.Clutter.Objects.Script.Script' instance will use /@state@/ to resolve target states when
-- connecting signal handlers.
-- 
-- The t'GI.Clutter.Objects.Script.Script' instance will take a reference on the t'GI.Clutter.Objects.State.State'
-- passed to this function.
-- 
-- /Since: 1.8/
scriptAddStates ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a, Clutter.State.IsState b) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> Maybe (T.Text)
    -- ^ /@name@/: a name for the /@state@/, or 'P.Nothing' to
    --   set the default t'GI.Clutter.Objects.State.State'
    -> b
    -- ^ /@state@/: a t'GI.Clutter.Objects.State.State'
    -> m ()
scriptAddStates :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsScript a, IsState b) =>
a -> Maybe Text -> b -> m ()
scriptAddStates a
script Maybe Text
name b
state = 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 Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr CChar
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jName -> do
            Ptr CChar
jName' <- Text -> IO (Ptr CChar)
textToCString Text
jName
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jName'
    Ptr State
state' <- b -> IO (Ptr State)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
state
    Ptr Script -> Ptr CChar -> Ptr State -> IO ()
clutter_script_add_states Ptr Script
script' Ptr CChar
maybeName Ptr State
state'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
state
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeName
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScriptAddStatesMethodInfo
instance (signature ~ (Maybe (T.Text) -> b -> m ()), MonadIO m, IsScript a, Clutter.State.IsState b) => O.OverloadedMethod ScriptAddStatesMethodInfo a signature where
    overloadedMethod = scriptAddStates

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


#endif

-- method Script::connect_signals
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "data to be passed to the signal handlers, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_script_connect_signals" clutter_script_connect_signals :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Connects all the signals defined into a UI definition file to their
-- handlers.
-- 
-- This method invokes 'GI.Clutter.Objects.Script.scriptConnectSignalsFull' internally
-- and uses  @/GModule/@\'s introspective features (by opening the current
-- module\'s scope) to look at the application\'s symbol table.
-- 
-- Note that this function will not work if @/GModule/@ is not supported by
-- the platform Clutter is running on.
-- 
-- /Since: 0.6/
scriptConnectSignals ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> Ptr ()
    -- ^ /@userData@/: data to be passed to the signal handlers, or 'P.Nothing'
    -> m ()
scriptConnectSignals :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> Ptr () -> m ()
scriptConnectSignals a
script Ptr ()
userData = 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 Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr Script -> Ptr () -> IO ()
clutter_script_connect_signals Ptr Script
script' Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScriptConnectSignalsMethodInfo
instance (signature ~ (Ptr () -> m ()), MonadIO m, IsScript a) => O.OverloadedMethod ScriptConnectSignalsMethodInfo a signature where
    overloadedMethod = scriptConnectSignals

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


#endif

-- method Script::connect_signals_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface
--                 Name { namespace = "Clutter" , name = "ScriptConnectFunc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "signal connection function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "data to be passed to the signal handlers, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_script_connect_signals_full" clutter_script_connect_signals_full :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    FunPtr Clutter.Callbacks.C_ScriptConnectFunc -> -- func : TInterface (Name {namespace = "Clutter", name = "ScriptConnectFunc"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Connects all the signals defined into a UI definition file to their
-- handlers.
-- 
-- This function allows to control how the signal handlers are
-- going to be connected to their respective signals. It is meant
-- primarily for language bindings to allow resolving the function
-- names using the native API, but it can also be used on platforms
-- that do not support GModule.
-- 
-- Applications should use 'GI.Clutter.Objects.Script.scriptConnectSignals'.
-- 
-- /Since: 0.6/
scriptConnectSignalsFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> Clutter.Callbacks.ScriptConnectFunc
    -- ^ /@func@/: signal connection function
    -> m ()
scriptConnectSignalsFull :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> ScriptConnectFunc -> m ()
scriptConnectSignalsFull a
script ScriptConnectFunc
func = 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 Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    FunPtr C_ScriptConnectFunc
func' <- C_ScriptConnectFunc -> IO (FunPtr C_ScriptConnectFunc)
Clutter.Callbacks.mk_ScriptConnectFunc (Maybe (Ptr (FunPtr C_ScriptConnectFunc))
-> ScriptConnectFunc_WithClosures -> C_ScriptConnectFunc
Clutter.Callbacks.wrap_ScriptConnectFunc Maybe (Ptr (FunPtr C_ScriptConnectFunc))
forall a. Maybe a
Nothing (ScriptConnectFunc -> ScriptConnectFunc_WithClosures
Clutter.Callbacks.drop_closures_ScriptConnectFunc ScriptConnectFunc
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Script -> FunPtr C_ScriptConnectFunc -> Ptr () -> IO ()
clutter_script_connect_signals_full Ptr Script
script' FunPtr C_ScriptConnectFunc
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_ScriptConnectFunc -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ScriptConnectFunc
func'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScriptConnectSignalsFullMethodInfo
instance (signature ~ (Clutter.Callbacks.ScriptConnectFunc -> m ()), MonadIO m, IsScript a) => O.OverloadedMethod ScriptConnectSignalsFullMethodInfo a signature where
    overloadedMethod = scriptConnectSignalsFull

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


#endif

-- method Script::ensure_objects
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_script_ensure_objects" clutter_script_ensure_objects :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    IO ()

-- | Ensure that every object defined inside /@script@/ is correctly
-- constructed. You should rarely need to use this function.
-- 
-- /Since: 0.6/
scriptEnsureObjects ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> m ()
scriptEnsureObjects :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> m ()
scriptEnsureObjects a
script = 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 Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr Script -> IO ()
clutter_script_ensure_objects Ptr Script
script'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScriptEnsureObjectsMethodInfo
instance (signature ~ (m ()), MonadIO m, IsScript a) => O.OverloadedMethod ScriptEnsureObjectsMethodInfo a signature where
    overloadedMethod = scriptEnsureObjects

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


#endif

-- method Script::get_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , 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 object to retrieve"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GObject" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_script_get_object" clutter_script_get_object :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GObject.Object.Object)

-- | Retrieves the object bound to /@name@/. This function does not increment
-- the reference count of the returned object.
-- 
-- /Since: 0.6/
scriptGetObject ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> T.Text
    -- ^ /@name@/: the name of the object to retrieve
    -> m GObject.Object.Object
    -- ^ __Returns:__ the named object, or 'P.Nothing' if no object
    --   with the given name was available
scriptGetObject :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> Text -> m Object
scriptGetObject a
script Text
name = IO Object -> m Object
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
    Ptr Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr CChar
name' <- Text -> IO (Ptr CChar)
textToCString Text
name
    Ptr Object
result <- Ptr Script -> Ptr CChar -> IO (Ptr Object)
clutter_script_get_object Ptr Script
script' Ptr CChar
name'
    Text -> Ptr Object -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"scriptGetObject" Ptr Object
result
    Object
result' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
name'
    Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result'

#if defined(ENABLE_OVERLOADING)
data ScriptGetObjectMethodInfo
instance (signature ~ (T.Text -> m GObject.Object.Object), MonadIO m, IsScript a) => O.OverloadedMethod ScriptGetObjectMethodInfo a signature where
    overloadedMethod = scriptGetObject

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


#endif

-- method Script::get_states
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the #ClutterState, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "State" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_script_get_states" clutter_script_get_states :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Clutter.State.State)

{-# DEPRECATED scriptGetStates ["(Since version 1.12)"] #-}
-- | Retrieves the t'GI.Clutter.Objects.State.State' for the given /@stateName@/.
-- 
-- If /@name@/ is 'P.Nothing', this function will return the default
-- t'GI.Clutter.Objects.State.State' instance.
-- 
-- /Since: 1.8/
scriptGetStates ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> Maybe (T.Text)
    -- ^ /@name@/: the name of the t'GI.Clutter.Objects.State.State', or 'P.Nothing'
    -> m Clutter.State.State
    -- ^ __Returns:__ a pointer to the t'GI.Clutter.Objects.State.State' for the
    --   given name. The t'GI.Clutter.Objects.State.State' is owned by the t'GI.Clutter.Objects.Script.Script' instance
    --   and it should not be unreferenced
scriptGetStates :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> Maybe Text -> m State
scriptGetStates a
script Maybe Text
name = IO State -> m State
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO State -> m State) -> IO State -> m State
forall a b. (a -> b) -> a -> b
$ do
    Ptr Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr CChar
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jName -> do
            Ptr CChar
jName' <- Text -> IO (Ptr CChar)
textToCString Text
jName
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jName'
    Ptr State
result <- Ptr Script -> Ptr CChar -> IO (Ptr State)
clutter_script_get_states Ptr Script
script' Ptr CChar
maybeName
    Text -> Ptr State -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"scriptGetStates" Ptr State
result
    State
result' <- ((ManagedPtr State -> State) -> Ptr State -> IO State
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr State -> State
Clutter.State.State) Ptr State
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeName
    State -> IO State
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return State
result'

#if defined(ENABLE_OVERLOADING)
data ScriptGetStatesMethodInfo
instance (signature ~ (Maybe (T.Text) -> m Clutter.State.State), MonadIO m, IsScript a) => O.OverloadedMethod ScriptGetStatesMethodInfo a signature where
    overloadedMethod = scriptGetStates

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


#endif

-- method Script::get_translation_domain
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , 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_script_get_translation_domain" clutter_script_get_translation_domain :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    IO CString

-- | Retrieves the translation domain set using
-- 'GI.Clutter.Objects.Script.scriptSetTranslationDomain'.
-- 
-- /Since: 1.10/
scriptGetTranslationDomain ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> m T.Text
    -- ^ __Returns:__ the translation domain, if any is set,
    --   or 'P.Nothing'
scriptGetTranslationDomain :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> m Text
scriptGetTranslationDomain a
script = 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 Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr CChar
result <- Ptr Script -> IO (Ptr CChar)
clutter_script_get_translation_domain Ptr Script
script'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"scriptGetTranslationDomain" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ScriptGetTranslationDomainMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsScript a) => O.OverloadedMethod ScriptGetTranslationDomainMethodInfo a signature where
    overloadedMethod = scriptGetTranslationDomain

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


#endif

-- method Script::get_type_from_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the type to look up"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_script_get_type_from_name" clutter_script_get_type_from_name :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    CString ->                              -- type_name : TBasicType TUTF8
    IO CGType

-- | Looks up a type by name, using the virtual function that
-- t'GI.Clutter.Objects.Script.Script' has for that purpose. This function should
-- rarely be used.
-- 
-- /Since: 0.6/
scriptGetTypeFromName ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> T.Text
    -- ^ /@typeName@/: name of the type to look up
    -> m GType
    -- ^ __Returns:__ the type for the requested type name, or
    --   @/G_TYPE_INVALID/@ if not corresponding type was found.
scriptGetTypeFromName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> Text -> m GType
scriptGetTypeFromName a
script Text
typeName = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr CChar
typeName' <- Text -> IO (Ptr CChar)
textToCString Text
typeName
    Word64
result <- Ptr Script -> Ptr CChar -> IO Word64
clutter_script_get_type_from_name Ptr Script
script' Ptr CChar
typeName'
    let result' :: GType
result' = Word64 -> GType
GType Word64
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
typeName'
    GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data ScriptGetTypeFromNameMethodInfo
instance (signature ~ (T.Text -> m GType), MonadIO m, IsScript a) => O.OverloadedMethod ScriptGetTypeFromNameMethodInfo a signature where
    overloadedMethod = scriptGetTypeFromName

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


#endif

-- method Script::list_objects
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface Name { namespace = "GObject" , name = "Object" }))
-- throws : False
-- Skip return : False

foreign import ccall "clutter_script_list_objects" clutter_script_list_objects :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    IO (Ptr (GList (Ptr GObject.Object.Object)))

-- | Retrieves all the objects created by /@script@/.
-- 
-- Note: this function does not increment the reference count of the
-- objects it returns.
-- 
-- /Since: 0.8/
scriptListObjects ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> m [GObject.Object.Object]
    -- ^ __Returns:__ a list
    --   of t'GI.GObject.Objects.Object.Object's, or 'P.Nothing'. The objects are owned by the
    --   t'GI.Clutter.Objects.Script.Script' instance. Use @/g_list_free()/@ on the returned list when
    --   done.
scriptListObjects :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> m [Object]
scriptListObjects a
script = IO [Object] -> m [Object]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Object] -> m [Object]) -> IO [Object] -> m [Object]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr (GList (Ptr Object))
result <- Ptr Script -> IO (Ptr (GList (Ptr Object)))
clutter_script_list_objects Ptr Script
script'
    [Ptr Object]
result' <- Ptr (GList (Ptr Object)) -> IO [Ptr Object]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Object))
result
    [Object]
result'' <- (Ptr Object -> IO Object) -> [Ptr Object] -> IO [Object]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) [Ptr Object]
result'
    Ptr (GList (Ptr Object)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Object))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    [Object] -> IO [Object]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Object]
result''

#if defined(ENABLE_OVERLOADING)
data ScriptListObjectsMethodInfo
instance (signature ~ (m [GObject.Object.Object]), MonadIO m, IsScript a) => O.OverloadedMethod ScriptListObjectsMethodInfo a signature where
    overloadedMethod = scriptListObjects

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


#endif

-- method Script::load_from_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a buffer containing the definitions"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the length of the buffer, or -1 if @data is a NUL-terminated\n  buffer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : True
-- Skip return : False

foreign import ccall "clutter_script_load_from_data" clutter_script_load_from_data :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    CString ->                              -- data : TBasicType TUTF8
    Int64 ->                                -- length : TBasicType TInt64
    Ptr (Ptr GError) ->                     -- error
    IO Word32

-- | Loads the definitions from /@data@/ into /@script@/ and merges with
-- the currently loaded ones, if any.
-- 
-- /Since: 0.6/
scriptLoadFromData ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> T.Text
    -- ^ /@data@/: a buffer containing the definitions
    -> Int64
    -- ^ /@length@/: the length of the buffer, or -1 if /@data@/ is a NUL-terminated
    --   buffer
    -> m Word32
    -- ^ __Returns:__ on error, zero is returned and /@error@/ is set
    --   accordingly. On success, the merge id for the UI definitions is
    --   returned. You can use the merge id with 'GI.Clutter.Objects.Script.scriptUnmergeObjects'. /(Can throw 'Data.GI.Base.GError.GError')/
scriptLoadFromData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> Text -> Int64 -> m Word32
scriptLoadFromData a
script Text
data_ Int64
length_ = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr CChar
data_' <- Text -> IO (Ptr CChar)
textToCString Text
data_
    IO Word32 -> IO () -> IO Word32
forall a b. IO a -> IO b -> IO a
onException (do
        Word32
result <- (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Word32) -> IO Word32)
-> (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ Ptr Script -> Ptr CChar -> Int64 -> Ptr (Ptr GError) -> IO Word32
clutter_script_load_from_data Ptr Script
script' Ptr CChar
data_' Int64
length_
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
data_'
        Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
data_'
     )

#if defined(ENABLE_OVERLOADING)
data ScriptLoadFromDataMethodInfo
instance (signature ~ (T.Text -> Int64 -> m Word32), MonadIO m, IsScript a) => O.OverloadedMethod ScriptLoadFromDataMethodInfo a signature where
    overloadedMethod = scriptLoadFromData

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


#endif

-- method Script::load_from_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the full path to the definition file"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : True
-- Skip return : False

foreign import ccall "clutter_script_load_from_file" clutter_script_load_from_file :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    CString ->                              -- filename : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO Word32

-- | Loads the definitions from /@filename@/ into /@script@/ and merges with
-- the currently loaded ones, if any.
-- 
-- /Since: 0.6/
scriptLoadFromFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> T.Text
    -- ^ /@filename@/: the full path to the definition file
    -> m Word32
    -- ^ __Returns:__ on error, zero is returned and /@error@/ is set
    --   accordingly. On success, the merge id for the UI definitions is
    --   returned. You can use the merge id with 'GI.Clutter.Objects.Script.scriptUnmergeObjects'. /(Can throw 'Data.GI.Base.GError.GError')/
scriptLoadFromFile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> Text -> m Word32
scriptLoadFromFile a
script Text
filename = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr CChar
filename' <- Text -> IO (Ptr CChar)
textToCString Text
filename
    IO Word32 -> IO () -> IO Word32
forall a b. IO a -> IO b -> IO a
onException (do
        Word32
result <- (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Word32) -> IO Word32)
-> (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ Ptr Script -> Ptr CChar -> Ptr (Ptr GError) -> IO Word32
clutter_script_load_from_file Ptr Script
script' Ptr CChar
filename'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
filename'
        Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
filename'
     )

#if defined(ENABLE_OVERLOADING)
data ScriptLoadFromFileMethodInfo
instance (signature ~ (T.Text -> m Word32), MonadIO m, IsScript a) => O.OverloadedMethod ScriptLoadFromFileMethodInfo a signature where
    overloadedMethod = scriptLoadFromFile

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


#endif

-- method Script::load_from_resource
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "resource_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the resource path of the file to parse"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : True
-- Skip return : False

foreign import ccall "clutter_script_load_from_resource" clutter_script_load_from_resource :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    CString ->                              -- resource_path : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO Word32

-- | Loads the definitions from a resource file into /@script@/ and merges with
-- the currently loaded ones, if any.
-- 
-- /Since: 1.10/
scriptLoadFromResource ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> T.Text
    -- ^ /@resourcePath@/: the resource path of the file to parse
    -> m Word32
    -- ^ __Returns:__ on error, zero is returned and /@error@/ is set
    --   accordingly. On success, the merge id for the UI definitions is
    --   returned. You can use the merge id with 'GI.Clutter.Objects.Script.scriptUnmergeObjects'. /(Can throw 'Data.GI.Base.GError.GError')/
scriptLoadFromResource :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> Text -> m Word32
scriptLoadFromResource a
script Text
resourcePath = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr CChar
resourcePath' <- Text -> IO (Ptr CChar)
textToCString Text
resourcePath
    IO Word32 -> IO () -> IO Word32
forall a b. IO a -> IO b -> IO a
onException (do
        Word32
result <- (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Word32) -> IO Word32)
-> (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ Ptr Script -> Ptr CChar -> Ptr (Ptr GError) -> IO Word32
clutter_script_load_from_resource Ptr Script
script' Ptr CChar
resourcePath'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
resourcePath'
        Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
resourcePath'
     )

#if defined(ENABLE_OVERLOADING)
data ScriptLoadFromResourceMethodInfo
instance (signature ~ (T.Text -> m Word32), MonadIO m, IsScript a) => O.OverloadedMethod ScriptLoadFromResourceMethodInfo a signature where
    overloadedMethod = scriptLoadFromResource

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


#endif

-- method Script::lookup_filename
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the file to lookup"
--                 , 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_script_lookup_filename" clutter_script_lookup_filename :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    CString ->                              -- filename : TBasicType TUTF8
    IO CString

-- | Looks up /@filename@/ inside the search paths of /@script@/. If /@filename@/
-- is found, its full path will be returned .
-- 
-- /Since: 0.8/
scriptLookupFilename ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> T.Text
    -- ^ /@filename@/: the name of the file to lookup
    -> m T.Text
    -- ^ __Returns:__ the full path of /@filename@/ or 'P.Nothing' if no path was
    --   found.
scriptLookupFilename :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> Text -> m Text
scriptLookupFilename a
script Text
filename = 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 Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr CChar
filename' <- Text -> IO (Ptr CChar)
textToCString Text
filename
    Ptr CChar
result <- Ptr Script -> Ptr CChar -> IO (Ptr CChar)
clutter_script_lookup_filename Ptr Script
script' Ptr CChar
filename'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"scriptLookupFilename" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
filename'
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

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


#endif

-- method Script::set_translation_domain
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "domain"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the translation domain, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_script_set_translation_domain" clutter_script_set_translation_domain :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    CString ->                              -- domain : TBasicType TUTF8
    IO ()

-- | Sets the translation domain for /@script@/.
-- 
-- /Since: 1.10/
scriptSetTranslationDomain ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> Maybe (T.Text)
    -- ^ /@domain@/: the translation domain, or 'P.Nothing'
    -> m ()
scriptSetTranslationDomain :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> Maybe Text -> m ()
scriptSetTranslationDomain a
script Maybe Text
domain = 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 Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr CChar
maybeDomain <- case Maybe Text
domain of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jDomain -> do
            Ptr CChar
jDomain' <- Text -> IO (Ptr CChar)
textToCString Text
jDomain
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jDomain'
    Ptr Script -> Ptr CChar -> IO ()
clutter_script_set_translation_domain Ptr Script
script' Ptr CChar
maybeDomain
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeDomain
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScriptSetTranslationDomainMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsScript a) => O.OverloadedMethod ScriptSetTranslationDomainMethodInfo a signature where
    overloadedMethod = scriptSetTranslationDomain

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


#endif

-- method Script::unmerge_objects
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "script"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Script" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterScript" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "merge_id"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "merge id returned when loading a UI definition"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_script_unmerge_objects" clutter_script_unmerge_objects :: 
    Ptr Script ->                           -- script : TInterface (Name {namespace = "Clutter", name = "Script"})
    Word32 ->                               -- merge_id : TBasicType TUInt
    IO ()

-- | Unmerges the objects identified by /@mergeId@/.
-- 
-- /Since: 0.6/
scriptUnmergeObjects ::
    (B.CallStack.HasCallStack, MonadIO m, IsScript a) =>
    a
    -- ^ /@script@/: a t'GI.Clutter.Objects.Script.Script'
    -> Word32
    -- ^ /@mergeId@/: merge id returned when loading a UI definition
    -> m ()
scriptUnmergeObjects :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsScript a) =>
a -> Word32 -> m ()
scriptUnmergeObjects a
script Word32
mergeId = 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 Script
script' <- a -> IO (Ptr Script)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
script
    Ptr Script -> Word32 -> IO ()
clutter_script_unmerge_objects Ptr Script
script' Word32
mergeId
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
script
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ScriptUnmergeObjectsMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsScript a) => O.OverloadedMethod ScriptUnmergeObjectsMethodInfo a signature where
    overloadedMethod = scriptUnmergeObjects

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


#endif