{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An AtkStateSet is a read-only representation of the full set of @/AtkStates/@
-- that apply to an object at a given time. This set is not meant to be
-- modified, but rather created when @/atk_object_ref_state_set/@() is called.

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

module GI.Atk.Objects.StateSet
    ( 

-- * Exported types
    StateSet(..)                            ,
    IsStateSet                              ,
    toStateSet                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addState]("GI.Atk.Objects.StateSet#g:method:addState"), [addStates]("GI.Atk.Objects.StateSet#g:method:addStates"), [andSets]("GI.Atk.Objects.StateSet#g:method:andSets"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [clearStates]("GI.Atk.Objects.StateSet#g:method:clearStates"), [containsState]("GI.Atk.Objects.StateSet#g:method:containsState"), [containsStates]("GI.Atk.Objects.StateSet#g:method:containsStates"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isEmpty]("GI.Atk.Objects.StateSet#g:method:isEmpty"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [orSets]("GI.Atk.Objects.StateSet#g:method:orSets"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeState]("GI.Atk.Objects.StateSet#g:method:removeState"), [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"), [xorSets]("GI.Atk.Objects.StateSet#g:method:xorSets").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveStateSetMethod                   ,
#endif

-- ** addState #method:addState#

#if defined(ENABLE_OVERLOADING)
    StateSetAddStateMethodInfo              ,
#endif
    stateSetAddState                        ,


-- ** addStates #method:addStates#

#if defined(ENABLE_OVERLOADING)
    StateSetAddStatesMethodInfo             ,
#endif
    stateSetAddStates                       ,


-- ** andSets #method:andSets#

#if defined(ENABLE_OVERLOADING)
    StateSetAndSetsMethodInfo               ,
#endif
    stateSetAndSets                         ,


-- ** clearStates #method:clearStates#

#if defined(ENABLE_OVERLOADING)
    StateSetClearStatesMethodInfo           ,
#endif
    stateSetClearStates                     ,


-- ** containsState #method:containsState#

#if defined(ENABLE_OVERLOADING)
    StateSetContainsStateMethodInfo         ,
#endif
    stateSetContainsState                   ,


-- ** containsStates #method:containsStates#

#if defined(ENABLE_OVERLOADING)
    StateSetContainsStatesMethodInfo        ,
#endif
    stateSetContainsStates                  ,


-- ** isEmpty #method:isEmpty#

#if defined(ENABLE_OVERLOADING)
    StateSetIsEmptyMethodInfo               ,
#endif
    stateSetIsEmpty                         ,


-- ** new #method:new#

    stateSetNew                             ,


-- ** orSets #method:orSets#

#if defined(ENABLE_OVERLOADING)
    StateSetOrSetsMethodInfo                ,
#endif
    stateSetOrSets                          ,


-- ** removeState #method:removeState#

#if defined(ENABLE_OVERLOADING)
    StateSetRemoveStateMethodInfo           ,
#endif
    stateSetRemoveState                     ,


-- ** xorSets #method:xorSets#

#if defined(ENABLE_OVERLOADING)
    StateSetXorSetsMethodInfo               ,
#endif
    stateSetXorSets                         ,




    ) 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.Atk.Enums as Atk.Enums
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "atk_state_set_get_type"
    c_atk_state_set_get_type :: IO B.Types.GType

instance B.Types.TypedObject StateSet where
    glibType :: IO GType
glibType = IO GType
c_atk_state_set_get_type

instance B.Types.GObject StateSet

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveStateSetMethod (t :: Symbol) (o :: *) :: * where
    ResolveStateSetMethod "addState" o = StateSetAddStateMethodInfo
    ResolveStateSetMethod "addStates" o = StateSetAddStatesMethodInfo
    ResolveStateSetMethod "andSets" o = StateSetAndSetsMethodInfo
    ResolveStateSetMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveStateSetMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveStateSetMethod "clearStates" o = StateSetClearStatesMethodInfo
    ResolveStateSetMethod "containsState" o = StateSetContainsStateMethodInfo
    ResolveStateSetMethod "containsStates" o = StateSetContainsStatesMethodInfo
    ResolveStateSetMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveStateSetMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveStateSetMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveStateSetMethod "isEmpty" o = StateSetIsEmptyMethodInfo
    ResolveStateSetMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveStateSetMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveStateSetMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveStateSetMethod "orSets" o = StateSetOrSetsMethodInfo
    ResolveStateSetMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveStateSetMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveStateSetMethod "removeState" o = StateSetRemoveStateMethodInfo
    ResolveStateSetMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveStateSetMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveStateSetMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveStateSetMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveStateSetMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveStateSetMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveStateSetMethod "xorSets" o = StateSetXorSetsMethodInfo
    ResolveStateSetMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveStateSetMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveStateSetMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveStateSetMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveStateSetMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveStateSetMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveStateSetMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "atk_state_set_new" atk_state_set_new :: 
    IO (Ptr StateSet)

-- | Creates a new empty state set.
stateSetNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m StateSet
    -- ^ __Returns:__ a new t'GI.Atk.Objects.StateSet.StateSet'
stateSetNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m StateSet
stateSetNew  = IO StateSet -> m StateSet
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StateSet -> m StateSet) -> IO StateSet -> m StateSet
forall a b. (a -> b) -> a -> b
$ do
    Ptr StateSet
result <- IO (Ptr StateSet)
atk_state_set_new
    Text -> Ptr StateSet -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"stateSetNew" Ptr StateSet
result
    StateSet
result' <- ((ManagedPtr StateSet -> StateSet) -> Ptr StateSet -> IO StateSet
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr StateSet -> StateSet
StateSet) Ptr StateSet
result
    StateSet -> IO StateSet
forall (m :: * -> *) a. Monad m => a -> m a
return StateSet
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method StateSet::add_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkStateSet" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkStateType" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "atk_state_set_add_state" atk_state_set_add_state :: 
    Ptr StateSet ->                         -- set : TInterface (Name {namespace = "Atk", name = "StateSet"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Atk", name = "StateType"})
    IO CInt

-- | Adds the state of the specified type to the state set if it is not already
-- present.
-- 
-- Note that because an t'GI.Atk.Objects.StateSet.StateSet' is a read-only object, this method should
-- be used to add a state to a newly-created set which will then be returned by
-- @/atk_object_ref_state_set/@. It should not be used to modify the existing state
-- of an object. See also @/atk_object_notify_state_change/@.
stateSetAddState ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateSet a) =>
    a
    -- ^ /@set@/: an t'GI.Atk.Objects.StateSet.StateSet'
    -> Atk.Enums.StateType
    -- ^ /@type@/: an t'GI.Atk.Enums.StateType'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if  the state for /@type@/ is not already in /@set@/.
stateSetAddState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStateSet a) =>
a -> StateType -> m Bool
stateSetAddState a
set StateType
type_ = IO Bool -> m Bool
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 StateSet
set' <- a -> IO (Ptr StateSet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
set
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (StateType -> Int) -> StateType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateType -> Int
forall a. Enum a => a -> Int
fromEnum) StateType
type_
    CInt
result <- Ptr StateSet -> CUInt -> IO CInt
atk_state_set_add_state Ptr StateSet
set' CUInt
type_'
    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
set
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StateSetAddStateMethodInfo
instance (signature ~ (Atk.Enums.StateType -> m Bool), MonadIO m, IsStateSet a) => O.OverloadedMethod StateSetAddStateMethodInfo a signature where
    overloadedMethod = stateSetAddState

instance O.OverloadedMethodInfo StateSetAddStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.StateSet.stateSetAddState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-StateSet.html#v:stateSetAddState"
        })


#endif

-- method StateSet::add_states
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkStateSet" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "types"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Atk" , name = "StateType" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of #AtkStateType"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_types"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The number of elements in the array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_types"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "The number of elements in the array"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_state_set_add_states" atk_state_set_add_states :: 
    Ptr StateSet ->                         -- set : TInterface (Name {namespace = "Atk", name = "StateSet"})
    Ptr CUInt ->                            -- types : TCArray False (-1) 2 (TInterface (Name {namespace = "Atk", name = "StateType"}))
    Int32 ->                                -- n_types : TBasicType TInt
    IO ()

-- | Adds the states of the specified types to the state set.
-- 
-- Note that because an t'GI.Atk.Objects.StateSet.StateSet' is a read-only object, this method should
-- be used to add states to a newly-created set which will then be returned by
-- @/atk_object_ref_state_set/@. It should not be used to modify the existing state
-- of an object. See also @/atk_object_notify_state_change/@.
stateSetAddStates ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateSet a) =>
    a
    -- ^ /@set@/: an t'GI.Atk.Objects.StateSet.StateSet'
    -> [Atk.Enums.StateType]
    -- ^ /@types@/: an array of t'GI.Atk.Enums.StateType'
    -> m ()
stateSetAddStates :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStateSet a) =>
a -> [StateType] -> m ()
stateSetAddStates a
set [StateType]
types = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nTypes :: Int32
nTypes = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [StateType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [StateType]
types
    Ptr StateSet
set' <- a -> IO (Ptr StateSet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
set
    let types' :: [CUInt]
types' = (StateType -> CUInt) -> [StateType] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (StateType -> Int) -> StateType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateType -> Int
forall a. Enum a => a -> Int
fromEnum) [StateType]
types
    Ptr CUInt
types'' <- [CUInt] -> IO (Ptr CUInt)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [CUInt]
types'
    Ptr StateSet -> Ptr CUInt -> Int32 -> IO ()
atk_state_set_add_states Ptr StateSet
set' Ptr CUInt
types'' Int32
nTypes
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
set
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
types''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StateSetAddStatesMethodInfo
instance (signature ~ ([Atk.Enums.StateType] -> m ()), MonadIO m, IsStateSet a) => O.OverloadedMethod StateSetAddStatesMethodInfo a signature where
    overloadedMethod = stateSetAddStates

instance O.OverloadedMethodInfo StateSetAddStatesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.StateSet.stateSetAddStates",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-StateSet.html#v:stateSetAddStates"
        })


#endif

-- method StateSet::and_sets
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkStateSet" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "compare_set"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another #AtkStateSet"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Atk" , name = "StateSet" })
-- throws : False
-- Skip return : False

foreign import ccall "atk_state_set_and_sets" atk_state_set_and_sets :: 
    Ptr StateSet ->                         -- set : TInterface (Name {namespace = "Atk", name = "StateSet"})
    Ptr StateSet ->                         -- compare_set : TInterface (Name {namespace = "Atk", name = "StateSet"})
    IO (Ptr StateSet)

-- | Constructs the intersection of the two sets, returning 'P.Nothing' if the
-- intersection is empty.
stateSetAndSets ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateSet a, IsStateSet b) =>
    a
    -- ^ /@set@/: an t'GI.Atk.Objects.StateSet.StateSet'
    -> b
    -- ^ /@compareSet@/: another t'GI.Atk.Objects.StateSet.StateSet'
    -> m StateSet
    -- ^ __Returns:__ a new t'GI.Atk.Objects.StateSet.StateSet' which is the intersection of
    -- the two sets.
stateSetAndSets :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsStateSet a, IsStateSet b) =>
a -> b -> m StateSet
stateSetAndSets a
set b
compareSet = IO StateSet -> m StateSet
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StateSet -> m StateSet) -> IO StateSet -> m StateSet
forall a b. (a -> b) -> a -> b
$ do
    Ptr StateSet
set' <- a -> IO (Ptr StateSet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
set
    Ptr StateSet
compareSet' <- b -> IO (Ptr StateSet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
compareSet
    Ptr StateSet
result <- Ptr StateSet -> Ptr StateSet -> IO (Ptr StateSet)
atk_state_set_and_sets Ptr StateSet
set' Ptr StateSet
compareSet'
    Text -> Ptr StateSet -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"stateSetAndSets" Ptr StateSet
result
    StateSet
result' <- ((ManagedPtr StateSet -> StateSet) -> Ptr StateSet -> IO StateSet
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr StateSet -> StateSet
StateSet) Ptr StateSet
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
set
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
compareSet
    StateSet -> IO StateSet
forall (m :: * -> *) a. Monad m => a -> m a
return StateSet
result'

#if defined(ENABLE_OVERLOADING)
data StateSetAndSetsMethodInfo
instance (signature ~ (b -> m StateSet), MonadIO m, IsStateSet a, IsStateSet b) => O.OverloadedMethod StateSetAndSetsMethodInfo a signature where
    overloadedMethod = stateSetAndSets

instance O.OverloadedMethodInfo StateSetAndSetsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.StateSet.stateSetAndSets",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-StateSet.html#v:stateSetAndSets"
        })


#endif

-- method StateSet::clear_states
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkStateSet" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_state_set_clear_states" atk_state_set_clear_states :: 
    Ptr StateSet ->                         -- set : TInterface (Name {namespace = "Atk", name = "StateSet"})
    IO ()

-- | Removes all states from the state set.
stateSetClearStates ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateSet a) =>
    a
    -- ^ /@set@/: an t'GI.Atk.Objects.StateSet.StateSet'
    -> m ()
stateSetClearStates :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStateSet a) =>
a -> m ()
stateSetClearStates a
set = 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 StateSet
set' <- a -> IO (Ptr StateSet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
set
    Ptr StateSet -> IO ()
atk_state_set_clear_states Ptr StateSet
set'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
set
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StateSetClearStatesMethodInfo
instance (signature ~ (m ()), MonadIO m, IsStateSet a) => O.OverloadedMethod StateSetClearStatesMethodInfo a signature where
    overloadedMethod = stateSetClearStates

instance O.OverloadedMethodInfo StateSetClearStatesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.StateSet.stateSetClearStates",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-StateSet.html#v:stateSetClearStates"
        })


#endif

-- method StateSet::contains_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkStateSet" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkStateType" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "atk_state_set_contains_state" atk_state_set_contains_state :: 
    Ptr StateSet ->                         -- set : TInterface (Name {namespace = "Atk", name = "StateSet"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Atk", name = "StateType"})
    IO CInt

-- | Checks whether the state for the specified type is in the specified set.
stateSetContainsState ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateSet a) =>
    a
    -- ^ /@set@/: an t'GI.Atk.Objects.StateSet.StateSet'
    -> Atk.Enums.StateType
    -- ^ /@type@/: an t'GI.Atk.Enums.StateType'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@type@/ is the state type is in /@set@/.
stateSetContainsState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStateSet a) =>
a -> StateType -> m Bool
stateSetContainsState a
set StateType
type_ = IO Bool -> m Bool
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 StateSet
set' <- a -> IO (Ptr StateSet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
set
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (StateType -> Int) -> StateType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateType -> Int
forall a. Enum a => a -> Int
fromEnum) StateType
type_
    CInt
result <- Ptr StateSet -> CUInt -> IO CInt
atk_state_set_contains_state Ptr StateSet
set' CUInt
type_'
    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
set
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StateSetContainsStateMethodInfo
instance (signature ~ (Atk.Enums.StateType -> m Bool), MonadIO m, IsStateSet a) => O.OverloadedMethod StateSetContainsStateMethodInfo a signature where
    overloadedMethod = stateSetContainsState

instance O.OverloadedMethodInfo StateSetContainsStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.StateSet.stateSetContainsState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-StateSet.html#v:stateSetContainsState"
        })


#endif

-- method StateSet::contains_states
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkStateSet" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "types"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Atk" , name = "StateType" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an array of #AtkStateType"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_types"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The number of elements in the array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_types"
--              , argType = TBasicType TInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "The number of elements in the array"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "atk_state_set_contains_states" atk_state_set_contains_states :: 
    Ptr StateSet ->                         -- set : TInterface (Name {namespace = "Atk", name = "StateSet"})
    Ptr CUInt ->                            -- types : TCArray False (-1) 2 (TInterface (Name {namespace = "Atk", name = "StateType"}))
    Int32 ->                                -- n_types : TBasicType TInt
    IO CInt

-- | Checks whether the states for all the specified types are in the
-- specified set.
stateSetContainsStates ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateSet a) =>
    a
    -- ^ /@set@/: an t'GI.Atk.Objects.StateSet.StateSet'
    -> [Atk.Enums.StateType]
    -- ^ /@types@/: an array of t'GI.Atk.Enums.StateType'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if all the states for /@type@/ are in /@set@/.
stateSetContainsStates :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStateSet a) =>
a -> [StateType] -> m Bool
stateSetContainsStates a
set [StateType]
types = IO Bool -> m Bool
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
    let nTypes :: Int32
nTypes = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ [StateType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [StateType]
types
    Ptr StateSet
set' <- a -> IO (Ptr StateSet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
set
    let types' :: [CUInt]
types' = (StateType -> CUInt) -> [StateType] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (StateType -> Int) -> StateType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateType -> Int
forall a. Enum a => a -> Int
fromEnum) [StateType]
types
    Ptr CUInt
types'' <- [CUInt] -> IO (Ptr CUInt)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [CUInt]
types'
    CInt
result <- Ptr StateSet -> Ptr CUInt -> Int32 -> IO CInt
atk_state_set_contains_states Ptr StateSet
set' Ptr CUInt
types'' Int32
nTypes
    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
set
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
types''
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StateSetContainsStatesMethodInfo
instance (signature ~ ([Atk.Enums.StateType] -> m Bool), MonadIO m, IsStateSet a) => O.OverloadedMethod StateSetContainsStatesMethodInfo a signature where
    overloadedMethod = stateSetContainsStates

instance O.OverloadedMethodInfo StateSetContainsStatesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.StateSet.stateSetContainsStates",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-StateSet.html#v:stateSetContainsStates"
        })


#endif

-- method StateSet::is_empty
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkStateType" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "atk_state_set_is_empty" atk_state_set_is_empty :: 
    Ptr StateSet ->                         -- set : TInterface (Name {namespace = "Atk", name = "StateSet"})
    IO CInt

-- | Checks whether the state set is empty, i.e. has no states set.
stateSetIsEmpty ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateSet a) =>
    a
    -- ^ /@set@/: an t'GI.Atk.Enums.StateType'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@set@/ has no states set, otherwise 'P.False'
stateSetIsEmpty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStateSet a) =>
a -> m Bool
stateSetIsEmpty a
set = IO Bool -> m Bool
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 StateSet
set' <- a -> IO (Ptr StateSet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
set
    CInt
result <- Ptr StateSet -> IO CInt
atk_state_set_is_empty Ptr StateSet
set'
    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
set
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StateSetIsEmptyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStateSet a) => O.OverloadedMethod StateSetIsEmptyMethodInfo a signature where
    overloadedMethod = stateSetIsEmpty

instance O.OverloadedMethodInfo StateSetIsEmptyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.StateSet.stateSetIsEmpty",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-StateSet.html#v:stateSetIsEmpty"
        })


#endif

-- method StateSet::or_sets
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkStateSet" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "compare_set"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another #AtkStateSet"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Atk" , name = "StateSet" })
-- throws : False
-- Skip return : False

foreign import ccall "atk_state_set_or_sets" atk_state_set_or_sets :: 
    Ptr StateSet ->                         -- set : TInterface (Name {namespace = "Atk", name = "StateSet"})
    Ptr StateSet ->                         -- compare_set : TInterface (Name {namespace = "Atk", name = "StateSet"})
    IO (Ptr StateSet)

-- | Constructs the union of the two sets.
stateSetOrSets ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateSet a, IsStateSet b) =>
    a
    -- ^ /@set@/: an t'GI.Atk.Objects.StateSet.StateSet'
    -> b
    -- ^ /@compareSet@/: another t'GI.Atk.Objects.StateSet.StateSet'
    -> m (Maybe StateSet)
    -- ^ __Returns:__ a new t'GI.Atk.Objects.StateSet.StateSet' which is
    -- the union of the two sets, returning 'P.Nothing' is empty.
stateSetOrSets :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsStateSet a, IsStateSet b) =>
a -> b -> m (Maybe StateSet)
stateSetOrSets a
set b
compareSet = IO (Maybe StateSet) -> m (Maybe StateSet)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe StateSet) -> m (Maybe StateSet))
-> IO (Maybe StateSet) -> m (Maybe StateSet)
forall a b. (a -> b) -> a -> b
$ do
    Ptr StateSet
set' <- a -> IO (Ptr StateSet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
set
    Ptr StateSet
compareSet' <- b -> IO (Ptr StateSet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
compareSet
    Ptr StateSet
result <- Ptr StateSet -> Ptr StateSet -> IO (Ptr StateSet)
atk_state_set_or_sets Ptr StateSet
set' Ptr StateSet
compareSet'
    Maybe StateSet
maybeResult <- Ptr StateSet
-> (Ptr StateSet -> IO StateSet) -> IO (Maybe StateSet)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr StateSet
result ((Ptr StateSet -> IO StateSet) -> IO (Maybe StateSet))
-> (Ptr StateSet -> IO StateSet) -> IO (Maybe StateSet)
forall a b. (a -> b) -> a -> b
$ \Ptr StateSet
result' -> do
        StateSet
result'' <- ((ManagedPtr StateSet -> StateSet) -> Ptr StateSet -> IO StateSet
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr StateSet -> StateSet
StateSet) Ptr StateSet
result'
        StateSet -> IO StateSet
forall (m :: * -> *) a. Monad m => a -> m a
return StateSet
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
set
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
compareSet
    Maybe StateSet -> IO (Maybe StateSet)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StateSet
maybeResult

#if defined(ENABLE_OVERLOADING)
data StateSetOrSetsMethodInfo
instance (signature ~ (b -> m (Maybe StateSet)), MonadIO m, IsStateSet a, IsStateSet b) => O.OverloadedMethod StateSetOrSetsMethodInfo a signature where
    overloadedMethod = stateSetOrSets

instance O.OverloadedMethodInfo StateSetOrSetsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.StateSet.stateSetOrSets",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-StateSet.html#v:stateSetOrSets"
        })


#endif

-- method StateSet::remove_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkStateSet" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkType" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "atk_state_set_remove_state" atk_state_set_remove_state :: 
    Ptr StateSet ->                         -- set : TInterface (Name {namespace = "Atk", name = "StateSet"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Atk", name = "StateType"})
    IO CInt

-- | Removes the state for the specified type from the state set.
-- 
-- Note that because an t'GI.Atk.Objects.StateSet.StateSet' is a read-only object, this method should
-- be used to remove a state to a newly-created set which will then be returned
-- by @/atk_object_ref_state_set/@. It should not be used to modify the existing
-- state of an object. See also @/atk_object_notify_state_change/@.
stateSetRemoveState ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateSet a) =>
    a
    -- ^ /@set@/: an t'GI.Atk.Objects.StateSet.StateSet'
    -> Atk.Enums.StateType
    -- ^ /@type@/: an @/AtkType/@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@type@/ was the state type is in /@set@/.
stateSetRemoveState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStateSet a) =>
a -> StateType -> m Bool
stateSetRemoveState a
set StateType
type_ = IO Bool -> m Bool
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 StateSet
set' <- a -> IO (Ptr StateSet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
set
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (StateType -> Int) -> StateType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateType -> Int
forall a. Enum a => a -> Int
fromEnum) StateType
type_
    CInt
result <- Ptr StateSet -> CUInt -> IO CInt
atk_state_set_remove_state Ptr StateSet
set' CUInt
type_'
    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
set
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StateSetRemoveStateMethodInfo
instance (signature ~ (Atk.Enums.StateType -> m Bool), MonadIO m, IsStateSet a) => O.OverloadedMethod StateSetRemoveStateMethodInfo a signature where
    overloadedMethod = stateSetRemoveState

instance O.OverloadedMethodInfo StateSetRemoveStateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.StateSet.stateSetRemoveState",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-StateSet.html#v:stateSetRemoveState"
        })


#endif

-- method StateSet::xor_sets
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "set"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkStateSet" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "compare_set"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "StateSet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another #AtkStateSet"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Atk" , name = "StateSet" })
-- throws : False
-- Skip return : False

foreign import ccall "atk_state_set_xor_sets" atk_state_set_xor_sets :: 
    Ptr StateSet ->                         -- set : TInterface (Name {namespace = "Atk", name = "StateSet"})
    Ptr StateSet ->                         -- compare_set : TInterface (Name {namespace = "Atk", name = "StateSet"})
    IO (Ptr StateSet)

-- | Constructs the exclusive-or of the two sets, returning 'P.Nothing' is empty.
-- The set returned by this operation contains the states in exactly
-- one of the two sets.
stateSetXorSets ::
    (B.CallStack.HasCallStack, MonadIO m, IsStateSet a, IsStateSet b) =>
    a
    -- ^ /@set@/: an t'GI.Atk.Objects.StateSet.StateSet'
    -> b
    -- ^ /@compareSet@/: another t'GI.Atk.Objects.StateSet.StateSet'
    -> m StateSet
    -- ^ __Returns:__ a new t'GI.Atk.Objects.StateSet.StateSet' which contains the states
    -- which are in exactly one of the two sets.
stateSetXorSets :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsStateSet a, IsStateSet b) =>
a -> b -> m StateSet
stateSetXorSets a
set b
compareSet = IO StateSet -> m StateSet
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StateSet -> m StateSet) -> IO StateSet -> m StateSet
forall a b. (a -> b) -> a -> b
$ do
    Ptr StateSet
set' <- a -> IO (Ptr StateSet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
set
    Ptr StateSet
compareSet' <- b -> IO (Ptr StateSet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
compareSet
    Ptr StateSet
result <- Ptr StateSet -> Ptr StateSet -> IO (Ptr StateSet)
atk_state_set_xor_sets Ptr StateSet
set' Ptr StateSet
compareSet'
    Text -> Ptr StateSet -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"stateSetXorSets" Ptr StateSet
result
    StateSet
result' <- ((ManagedPtr StateSet -> StateSet) -> Ptr StateSet -> IO StateSet
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr StateSet -> StateSet
StateSet) Ptr StateSet
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
set
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
compareSet
    StateSet -> IO StateSet
forall (m :: * -> *) a. Monad m => a -> m a
return StateSet
result'

#if defined(ENABLE_OVERLOADING)
data StateSetXorSetsMethodInfo
instance (signature ~ (b -> m StateSet), MonadIO m, IsStateSet a, IsStateSet b) => O.OverloadedMethod StateSetXorSetsMethodInfo a signature where
    overloadedMethod = stateSetXorSets

instance O.OverloadedMethodInfo StateSetXorSetsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Objects.StateSet.stateSetXorSets",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Objects-StateSet.html#v:stateSetXorSets"
        })


#endif