{-# 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.Path.Path' struct contains only private data and should
-- be accessed with the functions below.
-- 
-- /Since: 1.0/

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

module GI.Clutter.Objects.Path
    ( 

-- * Exported types
    Path(..)                                ,
    IsPath                                  ,
    toPath                                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addCairoPath]("GI.Clutter.Objects.Path#g:method:addCairoPath"), [addClose]("GI.Clutter.Objects.Path#g:method:addClose"), [addCurveTo]("GI.Clutter.Objects.Path#g:method:addCurveTo"), [addLineTo]("GI.Clutter.Objects.Path#g:method:addLineTo"), [addMoveTo]("GI.Clutter.Objects.Path#g:method:addMoveTo"), [addNode]("GI.Clutter.Objects.Path#g:method:addNode"), [addRelCurveTo]("GI.Clutter.Objects.Path#g:method:addRelCurveTo"), [addRelLineTo]("GI.Clutter.Objects.Path#g:method:addRelLineTo"), [addRelMoveTo]("GI.Clutter.Objects.Path#g:method:addRelMoveTo"), [addString]("GI.Clutter.Objects.Path#g:method:addString"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [clear]("GI.Clutter.Objects.Path#g:method:clear"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [foreach]("GI.Clutter.Objects.Path#g:method:foreach"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [insertNode]("GI.Clutter.Objects.Path#g:method:insertNode"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [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"), [removeNode]("GI.Clutter.Objects.Path#g:method:removeNode"), [replaceNode]("GI.Clutter.Objects.Path#g:method:replaceNode"), [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"), [toCairoPath]("GI.Clutter.Objects.Path#g:method:toCairoPath"), [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"), [getDescription]("GI.Clutter.Objects.Path#g:method:getDescription"), [getLength]("GI.Clutter.Objects.Path#g:method:getLength"), [getNNodes]("GI.Clutter.Objects.Path#g:method:getNNodes"), [getNode]("GI.Clutter.Objects.Path#g:method:getNode"), [getNodes]("GI.Clutter.Objects.Path#g:method:getNodes"), [getPosition]("GI.Clutter.Objects.Path#g:method:getPosition"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDescription]("GI.Clutter.Objects.Path#g:method:setDescription"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolvePathMethod                       ,
#endif

-- ** addCairoPath #method:addCairoPath#

#if defined(ENABLE_OVERLOADING)
    PathAddCairoPathMethodInfo              ,
#endif
    pathAddCairoPath                        ,


-- ** addClose #method:addClose#

#if defined(ENABLE_OVERLOADING)
    PathAddCloseMethodInfo                  ,
#endif
    pathAddClose                            ,


-- ** addCurveTo #method:addCurveTo#

#if defined(ENABLE_OVERLOADING)
    PathAddCurveToMethodInfo                ,
#endif
    pathAddCurveTo                          ,


-- ** addLineTo #method:addLineTo#

#if defined(ENABLE_OVERLOADING)
    PathAddLineToMethodInfo                 ,
#endif
    pathAddLineTo                           ,


-- ** addMoveTo #method:addMoveTo#

#if defined(ENABLE_OVERLOADING)
    PathAddMoveToMethodInfo                 ,
#endif
    pathAddMoveTo                           ,


-- ** addNode #method:addNode#

#if defined(ENABLE_OVERLOADING)
    PathAddNodeMethodInfo                   ,
#endif
    pathAddNode                             ,


-- ** addRelCurveTo #method:addRelCurveTo#

#if defined(ENABLE_OVERLOADING)
    PathAddRelCurveToMethodInfo             ,
#endif
    pathAddRelCurveTo                       ,


-- ** addRelLineTo #method:addRelLineTo#

#if defined(ENABLE_OVERLOADING)
    PathAddRelLineToMethodInfo              ,
#endif
    pathAddRelLineTo                        ,


-- ** addRelMoveTo #method:addRelMoveTo#

#if defined(ENABLE_OVERLOADING)
    PathAddRelMoveToMethodInfo              ,
#endif
    pathAddRelMoveTo                        ,


-- ** addString #method:addString#

#if defined(ENABLE_OVERLOADING)
    PathAddStringMethodInfo                 ,
#endif
    pathAddString                           ,


-- ** clear #method:clear#

#if defined(ENABLE_OVERLOADING)
    PathClearMethodInfo                     ,
#endif
    pathClear                               ,


-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    PathForeachMethodInfo                   ,
#endif
    pathForeach                             ,


-- ** getDescription #method:getDescription#

#if defined(ENABLE_OVERLOADING)
    PathGetDescriptionMethodInfo            ,
#endif
    pathGetDescription                      ,


-- ** getLength #method:getLength#

#if defined(ENABLE_OVERLOADING)
    PathGetLengthMethodInfo                 ,
#endif
    pathGetLength                           ,


-- ** getNNodes #method:getNNodes#

#if defined(ENABLE_OVERLOADING)
    PathGetNNodesMethodInfo                 ,
#endif
    pathGetNNodes                           ,


-- ** getNode #method:getNode#

#if defined(ENABLE_OVERLOADING)
    PathGetNodeMethodInfo                   ,
#endif
    pathGetNode                             ,


-- ** getNodes #method:getNodes#

#if defined(ENABLE_OVERLOADING)
    PathGetNodesMethodInfo                  ,
#endif
    pathGetNodes                            ,


-- ** getPosition #method:getPosition#

#if defined(ENABLE_OVERLOADING)
    PathGetPositionMethodInfo               ,
#endif
    pathGetPosition                         ,


-- ** insertNode #method:insertNode#

#if defined(ENABLE_OVERLOADING)
    PathInsertNodeMethodInfo                ,
#endif
    pathInsertNode                          ,


-- ** new #method:new#

    pathNew                                 ,


-- ** newWithDescription #method:newWithDescription#

    pathNewWithDescription                  ,


-- ** removeNode #method:removeNode#

#if defined(ENABLE_OVERLOADING)
    PathRemoveNodeMethodInfo                ,
#endif
    pathRemoveNode                          ,


-- ** replaceNode #method:replaceNode#

#if defined(ENABLE_OVERLOADING)
    PathReplaceNodeMethodInfo               ,
#endif
    pathReplaceNode                         ,


-- ** setDescription #method:setDescription#

#if defined(ENABLE_OVERLOADING)
    PathSetDescriptionMethodInfo            ,
#endif
    pathSetDescription                      ,


-- ** toCairoPath #method:toCairoPath#

#if defined(ENABLE_OVERLOADING)
    PathToCairoPathMethodInfo               ,
#endif
    pathToCairoPath                         ,




 -- * Properties


-- ** description #attr:description#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    PathDescriptionPropertyInfo             ,
#endif
    clearPathDescription                    ,
    constructPathDescription                ,
    getPathDescription                      ,
#if defined(ENABLE_OVERLOADING)
    pathDescription                         ,
#endif
    setPathDescription                      ,


-- ** length #attr:length#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    PathLengthPropertyInfo                  ,
#endif
    getPathLength                           ,
#if defined(ENABLE_OVERLOADING)
    pathLength                              ,
#endif




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.Path as Cairo.Path
import qualified GI.Clutter.Callbacks as Clutter.Callbacks
import {-# SOURCE #-} qualified GI.Clutter.Structs.Knot as Clutter.Knot
import {-# SOURCE #-} qualified GI.Clutter.Structs.PathNode as Clutter.PathNode
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_path_get_type"
    c_clutter_path_get_type :: IO B.Types.GType

instance B.Types.TypedObject Path where
    glibType :: IO GType
glibType = IO GType
c_clutter_path_get_type

instance B.Types.GObject Path

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolvePathMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePathMethod "addCairoPath" o = PathAddCairoPathMethodInfo
    ResolvePathMethod "addClose" o = PathAddCloseMethodInfo
    ResolvePathMethod "addCurveTo" o = PathAddCurveToMethodInfo
    ResolvePathMethod "addLineTo" o = PathAddLineToMethodInfo
    ResolvePathMethod "addMoveTo" o = PathAddMoveToMethodInfo
    ResolvePathMethod "addNode" o = PathAddNodeMethodInfo
    ResolvePathMethod "addRelCurveTo" o = PathAddRelCurveToMethodInfo
    ResolvePathMethod "addRelLineTo" o = PathAddRelLineToMethodInfo
    ResolvePathMethod "addRelMoveTo" o = PathAddRelMoveToMethodInfo
    ResolvePathMethod "addString" o = PathAddStringMethodInfo
    ResolvePathMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePathMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePathMethod "clear" o = PathClearMethodInfo
    ResolvePathMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePathMethod "foreach" o = PathForeachMethodInfo
    ResolvePathMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePathMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePathMethod "insertNode" o = PathInsertNodeMethodInfo
    ResolvePathMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePathMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePathMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePathMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePathMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePathMethod "removeNode" o = PathRemoveNodeMethodInfo
    ResolvePathMethod "replaceNode" o = PathReplaceNodeMethodInfo
    ResolvePathMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePathMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePathMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePathMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePathMethod "toCairoPath" o = PathToCairoPathMethodInfo
    ResolvePathMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePathMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePathMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePathMethod "getDescription" o = PathGetDescriptionMethodInfo
    ResolvePathMethod "getLength" o = PathGetLengthMethodInfo
    ResolvePathMethod "getNNodes" o = PathGetNNodesMethodInfo
    ResolvePathMethod "getNode" o = PathGetNodeMethodInfo
    ResolvePathMethod "getNodes" o = PathGetNodesMethodInfo
    ResolvePathMethod "getPosition" o = PathGetPositionMethodInfo
    ResolvePathMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePathMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePathMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePathMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePathMethod "setDescription" o = PathSetDescriptionMethodInfo
    ResolvePathMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePathMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

-- | Get the value of the “@description@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' path #description
-- @
getPathDescription :: (MonadIO m, IsPath o) => o -> m (Maybe T.Text)
getPathDescription :: forall (m :: * -> *) o.
(MonadIO m, IsPath o) =>
o -> m (Maybe Text)
getPathDescription 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
"description"

-- | Set the value of the “@description@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' path [ #description 'Data.GI.Base.Attributes.:=' value ]
-- @
setPathDescription :: (MonadIO m, IsPath o) => o -> T.Text -> m ()
setPathDescription :: forall (m :: * -> *) o. (MonadIO m, IsPath o) => o -> Text -> m ()
setPathDescription 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
"description" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@description@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPathDescription :: (IsPath o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructPathDescription :: forall o (m :: * -> *).
(IsPath o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructPathDescription 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
"description" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@description@” 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' #description
-- @
clearPathDescription :: (MonadIO m, IsPath o) => o -> m ()
clearPathDescription :: forall (m :: * -> *) o. (MonadIO m, IsPath o) => o -> m ()
clearPathDescription 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
"description" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data PathDescriptionPropertyInfo
instance AttrInfo PathDescriptionPropertyInfo where
    type AttrAllowedOps PathDescriptionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint PathDescriptionPropertyInfo = IsPath
    type AttrSetTypeConstraint PathDescriptionPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint PathDescriptionPropertyInfo = (~) T.Text
    type AttrTransferType PathDescriptionPropertyInfo = T.Text
    type AttrGetType PathDescriptionPropertyInfo = (Maybe T.Text)
    type AttrLabel PathDescriptionPropertyInfo = "description"
    type AttrOrigin PathDescriptionPropertyInfo = Path
    attrGet = getPathDescription
    attrSet = setPathDescription
    attrTransfer _ v = do
        return v
    attrConstruct = constructPathDescription
    attrClear = clearPathDescription
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Path.description"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-Path.html#g:attr:description"
        })
#endif

-- VVV Prop "length"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data PathLengthPropertyInfo
instance AttrInfo PathLengthPropertyInfo where
    type AttrAllowedOps PathLengthPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint PathLengthPropertyInfo = IsPath
    type AttrSetTypeConstraint PathLengthPropertyInfo = (~) ()
    type AttrTransferTypeConstraint PathLengthPropertyInfo = (~) ()
    type AttrTransferType PathLengthPropertyInfo = ()
    type AttrGetType PathLengthPropertyInfo = Word32
    type AttrLabel PathLengthPropertyInfo = "length"
    type AttrOrigin PathLengthPropertyInfo = Path
    attrGet = getPathLength
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Path.length"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.5/docs/GI-Clutter-Objects-Path.html#g:attr:length"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Path
type instance O.AttributeList Path = PathAttributeList
type PathAttributeList = ('[ '("description", PathDescriptionPropertyInfo), '("length", PathLengthPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
pathDescription :: AttrLabelProxy "description"
pathDescription = AttrLabelProxy

pathLength :: AttrLabelProxy "length"
pathLength = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Path = PathSignalList
type PathSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

foreign import ccall "clutter_path_new" clutter_path_new :: 
    IO (Ptr Path)

-- | Creates a new t'GI.Clutter.Objects.Path.Path' instance with no nodes.
-- 
-- The object has a floating reference so if you add it to a
-- t'GI.Clutter.Objects.BehaviourPath.BehaviourPath' then you do not need to unref it.
-- 
-- /Since: 1.0/
pathNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Path
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.Path.Path'
pathNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Path
pathNew  = IO Path -> m Path
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Path -> m Path) -> IO Path -> m Path
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
result <- IO (Ptr Path)
clutter_path_new
    Text -> Ptr Path -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pathNew" Ptr Path
result
    Path
result' <- ((ManagedPtr Path -> Path) -> Ptr Path -> IO Path
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Path -> Path
Path) Ptr Path
result
    Path -> IO Path
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Path
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Path::new_with_description
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "desc"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string describing the path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Path" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_new_with_description" clutter_path_new_with_description :: 
    CString ->                              -- desc : TBasicType TUTF8
    IO (Ptr Path)

-- | Creates a new t'GI.Clutter.Objects.Path.Path' instance with the nodes described in
-- /@desc@/. See 'GI.Clutter.Objects.Path.pathAddString' for details of the format of
-- the string.
-- 
-- The object has a floating reference so if you add it to a
-- t'GI.Clutter.Objects.BehaviourPath.BehaviourPath' then you do not need to unref it.
-- 
-- /Since: 1.0/
pathNewWithDescription ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@desc@/: a string describing the path
    -> m Path
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.Path.Path'
pathNewWithDescription :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m Path
pathNewWithDescription Text
desc = IO Path -> m Path
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Path -> m Path) -> IO Path -> m Path
forall a b. (a -> b) -> a -> b
$ do
    CString
desc' <- Text -> IO CString
textToCString Text
desc
    Ptr Path
result <- CString -> IO (Ptr Path)
clutter_path_new_with_description CString
desc'
    Text -> Ptr Path -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pathNewWithDescription" Ptr Path
result
    Path
result' <- ((ManagedPtr Path -> Path) -> Ptr Path -> IO Path
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Path -> Path
Path) Ptr Path
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
desc'
    Path -> IO Path
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Path
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "clutter_path_add_cairo_path" clutter_path_add_cairo_path :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    Ptr Cairo.Path.Path ->                  -- cpath : TInterface (Name {namespace = "cairo", name = "Path"})
    IO ()

-- | Add the nodes of the Cairo path to the end of /@path@/.
-- 
-- /Since: 1.0/
pathAddCairoPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Cairo.Path.Path
    -- ^ /@cpath@/: a Cairo path
    -> m ()
pathAddCairoPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Path -> m ()
pathAddCairoPath a
path Path
cpath = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr Path
cpath' <- Path -> IO (Ptr Path)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Path
cpath
    Ptr Path -> Ptr Path -> IO ()
clutter_path_add_cairo_path Ptr Path
path' Ptr Path
cpath'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    Path -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Path
cpath
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathAddCairoPathMethodInfo
instance (signature ~ (Cairo.Path.Path -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathAddCairoPathMethodInfo a signature where
    overloadedMethod = pathAddCairoPath

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


#endif

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

foreign import ccall "clutter_path_add_close" clutter_path_add_close :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    IO ()

-- | Adds a 'GI.Clutter.Enums.PathNodeTypeClose' type node to the path. This creates a
-- straight line from the last node to the last 'GI.Clutter.Enums.PathNodeTypeMoveTo'
-- type node.
-- 
-- /Since: 1.0/
pathAddClose ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> m ()
pathAddClose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> m ()
pathAddClose a
path = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr Path -> IO ()
clutter_path_add_close Ptr Path
path'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathAddCloseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathAddCloseMethodInfo a signature where
    overloadedMethod = pathAddClose

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


#endif

-- method Path::add_curve_to
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_1"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x coordinate of the first control point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_1"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y coordinate of the first control point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_2"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x coordinate of the second control point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_2"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y coordinate of the second control point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_3"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x coordinate of the third control point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_3"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y coordinate of the third control point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_add_curve_to" clutter_path_add_curve_to :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    Int32 ->                                -- x_1 : TBasicType TInt
    Int32 ->                                -- y_1 : TBasicType TInt
    Int32 ->                                -- x_2 : TBasicType TInt
    Int32 ->                                -- y_2 : TBasicType TInt
    Int32 ->                                -- x_3 : TBasicType TInt
    Int32 ->                                -- y_3 : TBasicType TInt
    IO ()

-- | Adds a 'GI.Clutter.Enums.PathNodeTypeCurveTo' type node to the path. This causes
-- the actor to follow a bezier from the last node to (/@x3@/, /@y3@/) using
-- (/@x1@/, /@y1@/) and (/@x2@/,/@y2@/) as control points.
-- 
-- /Since: 1.0/
pathAddCurveTo ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Int32
    -- ^ /@x1@/: the x coordinate of the first control point
    -> Int32
    -- ^ /@y1@/: the y coordinate of the first control point
    -> Int32
    -- ^ /@x2@/: the x coordinate of the second control point
    -> Int32
    -- ^ /@y2@/: the y coordinate of the second control point
    -> Int32
    -- ^ /@x3@/: the x coordinate of the third control point
    -> Int32
    -- ^ /@y3@/: the y coordinate of the third control point
    -> m ()
pathAddCurveTo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> m ()
pathAddCurveTo a
path Int32
x1 Int32
y1 Int32
x2 Int32
y2 Int32
x3 Int32
y3 = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr Path
-> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO ()
clutter_path_add_curve_to Ptr Path
path' Int32
x1 Int32
y1 Int32
x2 Int32
y2 Int32
x3 Int32
y3
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathAddCurveToMethodInfo
instance (signature ~ (Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathAddCurveToMethodInfo a signature where
    overloadedMethod = pathAddCurveTo

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


#endif

-- method Path::add_line_to
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x coordinate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y coordinate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_add_line_to" clutter_path_add_line_to :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    IO ()

-- | Adds a 'GI.Clutter.Enums.PathNodeTypeLineTo' type node to the path. This causes the
-- actor to move to the new coordinates in a straight line.
-- 
-- /Since: 1.0/
pathAddLineTo ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Int32
    -- ^ /@x@/: the x coordinate
    -> Int32
    -- ^ /@y@/: the y coordinate
    -> m ()
pathAddLineTo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Int32 -> Int32 -> m ()
pathAddLineTo a
path Int32
x Int32
y = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr Path -> Int32 -> Int32 -> IO ()
clutter_path_add_line_to Ptr Path
path' Int32
x Int32
y
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathAddLineToMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathAddLineToMethodInfo a signature where
    overloadedMethod = pathAddLineTo

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


#endif

-- method Path::add_move_to
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x coordinate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y coordinate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_add_move_to" clutter_path_add_move_to :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    IO ()

-- | Adds a 'GI.Clutter.Enums.PathNodeTypeMoveTo' type node to the path. This is usually
-- used as the first node in a path. It can also be used in the middle
-- of the path to cause the actor to jump to the new coordinate.
-- 
-- /Since: 1.0/
pathAddMoveTo ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Int32
    -- ^ /@x@/: the x coordinate
    -> Int32
    -- ^ /@y@/: the y coordinate
    -> m ()
pathAddMoveTo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Int32 -> Int32 -> m ()
pathAddMoveTo a
path Int32
x Int32
y = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr Path -> Int32 -> Int32 -> IO ()
clutter_path_add_move_to Ptr Path
path' Int32
x Int32
y
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathAddMoveToMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathAddMoveToMethodInfo a signature where
    overloadedMethod = pathAddMoveTo

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


#endif

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

foreign import ccall "clutter_path_add_node" clutter_path_add_node :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    Ptr Clutter.PathNode.PathNode ->        -- node : TInterface (Name {namespace = "Clutter", name = "PathNode"})
    IO ()

-- | Adds /@node@/ to the end of the path.
-- 
-- /Since: 1.0/
pathAddNode ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Clutter.PathNode.PathNode
    -- ^ /@node@/: a t'GI.Clutter.Structs.PathNode.PathNode'
    -> m ()
pathAddNode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> PathNode -> m ()
pathAddNode a
path PathNode
node = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr PathNode
node' <- PathNode -> IO (Ptr PathNode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathNode
node
    Ptr Path -> Ptr PathNode -> IO ()
clutter_path_add_node Ptr Path
path' Ptr PathNode
node'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    PathNode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathNode
node
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathAddNodeMethodInfo
instance (signature ~ (Clutter.PathNode.PathNode -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathAddNodeMethodInfo a signature where
    overloadedMethod = pathAddNode

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


#endif

-- method Path::add_rel_curve_to
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_1"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x coordinate of the first control point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_1"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y coordinate of the first control point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_2"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x coordinate of the second control point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_2"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y coordinate of the second control point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_3"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x coordinate of the third control point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_3"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y coordinate of the third control point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_add_rel_curve_to" clutter_path_add_rel_curve_to :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    Int32 ->                                -- x_1 : TBasicType TInt
    Int32 ->                                -- y_1 : TBasicType TInt
    Int32 ->                                -- x_2 : TBasicType TInt
    Int32 ->                                -- y_2 : TBasicType TInt
    Int32 ->                                -- x_3 : TBasicType TInt
    Int32 ->                                -- y_3 : TBasicType TInt
    IO ()

-- | Same as 'GI.Clutter.Objects.Path.pathAddCurveTo' except the coordinates are
-- relative to the previous node.
-- 
-- /Since: 1.0/
pathAddRelCurveTo ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Int32
    -- ^ /@x1@/: the x coordinate of the first control point
    -> Int32
    -- ^ /@y1@/: the y coordinate of the first control point
    -> Int32
    -- ^ /@x2@/: the x coordinate of the second control point
    -> Int32
    -- ^ /@y2@/: the y coordinate of the second control point
    -> Int32
    -- ^ /@x3@/: the x coordinate of the third control point
    -> Int32
    -- ^ /@y3@/: the y coordinate of the third control point
    -> m ()
pathAddRelCurveTo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> m ()
pathAddRelCurveTo a
path Int32
x1 Int32
y1 Int32
x2 Int32
y2 Int32
x3 Int32
y3 = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr Path
-> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> IO ()
clutter_path_add_rel_curve_to Ptr Path
path' Int32
x1 Int32
y1 Int32
x2 Int32
y2 Int32
x3 Int32
y3
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathAddRelCurveToMethodInfo
instance (signature ~ (Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> Int32 -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathAddRelCurveToMethodInfo a signature where
    overloadedMethod = pathAddRelCurveTo

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


#endif

-- method Path::add_rel_line_to
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x coordinate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y coordinate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_add_rel_line_to" clutter_path_add_rel_line_to :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    IO ()

-- | Same as 'GI.Clutter.Objects.Path.pathAddLineTo' except the coordinates are
-- relative to the previous node.
-- 
-- /Since: 1.0/
pathAddRelLineTo ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Int32
    -- ^ /@x@/: the x coordinate
    -> Int32
    -- ^ /@y@/: the y coordinate
    -> m ()
pathAddRelLineTo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Int32 -> Int32 -> m ()
pathAddRelLineTo a
path Int32
x Int32
y = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr Path -> Int32 -> Int32 -> IO ()
clutter_path_add_rel_line_to Ptr Path
path' Int32
x Int32
y
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathAddRelLineToMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathAddRelLineToMethodInfo a signature where
    overloadedMethod = pathAddRelLineTo

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


#endif

-- method Path::add_rel_move_to
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x coordinate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y coordinate" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_add_rel_move_to" clutter_path_add_rel_move_to :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    IO ()

-- | Same as 'GI.Clutter.Objects.Path.pathAddMoveTo' except the coordinates are
-- relative to the previous node.
-- 
-- /Since: 1.0/
pathAddRelMoveTo ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Int32
    -- ^ /@x@/: the x coordinate
    -> Int32
    -- ^ /@y@/: the y coordinate
    -> m ()
pathAddRelMoveTo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Int32 -> Int32 -> m ()
pathAddRelMoveTo a
path Int32
x Int32
y = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr Path -> Int32 -> Int32 -> IO ()
clutter_path_add_rel_move_to Ptr Path
path' Int32
x Int32
y
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathAddRelMoveToMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathAddRelMoveToMethodInfo a signature where
    overloadedMethod = pathAddRelMoveTo

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


#endif

-- method Path::add_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string describing the new nodes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_add_string" clutter_path_add_string :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    CString ->                              -- str : TBasicType TUTF8
    IO CInt

-- | Adds new nodes to the end of the path as described in /@str@/. The
-- format is a subset of the SVG path format. Each node is represented
-- by a letter and is followed by zero, one or three pairs of
-- coordinates. The coordinates can be separated by spaces or a
-- comma. The types are:
-- 
--  - @M@: Adds a 'GI.Clutter.Enums.PathNodeTypeMoveTo' node. Takes one pair of coordinates.
--  - @L@: Adds a 'GI.Clutter.Enums.PathNodeTypeLineTo' node. Takes one pair of coordinates.
--  - @C@: Adds a 'GI.Clutter.Enums.PathNodeTypeCurveTo' node. Takes three pairs of coordinates.
--  - @z@: Adds a 'GI.Clutter.Enums.PathNodeTypeClose' node. No coordinates are needed.
-- 
-- The M, L and C commands can also be specified in lower case which
-- means the coordinates are relative to the previous node.
-- 
-- For example, to move an actor in a 100 by 100 pixel square centered
-- on the point 300,300 you could use the following path:
-- 
-- >
-- >  M 250,350 l 0 -100 L 350,250 l 0 100 z
-- 
-- 
-- If the path description isn\'t valid 'P.False' will be returned and no
-- nodes will be added.
-- 
-- /Since: 1.0/
pathAddString ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> T.Text
    -- ^ /@str@/: a string describing the new nodes
    -> m Bool
    -- ^ __Returns:__ 'P.True' is the path description was valid or 'P.False'
    -- otherwise.
pathAddString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Text -> m Bool
pathAddString a
path Text
str = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    CString
str' <- Text -> IO CString
textToCString Text
str
    CInt
result <- Ptr Path -> CString -> IO CInt
clutter_path_add_string Ptr Path
path' CString
str'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PathAddStringMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsPath a) => O.OverloadedMethod PathAddStringMethodInfo a signature where
    overloadedMethod = pathAddString

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


#endif

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

foreign import ccall "clutter_path_clear" clutter_path_clear :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    IO ()

-- | Removes all nodes from the path.
-- 
-- /Since: 1.0/
pathClear ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> m ()
pathClear :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> m ()
pathClear a
path = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr Path -> IO ()
clutter_path_clear Ptr Path
path'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathClearMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathClearMethodInfo a signature where
    overloadedMethod = pathClear

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


#endif

-- method Path::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PathCallback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function to call with each node"
--                 , 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 "user data to pass to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_foreach" clutter_path_foreach :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    FunPtr Clutter.Callbacks.C_PathCallback -> -- callback : TInterface (Name {namespace = "Clutter", name = "PathCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Calls a function for each node of the path.
-- 
-- /Since: 1.0/
pathForeach ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Clutter.Callbacks.PathCallback
    -- ^ /@callback@/: the function to call with each node
    -> m ()
pathForeach :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> (PathNode -> IO ()) -> m ()
pathForeach a
path PathNode -> IO ()
callback = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    FunPtr C_PathCallback
callback' <- C_PathCallback -> IO (FunPtr C_PathCallback)
Clutter.Callbacks.mk_PathCallback (Maybe (Ptr (FunPtr C_PathCallback))
-> PathCallback_WithClosures -> C_PathCallback
Clutter.Callbacks.wrap_PathCallback Maybe (Ptr (FunPtr C_PathCallback))
forall a. Maybe a
Nothing ((PathNode -> IO ()) -> PathCallback_WithClosures
Clutter.Callbacks.drop_closures_PathCallback PathNode -> IO ()
callback))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Path -> FunPtr C_PathCallback -> Ptr () -> IO ()
clutter_path_foreach Ptr Path
path' FunPtr C_PathCallback
callback' 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_PathCallback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_PathCallback
callback'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathForeachMethodInfo
instance (signature ~ (Clutter.Callbacks.PathCallback -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathForeachMethodInfo a signature where
    overloadedMethod = pathForeach

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


#endif

-- method Path::get_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , 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_path_get_description" clutter_path_get_description :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    IO CString

-- | Returns a newly allocated string describing the path in the same
-- format as used by 'GI.Clutter.Objects.Path.pathAddString'.
-- 
-- /Since: 1.0/
pathGetDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> m T.Text
    -- ^ __Returns:__ a string description of the path. Free with 'GI.GLib.Functions.free'.
pathGetDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> m Text
pathGetDescription a
path = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    CString
result <- Ptr Path -> IO CString
clutter_path_get_description Ptr Path
path'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pathGetDescription" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PathGetDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsPath a) => O.OverloadedMethod PathGetDescriptionMethodInfo a signature where
    overloadedMethod = pathGetDescription

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


#endif

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

foreign import ccall "clutter_path_get_length" clutter_path_get_length :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    IO Word32

-- | Retrieves an approximation of the total length of the path.
-- 
-- /Since: 1.0/
pathGetLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> m Word32
    -- ^ __Returns:__ the length of the path.
pathGetLength :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> m Word32
pathGetLength a
path = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Word32
result <- Ptr Path -> IO Word32
clutter_path_get_length Ptr Path
path'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data PathGetLengthMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsPath a) => O.OverloadedMethod PathGetLengthMethodInfo a signature where
    overloadedMethod = pathGetLength

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


#endif

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

foreign import ccall "clutter_path_get_n_nodes" clutter_path_get_n_nodes :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    IO Word32

-- | Retrieves the number of nodes in the path.
-- 
-- /Since: 1.0/
pathGetNNodes ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> m Word32
    -- ^ __Returns:__ the number of nodes.
pathGetNNodes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> m Word32
pathGetNNodes a
path = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Word32
result <- Ptr Path -> IO Word32
clutter_path_get_n_nodes Ptr Path
path'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data PathGetNNodesMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsPath a) => O.OverloadedMethod PathGetNNodesMethodInfo a signature where
    overloadedMethod = pathGetNNodes

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


#endif

-- method Path::get_node
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node number to retrieve"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PathNode" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to store a copy of the node"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_get_node" clutter_path_get_node :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    Word32 ->                               -- index_ : TBasicType TUInt
    Ptr Clutter.PathNode.PathNode ->        -- node : TInterface (Name {namespace = "Clutter", name = "PathNode"})
    IO ()

-- | Retrieves the node of the path indexed by /@index@/.
-- 
-- /Since: 1.0/
pathGetNode ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Word32
    -- ^ /@index_@/: the node number to retrieve
    -> m (Clutter.PathNode.PathNode)
pathGetNode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Word32 -> m PathNode
pathGetNode a
path Word32
index_ = IO PathNode -> m PathNode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PathNode -> m PathNode) -> IO PathNode -> m PathNode
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr PathNode
node <- Int -> IO (Ptr PathNode)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
28 :: IO (Ptr Clutter.PathNode.PathNode)
    Ptr Path -> Word32 -> Ptr PathNode -> IO ()
clutter_path_get_node Ptr Path
path' Word32
index_ Ptr PathNode
node
    PathNode
node' <- ((ManagedPtr PathNode -> PathNode) -> Ptr PathNode -> IO PathNode
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr PathNode -> PathNode
Clutter.PathNode.PathNode) Ptr PathNode
node
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    PathNode -> IO PathNode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PathNode
node'

#if defined(ENABLE_OVERLOADING)
data PathGetNodeMethodInfo
instance (signature ~ (Word32 -> m (Clutter.PathNode.PathNode)), MonadIO m, IsPath a) => O.OverloadedMethod PathGetNodeMethodInfo a signature where
    overloadedMethod = pathGetNode

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


#endif

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

foreign import ccall "clutter_path_get_nodes" clutter_path_get_nodes :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    IO (Ptr (GSList (Ptr Clutter.PathNode.PathNode)))

-- | Returns a t'GI.GLib.Structs.SList.SList' of t'GI.Clutter.Structs.PathNode.PathNode's. The list should be
-- freed with @/g_slist_free()/@. The nodes are owned by the path and
-- should not be freed. Altering the path may cause the nodes in the
-- list to become invalid so you should copy them if you want to keep
-- the list.
-- 
-- /Since: 1.0/
pathGetNodes ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> m [Clutter.PathNode.PathNode]
    -- ^ __Returns:__ a
    --   list of nodes in the path.
pathGetNodes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> m [PathNode]
pathGetNodes a
path = IO [PathNode] -> m [PathNode]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [PathNode] -> m [PathNode]) -> IO [PathNode] -> m [PathNode]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr (GSList (Ptr PathNode))
result <- Ptr Path -> IO (Ptr (GSList (Ptr PathNode)))
clutter_path_get_nodes Ptr Path
path'
    [Ptr PathNode]
result' <- Ptr (GSList (Ptr PathNode)) -> IO [Ptr PathNode]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr PathNode))
result
    [PathNode]
result'' <- (Ptr PathNode -> IO PathNode) -> [Ptr PathNode] -> IO [PathNode]
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 PathNode -> PathNode) -> Ptr PathNode -> IO PathNode
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr PathNode -> PathNode
Clutter.PathNode.PathNode) [Ptr PathNode]
result'
    Ptr (GSList (Ptr PathNode)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr PathNode))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    [PathNode] -> IO [PathNode]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [PathNode]
result''

#if defined(ENABLE_OVERLOADING)
data PathGetNodesMethodInfo
instance (signature ~ (m [Clutter.PathNode.PathNode]), MonadIO m, IsPath a) => O.OverloadedMethod PathGetNodesMethodInfo a signature where
    overloadedMethod = pathGetNodes

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


#endif

-- method Path::get_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a position along the path as a fraction of its length"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Knot" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the position"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_get_position" clutter_path_get_position :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    CDouble ->                              -- progress : TBasicType TDouble
    Ptr Clutter.Knot.Knot ->                -- position : TInterface (Name {namespace = "Clutter", name = "Knot"})
    IO Word32

-- | The value in /@progress@/ represents a position along the path where
-- 0.0 is the beginning and 1.0 is the end of the path. An
-- interpolated position is then stored in /@position@/.
-- 
-- /Since: 1.0/
pathGetPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Double
    -- ^ /@progress@/: a position along the path as a fraction of its length
    -> m ((Word32, Clutter.Knot.Knot))
    -- ^ __Returns:__ index of the node used to calculate the position.
pathGetPosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Double -> m (Word32, Knot)
pathGetPosition a
path Double
progress = IO (Word32, Knot) -> m (Word32, Knot)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word32, Knot) -> m (Word32, Knot))
-> IO (Word32, Knot) -> m (Word32, Knot)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    let progress' :: CDouble
progress' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
progress
    Ptr Knot
position <- Int -> IO (Ptr Knot)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
8 :: IO (Ptr Clutter.Knot.Knot)
    Word32
result <- Ptr Path -> CDouble -> Ptr Knot -> IO Word32
clutter_path_get_position Ptr Path
path' CDouble
progress' Ptr Knot
position
    Knot
position' <- ((ManagedPtr Knot -> Knot) -> Ptr Knot -> IO Knot
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Knot -> Knot
Clutter.Knot.Knot) Ptr Knot
position
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    (Word32, Knot) -> IO (Word32, Knot)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
result, Knot
position')

#if defined(ENABLE_OVERLOADING)
data PathGetPositionMethodInfo
instance (signature ~ (Double -> m ((Word32, Clutter.Knot.Knot))), MonadIO m, IsPath a) => O.OverloadedMethod PathGetPositionMethodInfo a signature where
    overloadedMethod = pathGetPosition

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


#endif

-- method Path::insert_node
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "offset of where to insert the node"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PathNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to insert" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_insert_node" clutter_path_insert_node :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    Int32 ->                                -- index_ : TBasicType TInt
    Ptr Clutter.PathNode.PathNode ->        -- node : TInterface (Name {namespace = "Clutter", name = "PathNode"})
    IO ()

-- | Inserts /@node@/ into the path before the node at the given offset. If
-- /@index_@/ is negative it will append the node to the end of the path.
-- 
-- /Since: 1.0/
pathInsertNode ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Int32
    -- ^ /@index_@/: offset of where to insert the node
    -> Clutter.PathNode.PathNode
    -- ^ /@node@/: the node to insert
    -> m ()
pathInsertNode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Int32 -> PathNode -> m ()
pathInsertNode a
path Int32
index_ PathNode
node = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr PathNode
node' <- PathNode -> IO (Ptr PathNode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathNode
node
    Ptr Path -> Int32 -> Ptr PathNode -> IO ()
clutter_path_insert_node Ptr Path
path' Int32
index_ Ptr PathNode
node'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    PathNode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathNode
node
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathInsertNodeMethodInfo
instance (signature ~ (Int32 -> Clutter.PathNode.PathNode -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathInsertNodeMethodInfo a signature where
    overloadedMethod = pathInsertNode

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


#endif

-- method Path::remove_node
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index of the node to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_remove_node" clutter_path_remove_node :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    Word32 ->                               -- index_ : TBasicType TUInt
    IO ()

-- | Removes the node at the given offset from the path.
-- 
-- /Since: 1.0/
pathRemoveNode ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Word32
    -- ^ /@index_@/: index of the node to remove
    -> m ()
pathRemoveNode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Word32 -> m ()
pathRemoveNode a
path Word32
index_ = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr Path -> Word32 -> IO ()
clutter_path_remove_node Ptr Path
path' Word32
index_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathRemoveNodeMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathRemoveNodeMethodInfo a signature where
    overloadedMethod = pathRemoveNode

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


#endif

-- method Path::replace_node
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "index to the existing node"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "node"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "PathNode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the replacement node"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_replace_node" clutter_path_replace_node :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    Word32 ->                               -- index_ : TBasicType TUInt
    Ptr Clutter.PathNode.PathNode ->        -- node : TInterface (Name {namespace = "Clutter", name = "PathNode"})
    IO ()

-- | Replaces the node at offset /@index_@/ with /@node@/.
-- 
-- /Since: 1.0/
pathReplaceNode ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Word32
    -- ^ /@index_@/: index to the existing node
    -> Clutter.PathNode.PathNode
    -- ^ /@node@/: the replacement node
    -> m ()
pathReplaceNode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Word32 -> PathNode -> m ()
pathReplaceNode a
path Word32
index_ PathNode
node = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr PathNode
node' <- PathNode -> IO (Ptr PathNode)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PathNode
node
    Ptr Path -> Word32 -> Ptr PathNode -> IO ()
clutter_path_replace_node Ptr Path
path' Word32
index_ Ptr PathNode
node'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    PathNode -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PathNode
node
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathReplaceNodeMethodInfo
instance (signature ~ (Word32 -> Clutter.PathNode.PathNode -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathReplaceNodeMethodInfo a signature where
    overloadedMethod = pathReplaceNode

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


#endif

-- method Path::set_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string describing the path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_set_description" clutter_path_set_description :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    CString ->                              -- str : TBasicType TUTF8
    IO CInt

-- | Replaces all of the nodes in the path with nodes described by
-- /@str@/. See 'GI.Clutter.Objects.Path.pathAddString' for details of the format.
-- 
-- If the string is invalid then 'P.False' is returned and the path is
-- unaltered.
-- 
-- /Since: 1.0/
pathSetDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> T.Text
    -- ^ /@str@/: a string describing the path
    -> m Bool
    -- ^ __Returns:__ 'P.True' is the path was valid, 'P.False' otherwise.
pathSetDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Text -> m Bool
pathSetDescription a
path Text
str = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    CString
str' <- Text -> IO CString
textToCString Text
str
    CInt
result <- Ptr Path -> CString -> IO CInt
clutter_path_set_description Ptr Path
path' CString
str'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PathSetDescriptionMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsPath a) => O.OverloadedMethod PathSetDescriptionMethodInfo a signature where
    overloadedMethod = pathSetDescription

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


#endif

-- method Path::to_cairo_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "path"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Path" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterPath" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cr"
--           , argType =
--               TInterface Name { namespace = "cairo" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a Cairo context" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_path_to_cairo_path" clutter_path_to_cairo_path :: 
    Ptr Path ->                             -- path : TInterface (Name {namespace = "Clutter", name = "Path"})
    Ptr Cairo.Context.Context ->            -- cr : TInterface (Name {namespace = "cairo", name = "Context"})
    IO ()

-- | Add the nodes of the ClutterPath to the path in the Cairo context.
-- 
-- /Since: 1.0/
pathToCairoPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsPath a) =>
    a
    -- ^ /@path@/: a t'GI.Clutter.Objects.Path.Path'
    -> Cairo.Context.Context
    -- ^ /@cr@/: a Cairo context
    -> m ()
pathToCairoPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPath a) =>
a -> Context -> m ()
pathToCairoPath a
path Context
cr = 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 Path
path' <- a -> IO (Ptr Path)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr Context
cr' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
cr
    Ptr Path -> Ptr Context -> IO ()
clutter_path_to_cairo_path Ptr Path
path' Ptr Context
cr'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
cr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PathToCairoPathMethodInfo
instance (signature ~ (Cairo.Context.Context -> m ()), MonadIO m, IsPath a) => O.OverloadedMethod PathToCairoPathMethodInfo a signature where
    overloadedMethod = pathToCairoPath

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


#endif