{-# LANGUAGE TypeApplications #-}


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

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

module GI.Clutter.Objects.SnapConstraint
    ( 

-- * Exported types
    SnapConstraint(..)                      ,
    IsSnapConstraint                        ,
    toSnapConstraint                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getActor]("GI.Clutter.Objects.ActorMeta#g:method:getActor"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getEdges]("GI.Clutter.Objects.SnapConstraint#g:method:getEdges"), [getEnabled]("GI.Clutter.Objects.ActorMeta#g:method:getEnabled"), [getName]("GI.Clutter.Objects.ActorMeta#g:method:getName"), [getOffset]("GI.Clutter.Objects.SnapConstraint#g:method:getOffset"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSource]("GI.Clutter.Objects.SnapConstraint#g:method:getSource").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setEdges]("GI.Clutter.Objects.SnapConstraint#g:method:setEdges"), [setEnabled]("GI.Clutter.Objects.ActorMeta#g:method:setEnabled"), [setName]("GI.Clutter.Objects.ActorMeta#g:method:setName"), [setOffset]("GI.Clutter.Objects.SnapConstraint#g:method:setOffset"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSource]("GI.Clutter.Objects.SnapConstraint#g:method:setSource").

#if defined(ENABLE_OVERLOADING)
    ResolveSnapConstraintMethod             ,
#endif

-- ** getEdges #method:getEdges#

#if defined(ENABLE_OVERLOADING)
    SnapConstraintGetEdgesMethodInfo        ,
#endif
    snapConstraintGetEdges                  ,


-- ** getOffset #method:getOffset#

#if defined(ENABLE_OVERLOADING)
    SnapConstraintGetOffsetMethodInfo       ,
#endif
    snapConstraintGetOffset                 ,


-- ** getSource #method:getSource#

#if defined(ENABLE_OVERLOADING)
    SnapConstraintGetSourceMethodInfo       ,
#endif
    snapConstraintGetSource                 ,


-- ** new #method:new#

    snapConstraintNew                       ,


-- ** setEdges #method:setEdges#

#if defined(ENABLE_OVERLOADING)
    SnapConstraintSetEdgesMethodInfo        ,
#endif
    snapConstraintSetEdges                  ,


-- ** setOffset #method:setOffset#

#if defined(ENABLE_OVERLOADING)
    SnapConstraintSetOffsetMethodInfo       ,
#endif
    snapConstraintSetOffset                 ,


-- ** setSource #method:setSource#

#if defined(ENABLE_OVERLOADING)
    SnapConstraintSetSourceMethodInfo       ,
#endif
    snapConstraintSetSource                 ,




 -- * Properties


-- ** fromEdge #attr:fromEdge#
-- | The edge of the t'GI.Clutter.Objects.Actor.Actor' that should be snapped
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    SnapConstraintFromEdgePropertyInfo      ,
#endif
    constructSnapConstraintFromEdge         ,
    getSnapConstraintFromEdge               ,
    setSnapConstraintFromEdge               ,
#if defined(ENABLE_OVERLOADING)
    snapConstraintFromEdge                  ,
#endif


-- ** offset #attr:offset#
-- | The offset, in pixels, between t'GI.Clutter.Objects.SnapConstraint.SnapConstraint':@/from-edge/@
-- and t'GI.Clutter.Objects.SnapConstraint.SnapConstraint':@/to-edge/@
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    SnapConstraintOffsetPropertyInfo        ,
#endif
    constructSnapConstraintOffset           ,
    getSnapConstraintOffset                 ,
    setSnapConstraintOffset                 ,
#if defined(ENABLE_OVERLOADING)
    snapConstraintOffset                    ,
#endif


-- ** source #attr:source#
-- | The t'GI.Clutter.Objects.Actor.Actor' used as the source for the constraint
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    SnapConstraintSourcePropertyInfo        ,
#endif
    clearSnapConstraintSource               ,
    constructSnapConstraintSource           ,
    getSnapConstraintSource                 ,
    setSnapConstraintSource                 ,
#if defined(ENABLE_OVERLOADING)
    snapConstraintSource                    ,
#endif


-- ** toEdge #attr:toEdge#
-- | The edge of the t'GI.Clutter.Objects.SnapConstraint.SnapConstraint':@/source/@ that should be snapped
-- 
-- /Since: 1.6/

#if defined(ENABLE_OVERLOADING)
    SnapConstraintToEdgePropertyInfo        ,
#endif
    constructSnapConstraintToEdge           ,
    getSnapConstraintToEdge                 ,
    setSnapConstraintToEdge                 ,
#if defined(ENABLE_OVERLOADING)
    snapConstraintToEdge                    ,
#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.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.Clutter.Enums as Clutter.Enums
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.ActorMeta as Clutter.ActorMeta
import {-# SOURCE #-} qualified GI.Clutter.Objects.Constraint as Clutter.Constraint
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_snap_constraint_get_type"
    c_clutter_snap_constraint_get_type :: IO B.Types.GType

instance B.Types.TypedObject SnapConstraint where
    glibType :: IO GType
glibType = IO GType
c_clutter_snap_constraint_get_type

instance B.Types.GObject SnapConstraint

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

instance O.HasParentTypes SnapConstraint
type instance O.ParentTypes SnapConstraint = '[Clutter.Constraint.Constraint, Clutter.ActorMeta.ActorMeta, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSnapConstraintMethod (t :: Symbol) (o :: *) :: * where
    ResolveSnapConstraintMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSnapConstraintMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSnapConstraintMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSnapConstraintMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSnapConstraintMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSnapConstraintMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSnapConstraintMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSnapConstraintMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSnapConstraintMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSnapConstraintMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSnapConstraintMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSnapConstraintMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSnapConstraintMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSnapConstraintMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSnapConstraintMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSnapConstraintMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSnapConstraintMethod "getActor" o = Clutter.ActorMeta.ActorMetaGetActorMethodInfo
    ResolveSnapConstraintMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSnapConstraintMethod "getEdges" o = SnapConstraintGetEdgesMethodInfo
    ResolveSnapConstraintMethod "getEnabled" o = Clutter.ActorMeta.ActorMetaGetEnabledMethodInfo
    ResolveSnapConstraintMethod "getName" o = Clutter.ActorMeta.ActorMetaGetNameMethodInfo
    ResolveSnapConstraintMethod "getOffset" o = SnapConstraintGetOffsetMethodInfo
    ResolveSnapConstraintMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSnapConstraintMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSnapConstraintMethod "getSource" o = SnapConstraintGetSourceMethodInfo
    ResolveSnapConstraintMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSnapConstraintMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSnapConstraintMethod "setEdges" o = SnapConstraintSetEdgesMethodInfo
    ResolveSnapConstraintMethod "setEnabled" o = Clutter.ActorMeta.ActorMetaSetEnabledMethodInfo
    ResolveSnapConstraintMethod "setName" o = Clutter.ActorMeta.ActorMetaSetNameMethodInfo
    ResolveSnapConstraintMethod "setOffset" o = SnapConstraintSetOffsetMethodInfo
    ResolveSnapConstraintMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSnapConstraintMethod "setSource" o = SnapConstraintSetSourceMethodInfo
    ResolveSnapConstraintMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "from-edge"
   -- Type: TInterface (Name {namespace = "Clutter", name = "SnapEdge"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@from-edge@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' snapConstraint #fromEdge
-- @
getSnapConstraintFromEdge :: (MonadIO m, IsSnapConstraint o) => o -> m Clutter.Enums.SnapEdge
getSnapConstraintFromEdge :: forall (m :: * -> *) o.
(MonadIO m, IsSnapConstraint o) =>
o -> m SnapEdge
getSnapConstraintFromEdge o
obj = IO SnapEdge -> m SnapEdge
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO SnapEdge -> m SnapEdge) -> IO SnapEdge -> m SnapEdge
forall a b. (a -> b) -> a -> b
$ o -> String -> IO SnapEdge
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"from-edge"

-- | Set the value of the “@from-edge@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' snapConstraint [ #fromEdge 'Data.GI.Base.Attributes.:=' value ]
-- @
setSnapConstraintFromEdge :: (MonadIO m, IsSnapConstraint o) => o -> Clutter.Enums.SnapEdge -> m ()
setSnapConstraintFromEdge :: forall (m :: * -> *) o.
(MonadIO m, IsSnapConstraint o) =>
o -> SnapEdge -> m ()
setSnapConstraintFromEdge o
obj SnapEdge
val = IO () -> m ()
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 -> SnapEdge -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"from-edge" SnapEdge
val

-- | Construct a `GValueConstruct` with valid value for the “@from-edge@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSnapConstraintFromEdge :: (IsSnapConstraint o, MIO.MonadIO m) => Clutter.Enums.SnapEdge -> m (GValueConstruct o)
constructSnapConstraintFromEdge :: forall o (m :: * -> *).
(IsSnapConstraint o, MonadIO m) =>
SnapEdge -> m (GValueConstruct o)
constructSnapConstraintFromEdge SnapEdge
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> SnapEdge -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"from-edge" SnapEdge
val

#if defined(ENABLE_OVERLOADING)
data SnapConstraintFromEdgePropertyInfo
instance AttrInfo SnapConstraintFromEdgePropertyInfo where
    type AttrAllowedOps SnapConstraintFromEdgePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SnapConstraintFromEdgePropertyInfo = IsSnapConstraint
    type AttrSetTypeConstraint SnapConstraintFromEdgePropertyInfo = (~) Clutter.Enums.SnapEdge
    type AttrTransferTypeConstraint SnapConstraintFromEdgePropertyInfo = (~) Clutter.Enums.SnapEdge
    type AttrTransferType SnapConstraintFromEdgePropertyInfo = Clutter.Enums.SnapEdge
    type AttrGetType SnapConstraintFromEdgePropertyInfo = Clutter.Enums.SnapEdge
    type AttrLabel SnapConstraintFromEdgePropertyInfo = "from-edge"
    type AttrOrigin SnapConstraintFromEdgePropertyInfo = SnapConstraint
    attrGet = getSnapConstraintFromEdge
    attrSet = setSnapConstraintFromEdge
    attrTransfer _ v = do
        return v
    attrConstruct = constructSnapConstraintFromEdge
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.SnapConstraint.fromEdge"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-SnapConstraint.html#g:attr:fromEdge"
        })
#endif

-- VVV Prop "offset"
   -- Type: TBasicType TFloat
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@offset@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' snapConstraint [ #offset 'Data.GI.Base.Attributes.:=' value ]
-- @
setSnapConstraintOffset :: (MonadIO m, IsSnapConstraint o) => o -> Float -> m ()
setSnapConstraintOffset :: forall (m :: * -> *) o.
(MonadIO m, IsSnapConstraint o) =>
o -> Float -> m ()
setSnapConstraintOffset o
obj Float
val = IO () -> m ()
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 -> Float -> IO ()
forall a. GObject a => a -> String -> Float -> IO ()
B.Properties.setObjectPropertyFloat o
obj String
"offset" Float
val

-- | Construct a `GValueConstruct` with valid value for the “@offset@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSnapConstraintOffset :: (IsSnapConstraint o, MIO.MonadIO m) => Float -> m (GValueConstruct o)
constructSnapConstraintOffset :: forall o (m :: * -> *).
(IsSnapConstraint o, MonadIO m) =>
Float -> m (GValueConstruct o)
constructSnapConstraintOffset Float
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> Float -> IO (GValueConstruct o)
forall o. String -> Float -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFloat String
"offset" Float
val

#if defined(ENABLE_OVERLOADING)
data SnapConstraintOffsetPropertyInfo
instance AttrInfo SnapConstraintOffsetPropertyInfo where
    type AttrAllowedOps SnapConstraintOffsetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SnapConstraintOffsetPropertyInfo = IsSnapConstraint
    type AttrSetTypeConstraint SnapConstraintOffsetPropertyInfo = (~) Float
    type AttrTransferTypeConstraint SnapConstraintOffsetPropertyInfo = (~) Float
    type AttrTransferType SnapConstraintOffsetPropertyInfo = Float
    type AttrGetType SnapConstraintOffsetPropertyInfo = Float
    type AttrLabel SnapConstraintOffsetPropertyInfo = "offset"
    type AttrOrigin SnapConstraintOffsetPropertyInfo = SnapConstraint
    attrGet = getSnapConstraintOffset
    attrSet = setSnapConstraintOffset
    attrTransfer _ v = do
        return v
    attrConstruct = constructSnapConstraintOffset
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.SnapConstraint.offset"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-SnapConstraint.html#g:attr:offset"
        })
#endif

-- VVV Prop "source"
   -- Type: TInterface (Name {namespace = "Clutter", name = "Actor"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just True)

-- | Get the value of the “@source@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' snapConstraint #source
-- @
getSnapConstraintSource :: (MonadIO m, IsSnapConstraint o) => o -> m Clutter.Actor.Actor
getSnapConstraintSource :: forall (m :: * -> *) o.
(MonadIO m, IsSnapConstraint o) =>
o -> m Actor
getSnapConstraintSource o
obj = IO Actor -> m Actor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Actor) -> IO Actor
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getSnapConstraintSource" (IO (Maybe Actor) -> IO Actor) -> IO (Maybe Actor) -> IO Actor
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Actor -> Actor) -> IO (Maybe Actor)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"source" ManagedPtr Actor -> Actor
Clutter.Actor.Actor

-- | Set the value of the “@source@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' snapConstraint [ #source 'Data.GI.Base.Attributes.:=' value ]
-- @
setSnapConstraintSource :: (MonadIO m, IsSnapConstraint o, Clutter.Actor.IsActor a) => o -> a -> m ()
setSnapConstraintSource :: forall (m :: * -> *) o a.
(MonadIO m, IsSnapConstraint o, IsActor a) =>
o -> a -> m ()
setSnapConstraintSource o
obj a
val = IO () -> m ()
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 a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"source" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@source@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSnapConstraintSource :: (IsSnapConstraint o, MIO.MonadIO m, Clutter.Actor.IsActor a) => a -> m (GValueConstruct o)
constructSnapConstraintSource :: forall o (m :: * -> *) a.
(IsSnapConstraint o, MonadIO m, IsActor a) =>
a -> m (GValueConstruct o)
constructSnapConstraintSource a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"source" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@source@” 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' #source
-- @
clearSnapConstraintSource :: (MonadIO m, IsSnapConstraint o) => o -> m ()
clearSnapConstraintSource :: forall (m :: * -> *) o.
(MonadIO m, IsSnapConstraint o) =>
o -> m ()
clearSnapConstraintSource o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Actor -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"source" (Maybe Actor
forall a. Maybe a
Nothing :: Maybe Clutter.Actor.Actor)

#if defined(ENABLE_OVERLOADING)
data SnapConstraintSourcePropertyInfo
instance AttrInfo SnapConstraintSourcePropertyInfo where
    type AttrAllowedOps SnapConstraintSourcePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SnapConstraintSourcePropertyInfo = IsSnapConstraint
    type AttrSetTypeConstraint SnapConstraintSourcePropertyInfo = Clutter.Actor.IsActor
    type AttrTransferTypeConstraint SnapConstraintSourcePropertyInfo = Clutter.Actor.IsActor
    type AttrTransferType SnapConstraintSourcePropertyInfo = Clutter.Actor.Actor
    type AttrGetType SnapConstraintSourcePropertyInfo = Clutter.Actor.Actor
    type AttrLabel SnapConstraintSourcePropertyInfo = "source"
    type AttrOrigin SnapConstraintSourcePropertyInfo = SnapConstraint
    attrGet = getSnapConstraintSource
    attrSet = setSnapConstraintSource
    attrTransfer _ v = do
        unsafeCastTo Clutter.Actor.Actor v
    attrConstruct = constructSnapConstraintSource
    attrClear = clearSnapConstraintSource
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.SnapConstraint.source"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-SnapConstraint.html#g:attr:source"
        })
#endif

-- VVV Prop "to-edge"
   -- Type: TInterface (Name {namespace = "Clutter", name = "SnapEdge"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@to-edge@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' snapConstraint #toEdge
-- @
getSnapConstraintToEdge :: (MonadIO m, IsSnapConstraint o) => o -> m Clutter.Enums.SnapEdge
getSnapConstraintToEdge :: forall (m :: * -> *) o.
(MonadIO m, IsSnapConstraint o) =>
o -> m SnapEdge
getSnapConstraintToEdge o
obj = IO SnapEdge -> m SnapEdge
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO SnapEdge -> m SnapEdge) -> IO SnapEdge -> m SnapEdge
forall a b. (a -> b) -> a -> b
$ o -> String -> IO SnapEdge
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"to-edge"

-- | Set the value of the “@to-edge@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' snapConstraint [ #toEdge 'Data.GI.Base.Attributes.:=' value ]
-- @
setSnapConstraintToEdge :: (MonadIO m, IsSnapConstraint o) => o -> Clutter.Enums.SnapEdge -> m ()
setSnapConstraintToEdge :: forall (m :: * -> *) o.
(MonadIO m, IsSnapConstraint o) =>
o -> SnapEdge -> m ()
setSnapConstraintToEdge o
obj SnapEdge
val = IO () -> m ()
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 -> SnapEdge -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"to-edge" SnapEdge
val

-- | Construct a `GValueConstruct` with valid value for the “@to-edge@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSnapConstraintToEdge :: (IsSnapConstraint o, MIO.MonadIO m) => Clutter.Enums.SnapEdge -> m (GValueConstruct o)
constructSnapConstraintToEdge :: forall o (m :: * -> *).
(IsSnapConstraint o, MonadIO m) =>
SnapEdge -> m (GValueConstruct o)
constructSnapConstraintToEdge SnapEdge
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> SnapEdge -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"to-edge" SnapEdge
val

#if defined(ENABLE_OVERLOADING)
data SnapConstraintToEdgePropertyInfo
instance AttrInfo SnapConstraintToEdgePropertyInfo where
    type AttrAllowedOps SnapConstraintToEdgePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SnapConstraintToEdgePropertyInfo = IsSnapConstraint
    type AttrSetTypeConstraint SnapConstraintToEdgePropertyInfo = (~) Clutter.Enums.SnapEdge
    type AttrTransferTypeConstraint SnapConstraintToEdgePropertyInfo = (~) Clutter.Enums.SnapEdge
    type AttrTransferType SnapConstraintToEdgePropertyInfo = Clutter.Enums.SnapEdge
    type AttrGetType SnapConstraintToEdgePropertyInfo = Clutter.Enums.SnapEdge
    type AttrLabel SnapConstraintToEdgePropertyInfo = "to-edge"
    type AttrOrigin SnapConstraintToEdgePropertyInfo = SnapConstraint
    attrGet = getSnapConstraintToEdge
    attrSet = setSnapConstraintToEdge
    attrTransfer _ v = do
        return v
    attrConstruct = constructSnapConstraintToEdge
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.SnapConstraint.toEdge"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-SnapConstraint.html#g:attr:toEdge"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SnapConstraint
type instance O.AttributeList SnapConstraint = SnapConstraintAttributeList
type SnapConstraintAttributeList = ('[ '("actor", Clutter.ActorMeta.ActorMetaActorPropertyInfo), '("enabled", Clutter.ActorMeta.ActorMetaEnabledPropertyInfo), '("fromEdge", SnapConstraintFromEdgePropertyInfo), '("name", Clutter.ActorMeta.ActorMetaNamePropertyInfo), '("offset", SnapConstraintOffsetPropertyInfo), '("source", SnapConstraintSourcePropertyInfo), '("toEdge", SnapConstraintToEdgePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
snapConstraintFromEdge :: AttrLabelProxy "fromEdge"
snapConstraintFromEdge = AttrLabelProxy

snapConstraintOffset :: AttrLabelProxy "offset"
snapConstraintOffset = AttrLabelProxy

snapConstraintSource :: AttrLabelProxy "source"
snapConstraintSource = AttrLabelProxy

snapConstraintToEdge :: AttrLabelProxy "toEdge"
snapConstraintToEdge = AttrLabelProxy

#endif

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

#endif

-- method SnapConstraint::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #ClutterActor to use as the source of\n  the constraint, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "from_edge"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "SnapEdge" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the edge of the actor to use in the constraint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "to_edge"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "SnapEdge" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the edge of @source to use in the constraint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the offset to apply to the constraint, in pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Clutter" , name = "SnapConstraint" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_snap_constraint_new" clutter_snap_constraint_new :: 
    Ptr Clutter.Actor.Actor ->              -- source : TInterface (Name {namespace = "Clutter", name = "Actor"})
    CUInt ->                                -- from_edge : TInterface (Name {namespace = "Clutter", name = "SnapEdge"})
    CUInt ->                                -- to_edge : TInterface (Name {namespace = "Clutter", name = "SnapEdge"})
    CFloat ->                               -- offset : TBasicType TFloat
    IO (Ptr SnapConstraint)

-- | Creates a new t'GI.Clutter.Objects.SnapConstraint.SnapConstraint' that will snap a t'GI.Clutter.Objects.Actor.Actor'
-- to the /@edge@/ of /@source@/, with the given /@offset@/.
-- 
-- /Since: 1.6/
snapConstraintNew ::
    (B.CallStack.HasCallStack, MonadIO m, Clutter.Actor.IsActor a) =>
    Maybe (a)
    -- ^ /@source@/: the t'GI.Clutter.Objects.Actor.Actor' to use as the source of
    --   the constraint, or 'P.Nothing'
    -> Clutter.Enums.SnapEdge
    -- ^ /@fromEdge@/: the edge of the actor to use in the constraint
    -> Clutter.Enums.SnapEdge
    -- ^ /@toEdge@/: the edge of /@source@/ to use in the constraint
    -> Float
    -- ^ /@offset@/: the offset to apply to the constraint, in pixels
    -> m SnapConstraint
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.SnapConstraint.SnapConstraint'
snapConstraintNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsActor a) =>
Maybe a -> SnapEdge -> SnapEdge -> Float -> m SnapConstraint
snapConstraintNew Maybe a
source SnapEdge
fromEdge SnapEdge
toEdge Float
offset = IO SnapConstraint -> m SnapConstraint
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SnapConstraint -> m SnapConstraint)
-> IO SnapConstraint -> m SnapConstraint
forall a b. (a -> b) -> a -> b
$ do
    Ptr Actor
maybeSource <- case Maybe a
source of
        Maybe a
Nothing -> Ptr Actor -> IO (Ptr Actor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
forall a. Ptr a
nullPtr
        Just a
jSource -> do
            Ptr Actor
jSource' <- a -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSource
            Ptr Actor -> IO (Ptr Actor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
jSource'
    let fromEdge' :: CUInt
fromEdge' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SnapEdge -> Int) -> SnapEdge -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapEdge -> Int
forall a. Enum a => a -> Int
fromEnum) SnapEdge
fromEdge
    let toEdge' :: CUInt
toEdge' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SnapEdge -> Int) -> SnapEdge -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapEdge -> Int
forall a. Enum a => a -> Int
fromEnum) SnapEdge
toEdge
    let offset' :: CFloat
offset' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
offset
    Ptr SnapConstraint
result <- Ptr Actor -> CUInt -> CUInt -> CFloat -> IO (Ptr SnapConstraint)
clutter_snap_constraint_new Ptr Actor
maybeSource CUInt
fromEdge' CUInt
toEdge' CFloat
offset'
    Text -> Ptr SnapConstraint -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snapConstraintNew" Ptr SnapConstraint
result
    SnapConstraint
result' <- ((ManagedPtr SnapConstraint -> SnapConstraint)
-> Ptr SnapConstraint -> IO SnapConstraint
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SnapConstraint -> SnapConstraint
SnapConstraint) Ptr SnapConstraint
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
source a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    SnapConstraint -> IO SnapConstraint
forall (m :: * -> *) a. Monad m => a -> m a
return SnapConstraint
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method SnapConstraint::get_edges
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "constraint"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "SnapConstraint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterSnapConstraint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "from_edge"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "SnapEdge" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the actor's edge, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "to_edge"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "SnapEdge" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the source's edge, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_snap_constraint_get_edges" clutter_snap_constraint_get_edges :: 
    Ptr SnapConstraint ->                   -- constraint : TInterface (Name {namespace = "Clutter", name = "SnapConstraint"})
    Ptr CUInt ->                            -- from_edge : TInterface (Name {namespace = "Clutter", name = "SnapEdge"})
    Ptr CUInt ->                            -- to_edge : TInterface (Name {namespace = "Clutter", name = "SnapEdge"})
    IO ()

-- | Retrieves the edges used by the /@constraint@/
-- 
-- /Since: 1.6/
snapConstraintGetEdges ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapConstraint a) =>
    a
    -- ^ /@constraint@/: a t'GI.Clutter.Objects.SnapConstraint.SnapConstraint'
    -> m ((Clutter.Enums.SnapEdge, Clutter.Enums.SnapEdge))
snapConstraintGetEdges :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapConstraint a) =>
a -> m (SnapEdge, SnapEdge)
snapConstraintGetEdges a
constraint = IO (SnapEdge, SnapEdge) -> m (SnapEdge, SnapEdge)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SnapEdge, SnapEdge) -> m (SnapEdge, SnapEdge))
-> IO (SnapEdge, SnapEdge) -> m (SnapEdge, SnapEdge)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnapConstraint
constraint' <- a -> IO (Ptr SnapConstraint)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
constraint
    Ptr CUInt
fromEdge <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr CUInt
toEdge <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr SnapConstraint -> Ptr CUInt -> Ptr CUInt -> IO ()
clutter_snap_constraint_get_edges Ptr SnapConstraint
constraint' Ptr CUInt
fromEdge Ptr CUInt
toEdge
    CUInt
fromEdge' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
fromEdge
    let fromEdge'' :: SnapEdge
fromEdge'' = (Int -> SnapEdge
forall a. Enum a => Int -> a
toEnum (Int -> SnapEdge) -> (CUInt -> Int) -> CUInt -> SnapEdge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
fromEdge'
    CUInt
toEdge' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
toEdge
    let toEdge'' :: SnapEdge
toEdge'' = (Int -> SnapEdge
forall a. Enum a => Int -> a
toEnum (Int -> SnapEdge) -> (CUInt -> Int) -> CUInt -> SnapEdge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
toEdge'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
constraint
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
fromEdge
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
toEdge
    (SnapEdge, SnapEdge) -> IO (SnapEdge, SnapEdge)
forall (m :: * -> *) a. Monad m => a -> m a
return (SnapEdge
fromEdge'', SnapEdge
toEdge'')

#if defined(ENABLE_OVERLOADING)
data SnapConstraintGetEdgesMethodInfo
instance (signature ~ (m ((Clutter.Enums.SnapEdge, Clutter.Enums.SnapEdge))), MonadIO m, IsSnapConstraint a) => O.OverloadedMethod SnapConstraintGetEdgesMethodInfo a signature where
    overloadedMethod = snapConstraintGetEdges

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


#endif

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

foreign import ccall "clutter_snap_constraint_get_offset" clutter_snap_constraint_get_offset :: 
    Ptr SnapConstraint ->                   -- constraint : TInterface (Name {namespace = "Clutter", name = "SnapConstraint"})
    IO CFloat

-- | Retrieves the offset set using 'GI.Clutter.Objects.SnapConstraint.snapConstraintSetOffset'
-- 
-- /Since: 1.6/
snapConstraintGetOffset ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapConstraint a) =>
    a
    -- ^ /@constraint@/: a t'GI.Clutter.Objects.SnapConstraint.SnapConstraint'
    -> m Float
    -- ^ __Returns:__ the offset, in pixels
snapConstraintGetOffset :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapConstraint a) =>
a -> m Float
snapConstraintGetOffset a
constraint = IO Float -> m Float
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Float -> m Float) -> IO Float -> m Float
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnapConstraint
constraint' <- a -> IO (Ptr SnapConstraint)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
constraint
    CFloat
result <- Ptr SnapConstraint -> IO CFloat
clutter_snap_constraint_get_offset Ptr SnapConstraint
constraint'
    let result' :: Float
result' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
constraint
    Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
result'

#if defined(ENABLE_OVERLOADING)
data SnapConstraintGetOffsetMethodInfo
instance (signature ~ (m Float), MonadIO m, IsSnapConstraint a) => O.OverloadedMethod SnapConstraintGetOffsetMethodInfo a signature where
    overloadedMethod = snapConstraintGetOffset

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


#endif

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

foreign import ccall "clutter_snap_constraint_get_source" clutter_snap_constraint_get_source :: 
    Ptr SnapConstraint ->                   -- constraint : TInterface (Name {namespace = "Clutter", name = "SnapConstraint"})
    IO (Ptr Clutter.Actor.Actor)

-- | Retrieves the t'GI.Clutter.Objects.Actor.Actor' set using 'GI.Clutter.Objects.SnapConstraint.snapConstraintSetSource'
-- 
-- /Since: 1.6/
snapConstraintGetSource ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapConstraint a) =>
    a
    -- ^ /@constraint@/: a t'GI.Clutter.Objects.SnapConstraint.SnapConstraint'
    -> m Clutter.Actor.Actor
    -- ^ __Returns:__ a pointer to the source actor
snapConstraintGetSource :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapConstraint a) =>
a -> m Actor
snapConstraintGetSource a
constraint = IO Actor -> m Actor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnapConstraint
constraint' <- a -> IO (Ptr SnapConstraint)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
constraint
    Ptr Actor
result <- Ptr SnapConstraint -> IO (Ptr Actor)
clutter_snap_constraint_get_source Ptr SnapConstraint
constraint'
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snapConstraintGetSource" Ptr Actor
result
    Actor
result' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
constraint
    Actor -> IO Actor
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'

#if defined(ENABLE_OVERLOADING)
data SnapConstraintGetSourceMethodInfo
instance (signature ~ (m Clutter.Actor.Actor), MonadIO m, IsSnapConstraint a) => O.OverloadedMethod SnapConstraintGetSourceMethodInfo a signature where
    overloadedMethod = snapConstraintGetSource

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


#endif

-- method SnapConstraint::set_edges
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "constraint"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "SnapConstraint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterSnapConstraint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "from_edge"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "SnapEdge" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the edge on the actor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "to_edge"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "SnapEdge" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the edge on the source"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_snap_constraint_set_edges" clutter_snap_constraint_set_edges :: 
    Ptr SnapConstraint ->                   -- constraint : TInterface (Name {namespace = "Clutter", name = "SnapConstraint"})
    CUInt ->                                -- from_edge : TInterface (Name {namespace = "Clutter", name = "SnapEdge"})
    CUInt ->                                -- to_edge : TInterface (Name {namespace = "Clutter", name = "SnapEdge"})
    IO ()

-- | Sets the edges to be used by the /@constraint@/
-- 
-- The /@fromEdge@/ is the edge on the t'GI.Clutter.Objects.Actor.Actor' to which /@constraint@/
-- has been added. The /@toEdge@/ is the edge of the t'GI.Clutter.Objects.Actor.Actor' inside
-- the t'GI.Clutter.Objects.SnapConstraint.SnapConstraint':@/source/@ property.
-- 
-- /Since: 1.6/
snapConstraintSetEdges ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapConstraint a) =>
    a
    -- ^ /@constraint@/: a t'GI.Clutter.Objects.SnapConstraint.SnapConstraint'
    -> Clutter.Enums.SnapEdge
    -- ^ /@fromEdge@/: the edge on the actor
    -> Clutter.Enums.SnapEdge
    -- ^ /@toEdge@/: the edge on the source
    -> m ()
snapConstraintSetEdges :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapConstraint a) =>
a -> SnapEdge -> SnapEdge -> m ()
snapConstraintSetEdges a
constraint SnapEdge
fromEdge SnapEdge
toEdge = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnapConstraint
constraint' <- a -> IO (Ptr SnapConstraint)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
constraint
    let fromEdge' :: CUInt
fromEdge' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SnapEdge -> Int) -> SnapEdge -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapEdge -> Int
forall a. Enum a => a -> Int
fromEnum) SnapEdge
fromEdge
    let toEdge' :: CUInt
toEdge' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SnapEdge -> Int) -> SnapEdge -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapEdge -> Int
forall a. Enum a => a -> Int
fromEnum) SnapEdge
toEdge
    Ptr SnapConstraint -> CUInt -> CUInt -> IO ()
clutter_snap_constraint_set_edges Ptr SnapConstraint
constraint' CUInt
fromEdge' CUInt
toEdge'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
constraint
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapConstraintSetEdgesMethodInfo
instance (signature ~ (Clutter.Enums.SnapEdge -> Clutter.Enums.SnapEdge -> m ()), MonadIO m, IsSnapConstraint a) => O.OverloadedMethod SnapConstraintSetEdgesMethodInfo a signature where
    overloadedMethod = snapConstraintSetEdges

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


#endif

-- method SnapConstraint::set_offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "constraint"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "SnapConstraint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterSnapConstraint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TFloat
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offset to apply, in pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_snap_constraint_set_offset" clutter_snap_constraint_set_offset :: 
    Ptr SnapConstraint ->                   -- constraint : TInterface (Name {namespace = "Clutter", name = "SnapConstraint"})
    CFloat ->                               -- offset : TBasicType TFloat
    IO ()

-- | Sets the offset to be applied to the constraint
-- 
-- /Since: 1.6/
snapConstraintSetOffset ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapConstraint a) =>
    a
    -- ^ /@constraint@/: a t'GI.Clutter.Objects.SnapConstraint.SnapConstraint'
    -> Float
    -- ^ /@offset@/: the offset to apply, in pixels
    -> m ()
snapConstraintSetOffset :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnapConstraint a) =>
a -> Float -> m ()
snapConstraintSetOffset a
constraint Float
offset = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnapConstraint
constraint' <- a -> IO (Ptr SnapConstraint)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
constraint
    let offset' :: CFloat
offset' = Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
offset
    Ptr SnapConstraint -> CFloat -> IO ()
clutter_snap_constraint_set_offset Ptr SnapConstraint
constraint' CFloat
offset'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
constraint
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapConstraintSetOffsetMethodInfo
instance (signature ~ (Float -> m ()), MonadIO m, IsSnapConstraint a) => O.OverloadedMethod SnapConstraintSetOffsetMethodInfo a signature where
    overloadedMethod = snapConstraintSetOffset

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


#endif

-- method SnapConstraint::set_source
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "constraint"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "SnapConstraint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterSnapConstraint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor, or %NULL to unset the source"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_snap_constraint_set_source" clutter_snap_constraint_set_source :: 
    Ptr SnapConstraint ->                   -- constraint : TInterface (Name {namespace = "Clutter", name = "SnapConstraint"})
    Ptr Clutter.Actor.Actor ->              -- source : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

-- | Sets the source t'GI.Clutter.Objects.Actor.Actor' for the constraint
-- 
-- /Since: 1.6/
snapConstraintSetSource ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnapConstraint a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@constraint@/: a t'GI.Clutter.Objects.SnapConstraint.SnapConstraint'
    -> Maybe (b)
    -- ^ /@source@/: a t'GI.Clutter.Objects.Actor.Actor', or 'P.Nothing' to unset the source
    -> m ()
snapConstraintSetSource :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSnapConstraint a, IsActor b) =>
a -> Maybe b -> m ()
snapConstraintSetSource a
constraint Maybe b
source = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnapConstraint
constraint' <- a -> IO (Ptr SnapConstraint)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
constraint
    Ptr Actor
maybeSource <- case Maybe b
source of
        Maybe b
Nothing -> Ptr Actor -> IO (Ptr Actor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
forall a. Ptr a
nullPtr
        Just b
jSource -> do
            Ptr Actor
jSource' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jSource
            Ptr Actor -> IO (Ptr Actor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
jSource'
    Ptr SnapConstraint -> Ptr Actor -> IO ()
clutter_snap_constraint_set_source Ptr SnapConstraint
constraint' Ptr Actor
maybeSource
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
constraint
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
source b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnapConstraintSetSourceMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSnapConstraint a, Clutter.Actor.IsActor b) => O.OverloadedMethod SnapConstraintSetSourceMethodInfo a signature where
    overloadedMethod = snapConstraintSetSource

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


#endif