{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Dazzle.Objects.StateMachine
    ( 

-- * Exported types
    StateMachine(..)                        ,
    IsStateMachine                          ,
    toStateMachine                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addBinding]("GI.Dazzle.Objects.StateMachine#g:method:addBinding"), [addChild]("GI.Gtk.Interfaces.Buildable#g:method:addChild"), [addPropertyv]("GI.Dazzle.Objects.StateMachine#g:method:addPropertyv"), [addStyle]("GI.Dazzle.Objects.StateMachine#g:method:addStyle"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [constructChild]("GI.Gtk.Interfaces.Buildable#g:method:constructChild"), [createAction]("GI.Dazzle.Objects.StateMachine#g:method:createAction"), [customFinished]("GI.Gtk.Interfaces.Buildable#g:method:customFinished"), [customTagEnd]("GI.Gtk.Interfaces.Buildable#g:method:customTagEnd"), [customTagStart]("GI.Gtk.Interfaces.Buildable#g:method:customTagStart"), [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"), [isState]("GI.Dazzle.Objects.StateMachine#g:method:isState"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [parserFinished]("GI.Gtk.Interfaces.Buildable#g:method:parserFinished"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getInternalChild]("GI.Gtk.Interfaces.Buildable#g:method:getInternalChild"), [getName]("GI.Gtk.Interfaces.Buildable#g:method:getName"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getState]("GI.Dazzle.Objects.StateMachine#g:method:getState").
-- 
-- ==== Setters
-- [setBuildableProperty]("GI.Gtk.Interfaces.Buildable#g:method:setBuildableProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setName]("GI.Gtk.Interfaces.Buildable#g:method:setName"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setState]("GI.Dazzle.Objects.StateMachine#g:method:setState").

#if defined(ENABLE_OVERLOADING)
    ResolveStateMachineMethod               ,
#endif

-- ** addBinding #method:addBinding#

#if defined(ENABLE_OVERLOADING)
    StateMachineAddBindingMethodInfo        ,
#endif
    stateMachineAddBinding                  ,


-- ** addPropertyv #method:addPropertyv#

#if defined(ENABLE_OVERLOADING)
    StateMachineAddPropertyvMethodInfo      ,
#endif
    stateMachineAddPropertyv                ,


-- ** addStyle #method:addStyle#

#if defined(ENABLE_OVERLOADING)
    StateMachineAddStyleMethodInfo          ,
#endif
    stateMachineAddStyle                    ,


-- ** createAction #method:createAction#

#if defined(ENABLE_OVERLOADING)
    StateMachineCreateActionMethodInfo      ,
#endif
    stateMachineCreateAction                ,


-- ** getState #method:getState#

#if defined(ENABLE_OVERLOADING)
    StateMachineGetStateMethodInfo          ,
#endif
    stateMachineGetState                    ,


-- ** isState #method:isState#

#if defined(ENABLE_OVERLOADING)
    StateMachineIsStateMethodInfo           ,
#endif
    stateMachineIsState                     ,


-- ** new #method:new#

    stateMachineNew                         ,


-- ** setState #method:setState#

#if defined(ENABLE_OVERLOADING)
    StateMachineSetStateMethodInfo          ,
#endif
    stateMachineSetState                    ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    StateMachineStatePropertyInfo           ,
#endif
    constructStateMachineState              ,
    getStateMachineState                    ,
    setStateMachineState                    ,
#if defined(ENABLE_OVERLOADING)
    stateMachineState                       ,
#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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GObject.Flags as GObject.Flags
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Action as Gio.Action
import qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#else
import qualified GI.GObject.Flags as GObject.Flags
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Action as Gio.Action
import qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#endif

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

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

foreign import ccall "dzl_state_machine_get_type"
    c_dzl_state_machine_get_type :: IO B.Types.GType

instance B.Types.TypedObject StateMachine where
    glibType :: IO GType
glibType = IO GType
c_dzl_state_machine_get_type

instance B.Types.GObject StateMachine

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

instance O.HasParentTypes StateMachine
type instance O.ParentTypes StateMachine = '[GObject.Object.Object, Gtk.Buildable.Buildable]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveStateMachineMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveStateMachineMethod "addBinding" o = StateMachineAddBindingMethodInfo
    ResolveStateMachineMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveStateMachineMethod "addPropertyv" o = StateMachineAddPropertyvMethodInfo
    ResolveStateMachineMethod "addStyle" o = StateMachineAddStyleMethodInfo
    ResolveStateMachineMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveStateMachineMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveStateMachineMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveStateMachineMethod "createAction" o = StateMachineCreateActionMethodInfo
    ResolveStateMachineMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveStateMachineMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveStateMachineMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveStateMachineMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveStateMachineMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveStateMachineMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveStateMachineMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveStateMachineMethod "isState" o = StateMachineIsStateMethodInfo
    ResolveStateMachineMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveStateMachineMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveStateMachineMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveStateMachineMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveStateMachineMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveStateMachineMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveStateMachineMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveStateMachineMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveStateMachineMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveStateMachineMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveStateMachineMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveStateMachineMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveStateMachineMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveStateMachineMethod "getName" o = Gtk.Buildable.BuildableGetNameMethodInfo
    ResolveStateMachineMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveStateMachineMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveStateMachineMethod "getState" o = StateMachineGetStateMethodInfo
    ResolveStateMachineMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveStateMachineMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveStateMachineMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveStateMachineMethod "setName" o = Gtk.Buildable.BuildableSetNameMethodInfo
    ResolveStateMachineMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveStateMachineMethod "setState" o = StateMachineSetStateMethodInfo
    ResolveStateMachineMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data StateMachineStatePropertyInfo
instance AttrInfo StateMachineStatePropertyInfo where
    type AttrAllowedOps StateMachineStatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StateMachineStatePropertyInfo = IsStateMachine
    type AttrSetTypeConstraint StateMachineStatePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StateMachineStatePropertyInfo = (~) T.Text
    type AttrTransferType StateMachineStatePropertyInfo = T.Text
    type AttrGetType StateMachineStatePropertyInfo = T.Text
    type AttrLabel StateMachineStatePropertyInfo = "state"
    type AttrOrigin StateMachineStatePropertyInfo = StateMachine
    attrGet = getStateMachineState
    attrSet = setStateMachineState
    attrTransfer _ v = do
        return v
    attrConstruct = constructStateMachineState
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.StateMachine.state"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-StateMachine.html#g:attr:state"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList StateMachine
type instance O.AttributeList StateMachine = StateMachineAttributeList
type StateMachineAttributeList = ('[ '("state", StateMachineStatePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
stateMachineState :: AttrLabelProxy "state"
stateMachineState = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "dzl_state_machine_new" dzl_state_machine_new :: 
    IO (Ptr StateMachine)

-- | /No description available in the introspection data./
stateMachineNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m StateMachine
stateMachineNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m StateMachine
stateMachineNew  = IO StateMachine -> m StateMachine
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StateMachine -> m StateMachine)
-> IO StateMachine -> m StateMachine
forall a b. (a -> b) -> a -> b
$ do
    Ptr StateMachine
result <- IO (Ptr StateMachine)
dzl_state_machine_new
    Text -> Ptr StateMachine -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"stateMachineNew" Ptr StateMachine
result
    StateMachine
result' <- ((ManagedPtr StateMachine -> StateMachine)
-> Ptr StateMachine -> IO StateMachine
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr StateMachine -> StateMachine
StateMachine) Ptr StateMachine
result
    StateMachine -> IO StateMachine
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StateMachine
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method StateMachine::add_binding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "StateMachine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source_object"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source_property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target_object"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target_property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "BindingFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_state_machine_add_binding" dzl_state_machine_add_binding :: 
    Ptr StateMachine ->                     -- self : TInterface (Name {namespace = "Dazzle", name = "StateMachine"})
    CString ->                              -- state : TBasicType TUTF8
    Ptr () ->                               -- source_object : TBasicType TPtr
    CString ->                              -- source_property : TBasicType TUTF8
    Ptr () ->                               -- target_object : TBasicType TPtr
    CString ->                              -- target_property : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "GObject", name = "BindingFlags"})
    IO ()

-- | /No description available in the introspection data./
stateMachineAddBinding ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateMachine a) =>
    a
    -> T.Text
    -> Ptr ()
    -> T.Text
    -> Ptr ()
    -> T.Text
    -> [GObject.Flags.BindingFlags]
    -> m ()
stateMachineAddBinding :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStateMachine a) =>
a
-> Text
-> Ptr ()
-> Text
-> Ptr ()
-> Text
-> [BindingFlags]
-> m ()
stateMachineAddBinding a
self Text
state Ptr ()
sourceObject Text
sourceProperty Ptr ()
targetObject Text
targetProperty [BindingFlags]
flags = 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 StateMachine
self' <- a -> IO (Ptr StateMachine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
state' <- Text -> IO CString
textToCString Text
state
    CString
sourceProperty' <- Text -> IO CString
textToCString Text
sourceProperty
    CString
targetProperty' <- Text -> IO CString
textToCString Text
targetProperty
    let flags' :: CUInt
flags' = [BindingFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [BindingFlags]
flags
    Ptr StateMachine
-> CString
-> Ptr ()
-> CString
-> Ptr ()
-> CString
-> CUInt
-> IO ()
dzl_state_machine_add_binding Ptr StateMachine
self' CString
state' Ptr ()
sourceObject CString
sourceProperty' Ptr ()
targetObject CString
targetProperty' CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
state'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sourceProperty'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
targetProperty'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StateMachineAddBindingMethodInfo
instance (signature ~ (T.Text -> Ptr () -> T.Text -> Ptr () -> T.Text -> [GObject.Flags.BindingFlags] -> m ()), MonadIO m, IsStateMachine a) => O.OverloadedMethod StateMachineAddBindingMethodInfo a signature where
    overloadedMethod = stateMachineAddBinding

instance O.OverloadedMethodInfo StateMachineAddBindingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.StateMachine.stateMachineAddBinding",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-StateMachine.html#v:stateMachineAddBinding"
        })


#endif

-- method StateMachine::add_propertyv
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "StateMachine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_state_machine_add_propertyv" dzl_state_machine_add_propertyv :: 
    Ptr StateMachine ->                     -- self : TInterface (Name {namespace = "Dazzle", name = "StateMachine"})
    CString ->                              -- state : TBasicType TUTF8
    Ptr () ->                               -- object : TBasicType TPtr
    CString ->                              -- property : TBasicType TUTF8
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | /No description available in the introspection data./
stateMachineAddPropertyv ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateMachine a) =>
    a
    -> T.Text
    -> Ptr ()
    -> T.Text
    -> GValue
    -> m ()
stateMachineAddPropertyv :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStateMachine a) =>
a -> Text -> Ptr () -> Text -> GValue -> m ()
stateMachineAddPropertyv a
self Text
state Ptr ()
object Text
property GValue
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StateMachine
self' <- a -> IO (Ptr StateMachine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
state' <- Text -> IO CString
textToCString Text
state
    CString
property' <- Text -> IO CString
textToCString Text
property
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr StateMachine
-> CString -> Ptr () -> CString -> Ptr GValue -> IO ()
dzl_state_machine_add_propertyv Ptr StateMachine
self' CString
state' Ptr ()
object CString
property' Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
state'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
property'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StateMachineAddPropertyvMethodInfo
instance (signature ~ (T.Text -> Ptr () -> T.Text -> GValue -> m ()), MonadIO m, IsStateMachine a) => O.OverloadedMethod StateMachineAddPropertyvMethodInfo a signature where
    overloadedMethod = stateMachineAddPropertyv

instance O.OverloadedMethodInfo StateMachineAddPropertyvMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.StateMachine.stateMachineAddPropertyv",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-StateMachine.html#v:stateMachineAddPropertyv"
        })


#endif

-- method StateMachine::add_style
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "StateMachine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "style"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_state_machine_add_style" dzl_state_machine_add_style :: 
    Ptr StateMachine ->                     -- self : TInterface (Name {namespace = "Dazzle", name = "StateMachine"})
    CString ->                              -- state : TBasicType TUTF8
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    CString ->                              -- style : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
stateMachineAddStyle ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateMachine a, Gtk.Widget.IsWidget b) =>
    a
    -> T.Text
    -> b
    -> T.Text
    -> m ()
stateMachineAddStyle :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsStateMachine a, IsWidget b) =>
a -> Text -> b -> Text -> m ()
stateMachineAddStyle a
self Text
state b
widget Text
style = 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 StateMachine
self' <- a -> IO (Ptr StateMachine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
state' <- Text -> IO CString
textToCString Text
state
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    CString
style' <- Text -> IO CString
textToCString Text
style
    Ptr StateMachine -> CString -> Ptr Widget -> CString -> IO ()
dzl_state_machine_add_style Ptr StateMachine
self' CString
state' Ptr Widget
widget' CString
style'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
state'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
style'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StateMachineAddStyleMethodInfo
instance (signature ~ (T.Text -> b -> T.Text -> m ()), MonadIO m, IsStateMachine a, Gtk.Widget.IsWidget b) => O.OverloadedMethod StateMachineAddStyleMethodInfo a signature where
    overloadedMethod = stateMachineAddStyle

instance O.OverloadedMethodInfo StateMachineAddStyleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.StateMachine.stateMachineAddStyle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-StateMachine.html#v:stateMachineAddStyle"
        })


#endif

-- method StateMachine::create_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "StateMachine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #DzlStateMachine"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the action."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Action" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_state_machine_create_action" dzl_state_machine_create_action :: 
    Ptr StateMachine ->                     -- self : TInterface (Name {namespace = "Dazzle", name = "StateMachine"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gio.Action.Action)

-- | Creates a new t'GI.Gio.Interfaces.Action.Action' with the name of /@name@/.
-- 
-- Setting the state of this action will toggle the state of the state machine.
-- You should use 'GI.GLib.Structs.Variant.variantNewString' or similar to create the state.
stateMachineCreateAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateMachine a) =>
    a
    -- ^ /@self@/: An t'GI.Dazzle.Objects.StateMachine.StateMachine'
    -> T.Text
    -- ^ /@name@/: the name of the action.
    -> m Gio.Action.Action
    -- ^ __Returns:__ A newly created t'GI.Gio.Interfaces.Action.Action'.
stateMachineCreateAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStateMachine a) =>
a -> Text -> m Action
stateMachineCreateAction a
self Text
name = IO Action -> m Action
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Action -> m Action) -> IO Action -> m Action
forall a b. (a -> b) -> a -> b
$ do
    Ptr StateMachine
self' <- a -> IO (Ptr StateMachine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Action
result <- Ptr StateMachine -> CString -> IO (Ptr Action)
dzl_state_machine_create_action Ptr StateMachine
self' CString
name'
    Text -> Ptr Action -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"stateMachineCreateAction" Ptr Action
result
    Action
result' <- ((ManagedPtr Action -> Action) -> Ptr Action -> IO Action
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Action -> Action
Gio.Action.Action) Ptr Action
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Action -> IO Action
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Action
result'

#if defined(ENABLE_OVERLOADING)
data StateMachineCreateActionMethodInfo
instance (signature ~ (T.Text -> m Gio.Action.Action), MonadIO m, IsStateMachine a) => O.OverloadedMethod StateMachineCreateActionMethodInfo a signature where
    overloadedMethod = stateMachineCreateAction

instance O.OverloadedMethodInfo StateMachineCreateActionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.StateMachine.stateMachineCreateAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-StateMachine.html#v:stateMachineCreateAction"
        })


#endif

-- method StateMachine::get_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "StateMachine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #DzlStateMachine."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_state_machine_get_state" dzl_state_machine_get_state :: 
    Ptr StateMachine ->                     -- self : TInterface (Name {namespace = "Dazzle", name = "StateMachine"})
    IO CString

-- | Gets the [StateMachine:state]("GI.Dazzle.Objects.StateMachine#g:attr:state") property. This is the name of the
-- current state of the machine.
stateMachineGetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateMachine a) =>
    a
    -- ^ /@self@/: the t'GI.Dazzle.Objects.StateMachine.StateMachine'.
    -> m T.Text
    -- ^ __Returns:__ The current state of the machine.
stateMachineGetState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStateMachine a) =>
a -> m Text
stateMachineGetState a
self = 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 StateMachine
self' <- a -> IO (Ptr StateMachine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr StateMachine -> IO CString
dzl_state_machine_get_state Ptr StateMachine
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"stateMachineGetState" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data StateMachineGetStateMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsStateMachine a) => O.OverloadedMethod StateMachineGetStateMethodInfo a signature where
    overloadedMethod = stateMachineGetState

instance O.OverloadedMethodInfo StateMachineGetStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.StateMachine.stateMachineGetState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-StateMachine.html#v:stateMachineGetState"
        })


#endif

-- method StateMachine::is_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "StateMachine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlStateMachine" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the state to check"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_state_machine_is_state" dzl_state_machine_is_state :: 
    Ptr StateMachine ->                     -- self : TInterface (Name {namespace = "Dazzle", name = "StateMachine"})
    CString ->                              -- state : TBasicType TUTF8
    IO CInt

-- | Checks to see if the current state of the t'GI.Dazzle.Objects.StateMachine.StateMachine' matches /@state@/.
-- 
-- /Since: 3.28/
stateMachineIsState ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateMachine a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.StateMachine.StateMachine'
    -> Maybe (T.Text)
    -- ^ /@state@/: the name of the state to check
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@self@/ is currently set to /@state@/.
stateMachineIsState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStateMachine a) =>
a -> Maybe Text -> m Bool
stateMachineIsState a
self Maybe Text
state = 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 StateMachine
self' <- a -> IO (Ptr StateMachine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeState <- case Maybe Text
state of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jState -> do
            CString
jState' <- Text -> IO CString
textToCString Text
jState
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jState'
    CInt
result <- Ptr StateMachine -> CString -> IO CInt
dzl_state_machine_is_state Ptr StateMachine
self' CString
maybeState
    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
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeState
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StateMachineIsStateMethodInfo
instance (signature ~ (Maybe (T.Text) -> m Bool), MonadIO m, IsStateMachine a) => O.OverloadedMethod StateMachineIsStateMethodInfo a signature where
    overloadedMethod = stateMachineIsState

instance O.OverloadedMethodInfo StateMachineIsStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.StateMachine.stateMachineIsState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-StateMachine.html#v:stateMachineIsState"
        })


#endif

-- method StateMachine::set_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "StateMachine" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #DzlStateMachine @self: the #"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_state_machine_set_state" dzl_state_machine_set_state :: 
    Ptr StateMachine ->                     -- self : TInterface (Name {namespace = "Dazzle", name = "StateMachine"})
    CString ->                              -- state : TBasicType TUTF8
    IO ()

-- | Sets the [StateMachine:state]("GI.Dazzle.Objects.StateMachine#g:attr:state") property.
-- 
-- Registered state transformations will be applied during the state
-- transformation.
-- 
-- If the transition results in a cyclic operation, the state will stop at
-- the last state before the cycle was detected.
stateMachineSetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateMachine a) =>
    a
    -- ^ /@self@/: the t'GI.Dazzle.Objects.StateMachine.StateMachine' /@self@/: the #
    -> T.Text
    -> m ()
stateMachineSetState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStateMachine a) =>
a -> Text -> m ()
stateMachineSetState a
self Text
state = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StateMachine
self' <- a -> IO (Ptr StateMachine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
state' <- Text -> IO CString
textToCString Text
state
    Ptr StateMachine -> CString -> IO ()
dzl_state_machine_set_state Ptr StateMachine
self' CString
state'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
state'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo StateMachineSetStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.StateMachine.stateMachineSetState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-StateMachine.html#v:stateMachineSetState"
        })


#endif