{-# language CPP #-}
-- No documentation found for Chapter "Input"
module OpenXR.Core10.Input  ( getActionStateBoolean
                            , getActionStateFloat
                            , getActionStateVector2f
                            , getActionStatePose
                            , createActionSet
                            , withActionSet
                            , destroyActionSet
                            , createAction
                            , withAction
                            , destroyAction
                            , suggestInteractionProfileBindings
                            , attachSessionActionSets
                            , getCurrentInteractionProfile
                            , syncActions
                            , enumerateBoundSourcesForAction
                            , getInputSourceLocalizedName
                            , Vector2f(..)
                            , ActionStateBoolean(..)
                            , ActionStateFloat(..)
                            , ActionStateVector2f(..)
                            , ActionStatePose(..)
                            , ActionStateGetInfo(..)
                            , ActionSetCreateInfo(..)
                            , ActionSuggestedBinding(..)
                            , InteractionProfileSuggestedBinding(..)
                            , ActiveActionSet(..)
                            , SessionActionSetsAttachInfo(..)
                            , ActionsSyncInfo(..)
                            , BoundSourcesForActionEnumerateInfo(..)
                            , InputSourceLocalizedNameGetInfo(..)
                            , InteractionProfileState(..)
                            , ActionCreateInfo(..)
                            ) where

import OpenXR.CStruct.Utils (FixedArray)
import OpenXR.Internal.Utils (traceAroundEvent)
import Control.Exception.Base (bracket)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Data.Typeable (eqT)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Marshal.Alloc (callocBytes)
import Foreign.Marshal.Alloc (free)
import GHC.Base (when)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import GHC.Ptr (nullFunPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Data.ByteString (packCString)
import Data.Coerce (coerce)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import Data.Vector (generateM)
import qualified Data.Vector (imapM_)
import qualified Data.Vector (length)
import qualified Data.Vector (null)
import Foreign.C.Types (CChar(..))
import OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.Zero (Zero(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Type.Equality ((:~:)(Refl))
import Data.Typeable (Typeable)
import Foreign.C.Types (CChar)
import Foreign.C.Types (CFloat)
import Foreign.C.Types (CFloat(..))
import Foreign.C.Types (CFloat(CFloat))
import Foreign.Storable (Storable)
import Foreign.Storable (Storable(peek))
import Foreign.Storable (Storable(poke))
import qualified Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import GHC.IO.Exception (IOErrorType(..))
import GHC.IO.Exception (IOException(..))
import Foreign.Ptr (FunPtr)
import Foreign.Ptr (Ptr)
import Data.Word (Word32)
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import Data.Vector (Vector)
import OpenXR.CStruct.Utils (advancePtrBytes)
import OpenXR.Core10.FundamentalTypes (bool32ToBool)
import OpenXR.Core10.FundamentalTypes (boolToBool32)
import OpenXR.CStruct.Extends (forgetExtensions)
import OpenXR.CStruct.Utils (lowerArrayPtr)
import OpenXR.CStruct.Utils (pokeFixedLengthNullTerminatedByteString)
import OpenXR.NamedType ((:::))
import OpenXR.Core10.Handles (Action)
import OpenXR.Core10.Handles (Action(..))
import OpenXR.Core10.Handles (Action(Action))
import OpenXR.Core10.Handles (ActionSet)
import OpenXR.Core10.Handles (ActionSet(..))
import OpenXR.Core10.Handles (ActionSet(ActionSet))
import OpenXR.Core10.Handles (ActionSet_T)
import OpenXR.Core10.Enums.ActionType (ActionType)
import OpenXR.Core10.Handles (Action_T)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_binding_modification (BindingModificationsKHR)
import OpenXR.Core10.FundamentalTypes (Bool32)
import OpenXR.CStruct.Extends (Chain)
import OpenXR.CStruct.Extends (Extends)
import OpenXR.CStruct.Extends (Extendss)
import OpenXR.CStruct.Extends (Extensible(..))
import OpenXR.Core10.Enums.InputSourceLocalizedNameFlags (InputSourceLocalizedNameFlags)
import OpenXR.Core10.Handles (Instance)
import OpenXR.Core10.Handles (Instance(..))
import OpenXR.Dynamic (InstanceCmds(pXrAttachSessionActionSets))
import OpenXR.Dynamic (InstanceCmds(pXrCreateAction))
import OpenXR.Dynamic (InstanceCmds(pXrCreateActionSet))
import OpenXR.Dynamic (InstanceCmds(pXrDestroyAction))
import OpenXR.Dynamic (InstanceCmds(pXrDestroyActionSet))
import OpenXR.Dynamic (InstanceCmds(pXrEnumerateBoundSourcesForAction))
import OpenXR.Dynamic (InstanceCmds(pXrGetActionStateBoolean))
import OpenXR.Dynamic (InstanceCmds(pXrGetActionStateFloat))
import OpenXR.Dynamic (InstanceCmds(pXrGetActionStatePose))
import OpenXR.Dynamic (InstanceCmds(pXrGetActionStateVector2f))
import OpenXR.Dynamic (InstanceCmds(pXrGetCurrentInteractionProfile))
import OpenXR.Dynamic (InstanceCmds(pXrGetInputSourceLocalizedName))
import OpenXR.Dynamic (InstanceCmds(pXrSuggestInteractionProfileBindings))
import OpenXR.Dynamic (InstanceCmds(pXrSyncActions))
import OpenXR.Core10.Handles (Instance_T)
import {-# SOURCE #-} OpenXR.Extensions.XR_VALVE_analog_threshold (InteractionProfileAnalogThresholdVALVE)
import OpenXR.Core10.APIConstants (MAX_ACTION_NAME_SIZE)
import OpenXR.Core10.APIConstants (MAX_ACTION_SET_NAME_SIZE)
import OpenXR.Core10.APIConstants (MAX_LOCALIZED_ACTION_NAME_SIZE)
import OpenXR.Core10.APIConstants (MAX_LOCALIZED_ACTION_SET_NAME_SIZE)
import OpenXR.Exception (OpenXrException(..))
import OpenXR.Core10.SemanticPaths (Path)
import OpenXR.Core10.SemanticPaths (Path(..))
import OpenXR.CStruct.Extends (PeekChain)
import OpenXR.CStruct.Extends (PeekChain(..))
import OpenXR.CStruct.Extends (PokeChain)
import OpenXR.CStruct.Extends (PokeChain(..))
import OpenXR.Core10.Enums.Result (Result)
import OpenXR.Core10.Enums.Result (Result(..))
import OpenXR.Core10.Handles (Session)
import OpenXR.Core10.Handles (Session(..))
import OpenXR.Core10.Handles (Session_T)
import OpenXR.CStruct.Extends (SomeStruct)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.FundamentalTypes (Time)
import OpenXR.Core10.Enums.Result (Result(SUCCESS))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_ACTIONS_SYNC_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_ACTION_CREATE_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_ACTION_SET_CREATE_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_ACTION_STATE_BOOLEAN))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_ACTION_STATE_FLOAT))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_ACTION_STATE_GET_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_ACTION_STATE_POSE))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_ACTION_STATE_VECTOR2F))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_BOUND_SOURCES_FOR_ACTION_ENUMERATE_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_INPUT_SOURCE_LOCALIZED_NAME_GET_INFO))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_INTERACTION_PROFILE_STATE))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_INTERACTION_PROFILE_SUGGESTED_BINDING))
import OpenXR.Core10.Enums.StructureType (StructureType(TYPE_SESSION_ACTION_SETS_ATTACH_INFO))
foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrGetActionStateBoolean
  :: FunPtr (Ptr Session_T -> Ptr ActionStateGetInfo -> Ptr ActionStateBoolean -> IO Result) -> Ptr Session_T -> Ptr ActionStateGetInfo -> Ptr ActionStateBoolean -> IO Result

-- | xrGetActionStateBoolean - Gets boolean action state
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTIONSET_NOT_ATTACHED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTION_TYPE_MISMATCH'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'
--
-- = See Also
--
-- 'ActionStateBoolean', 'ActionStateGetInfo',
-- 'OpenXR.Core10.Handles.Session', 'createAction'
getActionStateBoolean :: forall io
                       . (MonadIO io)
                      => -- | @session@ is the 'OpenXR.Core10.Handles.Session' to query.
                         --
                         -- #VUID-xrGetActionStateBoolean-session-parameter# @session@ /must/ be a
                         -- valid 'OpenXR.Core10.Handles.Session' handle
                         Session
                      -> -- | @getInfo@ is a pointer to 'ActionStateGetInfo' to provide action and
                         -- subaction paths information.
                         --
                         -- #VUID-xrGetActionStateBoolean-getInfo-parameter# @getInfo@ /must/ be a
                         -- pointer to a valid 'ActionStateGetInfo' structure
                         ActionStateGetInfo
                      -> io (Result, ActionStateBoolean)
getActionStateBoolean :: Session -> ActionStateGetInfo -> io (Result, ActionStateBoolean)
getActionStateBoolean session :: Session
session getInfo :: ActionStateGetInfo
getInfo = IO (Result, ActionStateBoolean) -> io (Result, ActionStateBoolean)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, ActionStateBoolean)
 -> io (Result, ActionStateBoolean))
-> (ContT
      (Result, ActionStateBoolean) IO (Result, ActionStateBoolean)
    -> IO (Result, ActionStateBoolean))
-> ContT
     (Result, ActionStateBoolean) IO (Result, ActionStateBoolean)
-> io (Result, ActionStateBoolean)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (Result, ActionStateBoolean) IO (Result, ActionStateBoolean)
-> IO (Result, ActionStateBoolean)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (Result, ActionStateBoolean) IO (Result, ActionStateBoolean)
 -> io (Result, ActionStateBoolean))
-> ContT
     (Result, ActionStateBoolean) IO (Result, ActionStateBoolean)
-> io (Result, ActionStateBoolean)
forall a b. (a -> b) -> a -> b
$ do
  let xrGetActionStateBooleanPtr :: FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateBoolean -> IO Result)
xrGetActionStateBooleanPtr = InstanceCmds
-> FunPtr
     (Ptr Session_T
      -> Ptr ActionStateGetInfo -> Ptr ActionStateBoolean -> IO Result)
pXrGetActionStateBoolean (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO () -> ContT (Result, ActionStateBoolean) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, ActionStateBoolean) IO ())
-> IO () -> ContT (Result, ActionStateBoolean) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateBoolean -> IO Result)
xrGetActionStateBooleanPtr FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateBoolean -> IO Result)
-> FunPtr
     (Ptr Session_T
      -> Ptr ActionStateGetInfo -> Ptr ActionStateBoolean -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateBoolean -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrGetActionStateBoolean is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrGetActionStateBoolean' :: Ptr Session_T
-> Ptr ActionStateGetInfo -> Ptr ActionStateBoolean -> IO Result
xrGetActionStateBoolean' = FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateBoolean -> IO Result)
-> Ptr Session_T
-> Ptr ActionStateGetInfo
-> Ptr ActionStateBoolean
-> IO Result
mkXrGetActionStateBoolean FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateBoolean -> IO Result)
xrGetActionStateBooleanPtr
  Ptr ActionStateGetInfo
getInfo' <- ((Ptr ActionStateGetInfo -> IO (Result, ActionStateBoolean))
 -> IO (Result, ActionStateBoolean))
-> ContT (Result, ActionStateBoolean) IO (Ptr ActionStateGetInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ActionStateGetInfo -> IO (Result, ActionStateBoolean))
  -> IO (Result, ActionStateBoolean))
 -> ContT (Result, ActionStateBoolean) IO (Ptr ActionStateGetInfo))
-> ((Ptr ActionStateGetInfo -> IO (Result, ActionStateBoolean))
    -> IO (Result, ActionStateBoolean))
-> ContT (Result, ActionStateBoolean) IO (Ptr ActionStateGetInfo)
forall a b. (a -> b) -> a -> b
$ ActionStateGetInfo
-> (Ptr ActionStateGetInfo -> IO (Result, ActionStateBoolean))
-> IO (Result, ActionStateBoolean)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ActionStateGetInfo
getInfo)
  Ptr ActionStateBoolean
pState <- ((Ptr ActionStateBoolean -> IO (Result, ActionStateBoolean))
 -> IO (Result, ActionStateBoolean))
-> ContT (Result, ActionStateBoolean) IO (Ptr ActionStateBoolean)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct ActionStateBoolean =>
(Ptr ActionStateBoolean -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @ActionStateBoolean)
  Result
r <- IO Result -> ContT (Result, ActionStateBoolean) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, ActionStateBoolean) IO Result)
-> IO Result -> ContT (Result, ActionStateBoolean) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrGetActionStateBoolean" (Ptr Session_T
-> Ptr ActionStateGetInfo -> Ptr ActionStateBoolean -> IO Result
xrGetActionStateBoolean' (Session -> Ptr Session_T
sessionHandle (Session
session)) Ptr ActionStateGetInfo
getInfo' (Ptr ActionStateBoolean
pState))
  IO () -> ContT (Result, ActionStateBoolean) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, ActionStateBoolean) IO ())
-> IO () -> ContT (Result, ActionStateBoolean) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  ActionStateBoolean
state <- IO ActionStateBoolean
-> ContT (Result, ActionStateBoolean) IO ActionStateBoolean
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ActionStateBoolean
 -> ContT (Result, ActionStateBoolean) IO ActionStateBoolean)
-> IO ActionStateBoolean
-> ContT (Result, ActionStateBoolean) IO ActionStateBoolean
forall a b. (a -> b) -> a -> b
$ Ptr ActionStateBoolean -> IO ActionStateBoolean
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ActionStateBoolean Ptr ActionStateBoolean
pState
  (Result, ActionStateBoolean)
-> ContT
     (Result, ActionStateBoolean) IO (Result, ActionStateBoolean)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, ActionStateBoolean)
 -> ContT
      (Result, ActionStateBoolean) IO (Result, ActionStateBoolean))
-> (Result, ActionStateBoolean)
-> ContT
     (Result, ActionStateBoolean) IO (Result, ActionStateBoolean)
forall a b. (a -> b) -> a -> b
$ (Result
r, ActionStateBoolean
state)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrGetActionStateFloat
  :: FunPtr (Ptr Session_T -> Ptr ActionStateGetInfo -> Ptr ActionStateFloat -> IO Result) -> Ptr Session_T -> Ptr ActionStateGetInfo -> Ptr ActionStateFloat -> IO Result

-- | xrGetActionStateFloat - Gets a floating point action state
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTIONSET_NOT_ATTACHED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTION_TYPE_MISMATCH'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'
--
-- = See Also
--
-- 'ActionStateFloat', 'ActionStateGetInfo',
-- 'OpenXR.Core10.Handles.Session', 'createAction'
getActionStateFloat :: forall io
                     . (MonadIO io)
                    => -- | @session@ is the 'OpenXR.Core10.Handles.Session' to query.
                       --
                       -- #VUID-xrGetActionStateFloat-session-parameter# @session@ /must/ be a
                       -- valid 'OpenXR.Core10.Handles.Session' handle
                       Session
                    -> -- | @getInfo@ is a pointer to 'ActionStateGetInfo' to provide action and
                       -- subaction paths information.
                       --
                       -- #VUID-xrGetActionStateFloat-getInfo-parameter# @getInfo@ /must/ be a
                       -- pointer to a valid 'ActionStateGetInfo' structure
                       ActionStateGetInfo
                    -> io (Result, ActionStateFloat)
getActionStateFloat :: Session -> ActionStateGetInfo -> io (Result, ActionStateFloat)
getActionStateFloat session :: Session
session getInfo :: ActionStateGetInfo
getInfo = IO (Result, ActionStateFloat) -> io (Result, ActionStateFloat)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, ActionStateFloat) -> io (Result, ActionStateFloat))
-> (ContT (Result, ActionStateFloat) IO (Result, ActionStateFloat)
    -> IO (Result, ActionStateFloat))
-> ContT (Result, ActionStateFloat) IO (Result, ActionStateFloat)
-> io (Result, ActionStateFloat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (Result, ActionStateFloat) IO (Result, ActionStateFloat)
-> IO (Result, ActionStateFloat)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (Result, ActionStateFloat) IO (Result, ActionStateFloat)
 -> io (Result, ActionStateFloat))
-> ContT (Result, ActionStateFloat) IO (Result, ActionStateFloat)
-> io (Result, ActionStateFloat)
forall a b. (a -> b) -> a -> b
$ do
  let xrGetActionStateFloatPtr :: FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateFloat -> IO Result)
xrGetActionStateFloatPtr = InstanceCmds
-> FunPtr
     (Ptr Session_T
      -> Ptr ActionStateGetInfo -> Ptr ActionStateFloat -> IO Result)
pXrGetActionStateFloat (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO () -> ContT (Result, ActionStateFloat) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, ActionStateFloat) IO ())
-> IO () -> ContT (Result, ActionStateFloat) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateFloat -> IO Result)
xrGetActionStateFloatPtr FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateFloat -> IO Result)
-> FunPtr
     (Ptr Session_T
      -> Ptr ActionStateGetInfo -> Ptr ActionStateFloat -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateFloat -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrGetActionStateFloat is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrGetActionStateFloat' :: Ptr Session_T
-> Ptr ActionStateGetInfo -> Ptr ActionStateFloat -> IO Result
xrGetActionStateFloat' = FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateFloat -> IO Result)
-> Ptr Session_T
-> Ptr ActionStateGetInfo
-> Ptr ActionStateFloat
-> IO Result
mkXrGetActionStateFloat FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateFloat -> IO Result)
xrGetActionStateFloatPtr
  Ptr ActionStateGetInfo
getInfo' <- ((Ptr ActionStateGetInfo -> IO (Result, ActionStateFloat))
 -> IO (Result, ActionStateFloat))
-> ContT (Result, ActionStateFloat) IO (Ptr ActionStateGetInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ActionStateGetInfo -> IO (Result, ActionStateFloat))
  -> IO (Result, ActionStateFloat))
 -> ContT (Result, ActionStateFloat) IO (Ptr ActionStateGetInfo))
-> ((Ptr ActionStateGetInfo -> IO (Result, ActionStateFloat))
    -> IO (Result, ActionStateFloat))
-> ContT (Result, ActionStateFloat) IO (Ptr ActionStateGetInfo)
forall a b. (a -> b) -> a -> b
$ ActionStateGetInfo
-> (Ptr ActionStateGetInfo -> IO (Result, ActionStateFloat))
-> IO (Result, ActionStateFloat)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ActionStateGetInfo
getInfo)
  Ptr ActionStateFloat
pState <- ((Ptr ActionStateFloat -> IO (Result, ActionStateFloat))
 -> IO (Result, ActionStateFloat))
-> ContT (Result, ActionStateFloat) IO (Ptr ActionStateFloat)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct ActionStateFloat =>
(Ptr ActionStateFloat -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @ActionStateFloat)
  Result
r <- IO Result -> ContT (Result, ActionStateFloat) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, ActionStateFloat) IO Result)
-> IO Result -> ContT (Result, ActionStateFloat) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrGetActionStateFloat" (Ptr Session_T
-> Ptr ActionStateGetInfo -> Ptr ActionStateFloat -> IO Result
xrGetActionStateFloat' (Session -> Ptr Session_T
sessionHandle (Session
session)) Ptr ActionStateGetInfo
getInfo' (Ptr ActionStateFloat
pState))
  IO () -> ContT (Result, ActionStateFloat) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, ActionStateFloat) IO ())
-> IO () -> ContT (Result, ActionStateFloat) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  ActionStateFloat
state <- IO ActionStateFloat
-> ContT (Result, ActionStateFloat) IO ActionStateFloat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ActionStateFloat
 -> ContT (Result, ActionStateFloat) IO ActionStateFloat)
-> IO ActionStateFloat
-> ContT (Result, ActionStateFloat) IO ActionStateFloat
forall a b. (a -> b) -> a -> b
$ Ptr ActionStateFloat -> IO ActionStateFloat
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ActionStateFloat Ptr ActionStateFloat
pState
  (Result, ActionStateFloat)
-> ContT (Result, ActionStateFloat) IO (Result, ActionStateFloat)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, ActionStateFloat)
 -> ContT (Result, ActionStateFloat) IO (Result, ActionStateFloat))
-> (Result, ActionStateFloat)
-> ContT (Result, ActionStateFloat) IO (Result, ActionStateFloat)
forall a b. (a -> b) -> a -> b
$ (Result
r, ActionStateFloat
state)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrGetActionStateVector2f
  :: FunPtr (Ptr Session_T -> Ptr ActionStateGetInfo -> Ptr ActionStateVector2f -> IO Result) -> Ptr Session_T -> Ptr ActionStateGetInfo -> Ptr ActionStateVector2f -> IO Result

-- | xrGetActionStateVector2f - Gets 2D float vector action state
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTIONSET_NOT_ATTACHED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTION_TYPE_MISMATCH'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'
--
-- = See Also
--
-- 'ActionStateGetInfo', 'ActionStateVector2f',
-- 'OpenXR.Core10.Handles.Session', 'createAction'
getActionStateVector2f :: forall io
                        . (MonadIO io)
                       => -- | @session@ is the 'OpenXR.Core10.Handles.Session' to query.
                          --
                          -- #VUID-xrGetActionStateVector2f-session-parameter# @session@ /must/ be a
                          -- valid 'OpenXR.Core10.Handles.Session' handle
                          Session
                       -> -- | @getInfo@ is a pointer to 'ActionStateGetInfo' to provide action and
                          -- subaction paths information.
                          --
                          -- #VUID-xrGetActionStateVector2f-getInfo-parameter# @getInfo@ /must/ be a
                          -- pointer to a valid 'ActionStateGetInfo' structure
                          ActionStateGetInfo
                       -> io (Result, ActionStateVector2f)
getActionStateVector2f :: Session -> ActionStateGetInfo -> io (Result, ActionStateVector2f)
getActionStateVector2f session :: Session
session getInfo :: ActionStateGetInfo
getInfo = IO (Result, ActionStateVector2f)
-> io (Result, ActionStateVector2f)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, ActionStateVector2f)
 -> io (Result, ActionStateVector2f))
-> (ContT
      (Result, ActionStateVector2f) IO (Result, ActionStateVector2f)
    -> IO (Result, ActionStateVector2f))
-> ContT
     (Result, ActionStateVector2f) IO (Result, ActionStateVector2f)
-> io (Result, ActionStateVector2f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, ActionStateVector2f) IO (Result, ActionStateVector2f)
-> IO (Result, ActionStateVector2f)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, ActionStateVector2f) IO (Result, ActionStateVector2f)
 -> io (Result, ActionStateVector2f))
-> ContT
     (Result, ActionStateVector2f) IO (Result, ActionStateVector2f)
-> io (Result, ActionStateVector2f)
forall a b. (a -> b) -> a -> b
$ do
  let xrGetActionStateVector2fPtr :: FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateVector2f -> IO Result)
xrGetActionStateVector2fPtr = InstanceCmds
-> FunPtr
     (Ptr Session_T
      -> Ptr ActionStateGetInfo -> Ptr ActionStateVector2f -> IO Result)
pXrGetActionStateVector2f (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO () -> ContT (Result, ActionStateVector2f) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, ActionStateVector2f) IO ())
-> IO () -> ContT (Result, ActionStateVector2f) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateVector2f -> IO Result)
xrGetActionStateVector2fPtr FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateVector2f -> IO Result)
-> FunPtr
     (Ptr Session_T
      -> Ptr ActionStateGetInfo -> Ptr ActionStateVector2f -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateVector2f -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrGetActionStateVector2f is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrGetActionStateVector2f' :: Ptr Session_T
-> Ptr ActionStateGetInfo -> Ptr ActionStateVector2f -> IO Result
xrGetActionStateVector2f' = FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateVector2f -> IO Result)
-> Ptr Session_T
-> Ptr ActionStateGetInfo
-> Ptr ActionStateVector2f
-> IO Result
mkXrGetActionStateVector2f FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStateVector2f -> IO Result)
xrGetActionStateVector2fPtr
  Ptr ActionStateGetInfo
getInfo' <- ((Ptr ActionStateGetInfo -> IO (Result, ActionStateVector2f))
 -> IO (Result, ActionStateVector2f))
-> ContT (Result, ActionStateVector2f) IO (Ptr ActionStateGetInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ActionStateGetInfo -> IO (Result, ActionStateVector2f))
  -> IO (Result, ActionStateVector2f))
 -> ContT (Result, ActionStateVector2f) IO (Ptr ActionStateGetInfo))
-> ((Ptr ActionStateGetInfo -> IO (Result, ActionStateVector2f))
    -> IO (Result, ActionStateVector2f))
-> ContT (Result, ActionStateVector2f) IO (Ptr ActionStateGetInfo)
forall a b. (a -> b) -> a -> b
$ ActionStateGetInfo
-> (Ptr ActionStateGetInfo -> IO (Result, ActionStateVector2f))
-> IO (Result, ActionStateVector2f)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ActionStateGetInfo
getInfo)
  Ptr ActionStateVector2f
pState <- ((Ptr ActionStateVector2f -> IO (Result, ActionStateVector2f))
 -> IO (Result, ActionStateVector2f))
-> ContT (Result, ActionStateVector2f) IO (Ptr ActionStateVector2f)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct ActionStateVector2f =>
(Ptr ActionStateVector2f -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @ActionStateVector2f)
  Result
r <- IO Result -> ContT (Result, ActionStateVector2f) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, ActionStateVector2f) IO Result)
-> IO Result -> ContT (Result, ActionStateVector2f) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrGetActionStateVector2f" (Ptr Session_T
-> Ptr ActionStateGetInfo -> Ptr ActionStateVector2f -> IO Result
xrGetActionStateVector2f' (Session -> Ptr Session_T
sessionHandle (Session
session)) Ptr ActionStateGetInfo
getInfo' (Ptr ActionStateVector2f
pState))
  IO () -> ContT (Result, ActionStateVector2f) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, ActionStateVector2f) IO ())
-> IO () -> ContT (Result, ActionStateVector2f) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  ActionStateVector2f
state <- IO ActionStateVector2f
-> ContT (Result, ActionStateVector2f) IO ActionStateVector2f
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ActionStateVector2f
 -> ContT (Result, ActionStateVector2f) IO ActionStateVector2f)
-> IO ActionStateVector2f
-> ContT (Result, ActionStateVector2f) IO ActionStateVector2f
forall a b. (a -> b) -> a -> b
$ Ptr ActionStateVector2f -> IO ActionStateVector2f
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ActionStateVector2f Ptr ActionStateVector2f
pState
  (Result, ActionStateVector2f)
-> ContT
     (Result, ActionStateVector2f) IO (Result, ActionStateVector2f)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, ActionStateVector2f)
 -> ContT
      (Result, ActionStateVector2f) IO (Result, ActionStateVector2f))
-> (Result, ActionStateVector2f)
-> ContT
     (Result, ActionStateVector2f) IO (Result, ActionStateVector2f)
forall a b. (a -> b) -> a -> b
$ (Result
r, ActionStateVector2f
state)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrGetActionStatePose
  :: FunPtr (Ptr Session_T -> Ptr ActionStateGetInfo -> Ptr ActionStatePose -> IO Result) -> Ptr Session_T -> Ptr ActionStateGetInfo -> Ptr ActionStatePose -> IO Result

-- | xrGetActionStatePose - Gets metadata from a pose action
--
-- == Parameter Descriptions
--
-- = Description
--
-- 'getActionStatePose' returns information about the binding and active
-- state for the specified action. To determine the pose of this action at
-- a historical or predicted time, the application /can/ create an action
-- space using 'OpenXR.Core10.Space.createActionSpace'. Then, after each
-- sync, the application /can/ locate the pose of this action space within
-- a base space using 'OpenXR.Core10.Space.locateSpace'.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTIONSET_NOT_ATTACHED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTION_TYPE_MISMATCH'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'
--
-- = See Also
--
-- 'ActionStateGetInfo', 'ActionStatePose',
-- 'OpenXR.Core10.Handles.Session', 'createAction',
-- 'OpenXR.Core10.Space.createActionSpace'
getActionStatePose :: forall io
                    . (MonadIO io)
                   => -- | @session@ is the 'OpenXR.Core10.Handles.Session' to query.
                      --
                      -- #VUID-xrGetActionStatePose-session-parameter# @session@ /must/ be a
                      -- valid 'OpenXR.Core10.Handles.Session' handle
                      Session
                   -> -- | @getInfo@ is a pointer to 'ActionStateGetInfo' to provide action and
                      -- subaction paths information.
                      --
                      -- #VUID-xrGetActionStatePose-getInfo-parameter# @getInfo@ /must/ be a
                      -- pointer to a valid 'ActionStateGetInfo' structure
                      ActionStateGetInfo
                   -> io (Result, ActionStatePose)
getActionStatePose :: Session -> ActionStateGetInfo -> io (Result, ActionStatePose)
getActionStatePose session :: Session
session getInfo :: ActionStateGetInfo
getInfo = IO (Result, ActionStatePose) -> io (Result, ActionStatePose)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, ActionStatePose) -> io (Result, ActionStatePose))
-> (ContT (Result, ActionStatePose) IO (Result, ActionStatePose)
    -> IO (Result, ActionStatePose))
-> ContT (Result, ActionStatePose) IO (Result, ActionStatePose)
-> io (Result, ActionStatePose)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT (Result, ActionStatePose) IO (Result, ActionStatePose)
-> IO (Result, ActionStatePose)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT (Result, ActionStatePose) IO (Result, ActionStatePose)
 -> io (Result, ActionStatePose))
-> ContT (Result, ActionStatePose) IO (Result, ActionStatePose)
-> io (Result, ActionStatePose)
forall a b. (a -> b) -> a -> b
$ do
  let xrGetActionStatePosePtr :: FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStatePose -> IO Result)
xrGetActionStatePosePtr = InstanceCmds
-> FunPtr
     (Ptr Session_T
      -> Ptr ActionStateGetInfo -> Ptr ActionStatePose -> IO Result)
pXrGetActionStatePose (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO () -> ContT (Result, ActionStatePose) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, ActionStatePose) IO ())
-> IO () -> ContT (Result, ActionStatePose) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStatePose -> IO Result)
xrGetActionStatePosePtr FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStatePose -> IO Result)
-> FunPtr
     (Ptr Session_T
      -> Ptr ActionStateGetInfo -> Ptr ActionStatePose -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStatePose -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrGetActionStatePose is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrGetActionStatePose' :: Ptr Session_T
-> Ptr ActionStateGetInfo -> Ptr ActionStatePose -> IO Result
xrGetActionStatePose' = FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStatePose -> IO Result)
-> Ptr Session_T
-> Ptr ActionStateGetInfo
-> Ptr ActionStatePose
-> IO Result
mkXrGetActionStatePose FunPtr
  (Ptr Session_T
   -> Ptr ActionStateGetInfo -> Ptr ActionStatePose -> IO Result)
xrGetActionStatePosePtr
  Ptr ActionStateGetInfo
getInfo' <- ((Ptr ActionStateGetInfo -> IO (Result, ActionStatePose))
 -> IO (Result, ActionStatePose))
-> ContT (Result, ActionStatePose) IO (Ptr ActionStateGetInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ActionStateGetInfo -> IO (Result, ActionStatePose))
  -> IO (Result, ActionStatePose))
 -> ContT (Result, ActionStatePose) IO (Ptr ActionStateGetInfo))
-> ((Ptr ActionStateGetInfo -> IO (Result, ActionStatePose))
    -> IO (Result, ActionStatePose))
-> ContT (Result, ActionStatePose) IO (Ptr ActionStateGetInfo)
forall a b. (a -> b) -> a -> b
$ ActionStateGetInfo
-> (Ptr ActionStateGetInfo -> IO (Result, ActionStatePose))
-> IO (Result, ActionStatePose)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ActionStateGetInfo
getInfo)
  Ptr ActionStatePose
pState <- ((Ptr ActionStatePose -> IO (Result, ActionStatePose))
 -> IO (Result, ActionStatePose))
-> ContT (Result, ActionStatePose) IO (Ptr ActionStatePose)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct ActionStatePose =>
(Ptr ActionStatePose -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @ActionStatePose)
  Result
r <- IO Result -> ContT (Result, ActionStatePose) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, ActionStatePose) IO Result)
-> IO Result -> ContT (Result, ActionStatePose) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrGetActionStatePose" (Ptr Session_T
-> Ptr ActionStateGetInfo -> Ptr ActionStatePose -> IO Result
xrGetActionStatePose' (Session -> Ptr Session_T
sessionHandle (Session
session)) Ptr ActionStateGetInfo
getInfo' (Ptr ActionStatePose
pState))
  IO () -> ContT (Result, ActionStatePose) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, ActionStatePose) IO ())
-> IO () -> ContT (Result, ActionStatePose) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  ActionStatePose
state <- IO ActionStatePose
-> ContT (Result, ActionStatePose) IO ActionStatePose
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ActionStatePose
 -> ContT (Result, ActionStatePose) IO ActionStatePose)
-> IO ActionStatePose
-> ContT (Result, ActionStatePose) IO ActionStatePose
forall a b. (a -> b) -> a -> b
$ Ptr ActionStatePose -> IO ActionStatePose
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ActionStatePose Ptr ActionStatePose
pState
  (Result, ActionStatePose)
-> ContT (Result, ActionStatePose) IO (Result, ActionStatePose)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, ActionStatePose)
 -> ContT (Result, ActionStatePose) IO (Result, ActionStatePose))
-> (Result, ActionStatePose)
-> ContT (Result, ActionStatePose) IO (Result, ActionStatePose)
forall a b. (a -> b) -> a -> b
$ (Result
r, ActionStatePose
state)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrCreateActionSet
  :: FunPtr (Ptr Instance_T -> Ptr ActionSetCreateInfo -> Ptr (Ptr ActionSet_T) -> IO Result) -> Ptr Instance_T -> Ptr ActionSetCreateInfo -> Ptr (Ptr ActionSet_T) -> IO Result

-- | xrCreateActionSet - Creates an XrActionSet
--
-- == Parameter Descriptions
--
-- = Description
--
-- The 'createActionSet' function creates an action set and returns a
-- handle to the created action set.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_LIMIT_REACHED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_OUT_OF_MEMORY'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_NAME_DUPLICATED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_LOCALIZED_NAME_DUPLICATED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_NAME_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_LOCALIZED_NAME_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_FORMAT_INVALID'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.ActionSet', 'ActionSetCreateInfo',
-- 'OpenXR.Core10.Handles.Instance', 'destroyActionSet'
createActionSet :: forall io
                 . (MonadIO io)
                => -- | @instance@ is a handle to an 'OpenXR.Core10.Handles.Instance'.
                   --
                   -- #VUID-xrCreateActionSet-instance-parameter# @instance@ /must/ be a valid
                   -- 'OpenXR.Core10.Handles.Instance' handle
                   Instance
                -> -- | @createInfo@ is a pointer to a valid 'ActionSetCreateInfo' structure
                   -- that defines the action set being created.
                   --
                   -- #VUID-xrCreateActionSet-createInfo-parameter# @createInfo@ /must/ be a
                   -- pointer to a valid 'ActionSetCreateInfo' structure
                   ActionSetCreateInfo
                -> io (ActionSet)
createActionSet :: Instance -> ActionSetCreateInfo -> io ActionSet
createActionSet instance' :: Instance
instance' createInfo :: ActionSetCreateInfo
createInfo = IO ActionSet -> io ActionSet
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionSet -> io ActionSet)
-> (ContT ActionSet IO ActionSet -> IO ActionSet)
-> ContT ActionSet IO ActionSet
-> io ActionSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ActionSet IO ActionSet -> IO ActionSet
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT ActionSet IO ActionSet -> io ActionSet)
-> ContT ActionSet IO ActionSet -> io ActionSet
forall a b. (a -> b) -> a -> b
$ do
  let cmds :: InstanceCmds
cmds = Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance)
  let xrCreateActionSetPtr :: FunPtr
  (Ptr Instance_T
   -> Ptr ActionSetCreateInfo
   -> ("actionSet" ::: Ptr (Ptr ActionSet_T))
   -> IO Result)
xrCreateActionSetPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> Ptr ActionSetCreateInfo
      -> ("actionSet" ::: Ptr (Ptr ActionSet_T))
      -> IO Result)
pXrCreateActionSet InstanceCmds
cmds
  IO () -> ContT ActionSet IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ActionSet IO ()) -> IO () -> ContT ActionSet IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> Ptr ActionSetCreateInfo
   -> ("actionSet" ::: Ptr (Ptr ActionSet_T))
   -> IO Result)
xrCreateActionSetPtr FunPtr
  (Ptr Instance_T
   -> Ptr ActionSetCreateInfo
   -> ("actionSet" ::: Ptr (Ptr ActionSet_T))
   -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> Ptr ActionSetCreateInfo
      -> ("actionSet" ::: Ptr (Ptr ActionSet_T))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> Ptr ActionSetCreateInfo
   -> ("actionSet" ::: Ptr (Ptr ActionSet_T))
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrCreateActionSet is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrCreateActionSet' :: Ptr Instance_T
-> Ptr ActionSetCreateInfo
-> ("actionSet" ::: Ptr (Ptr ActionSet_T))
-> IO Result
xrCreateActionSet' = FunPtr
  (Ptr Instance_T
   -> Ptr ActionSetCreateInfo
   -> ("actionSet" ::: Ptr (Ptr ActionSet_T))
   -> IO Result)
-> Ptr Instance_T
-> Ptr ActionSetCreateInfo
-> ("actionSet" ::: Ptr (Ptr ActionSet_T))
-> IO Result
mkXrCreateActionSet FunPtr
  (Ptr Instance_T
   -> Ptr ActionSetCreateInfo
   -> ("actionSet" ::: Ptr (Ptr ActionSet_T))
   -> IO Result)
xrCreateActionSetPtr
  Ptr ActionSetCreateInfo
createInfo' <- ((Ptr ActionSetCreateInfo -> IO ActionSet) -> IO ActionSet)
-> ContT ActionSet IO (Ptr ActionSetCreateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ActionSetCreateInfo -> IO ActionSet) -> IO ActionSet)
 -> ContT ActionSet IO (Ptr ActionSetCreateInfo))
-> ((Ptr ActionSetCreateInfo -> IO ActionSet) -> IO ActionSet)
-> ContT ActionSet IO (Ptr ActionSetCreateInfo)
forall a b. (a -> b) -> a -> b
$ ActionSetCreateInfo
-> (Ptr ActionSetCreateInfo -> IO ActionSet) -> IO ActionSet
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ActionSetCreateInfo
createInfo)
  "actionSet" ::: Ptr (Ptr ActionSet_T)
pActionSet <- ((("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO ActionSet)
 -> IO ActionSet)
-> ContT ActionSet IO ("actionSet" ::: Ptr (Ptr ActionSet_T))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO ActionSet)
  -> IO ActionSet)
 -> ContT ActionSet IO ("actionSet" ::: Ptr (Ptr ActionSet_T)))
-> ((("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO ActionSet)
    -> IO ActionSet)
-> ContT ActionSet IO ("actionSet" ::: Ptr (Ptr ActionSet_T))
forall a b. (a -> b) -> a -> b
$ IO ("actionSet" ::: Ptr (Ptr ActionSet_T))
-> (("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO ())
-> (("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO ActionSet)
-> IO ActionSet
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("actionSet" ::: Ptr (Ptr ActionSet_T))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr ActionSet_T) 8) ("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT ActionSet IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT ActionSet IO Result)
-> IO Result -> ContT ActionSet IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrCreateActionSet" (Ptr Instance_T
-> Ptr ActionSetCreateInfo
-> ("actionSet" ::: Ptr (Ptr ActionSet_T))
-> IO Result
xrCreateActionSet' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) Ptr ActionSetCreateInfo
createInfo' ("actionSet" ::: Ptr (Ptr ActionSet_T)
pActionSet))
  IO () -> ContT ActionSet IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT ActionSet IO ()) -> IO () -> ContT ActionSet IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  Ptr ActionSet_T
actionSet <- IO (Ptr ActionSet_T) -> ContT ActionSet IO (Ptr ActionSet_T)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Ptr ActionSet_T) -> ContT ActionSet IO (Ptr ActionSet_T))
-> IO (Ptr ActionSet_T) -> ContT ActionSet IO (Ptr ActionSet_T)
forall a b. (a -> b) -> a -> b
$ ("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO (Ptr ActionSet_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ActionSet_T) "actionSet" ::: Ptr (Ptr ActionSet_T)
pActionSet
  ActionSet -> ContT ActionSet IO ActionSet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionSet -> ContT ActionSet IO ActionSet)
-> ActionSet -> ContT ActionSet IO ActionSet
forall a b. (a -> b) -> a -> b
$ (((\h :: Ptr ActionSet_T
h -> Ptr ActionSet_T -> InstanceCmds -> ActionSet
ActionSet Ptr ActionSet_T
h InstanceCmds
cmds ) Ptr ActionSet_T
actionSet))

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createActionSet' and 'destroyActionSet'
--
-- To ensure that 'destroyActionSet' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the last argument.
-- To just extract the pair pass '(,)' as the last argument.
--
withActionSet :: forall io r . MonadIO io => Instance -> ActionSetCreateInfo -> (io ActionSet -> (ActionSet -> io ()) -> r) -> r
withActionSet :: Instance
-> ActionSetCreateInfo
-> (io ActionSet -> (ActionSet -> io ()) -> r)
-> r
withActionSet instance' :: Instance
instance' createInfo :: ActionSetCreateInfo
createInfo b :: io ActionSet -> (ActionSet -> io ()) -> r
b =
  io ActionSet -> (ActionSet -> io ()) -> r
b (Instance -> ActionSetCreateInfo -> io ActionSet
forall (io :: * -> *).
MonadIO io =>
Instance -> ActionSetCreateInfo -> io ActionSet
createActionSet Instance
instance' ActionSetCreateInfo
createInfo)
    (\(ActionSet
o0) -> ActionSet -> io ()
forall (io :: * -> *). MonadIO io => ActionSet -> io ()
destroyActionSet ActionSet
o0)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrDestroyActionSet
  :: FunPtr (Ptr ActionSet_T -> IO Result) -> Ptr ActionSet_T -> IO Result

-- | xrDestroyActionSet - Destroys an XrActionSet
--
-- == Parameter Descriptions
--
-- = Description
--
-- Action set handles /can/ be destroyed by calling 'destroyActionSet'.
-- When an action set handle is destroyed, all handles of actions in that
-- action set are also destroyed.
--
-- The implementation /must/ not free underlying resources for the action
-- set while there are other valid handles that refer to those resources.
-- The implementation /may/ release resources for an action set when all of
-- the action spaces for actions in that action set have been destroyed.
-- See
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#spaces-action-spaces-lifetime Action Spaces Lifetime>
-- for details.
--
-- Resources for all action sets in an instance /must/ be freed when the
-- instance containing those actions sets is destroyed.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrDestroyActionSet-actionSet-parameter# @actionSet@ /must/ be
--     a valid 'OpenXR.Core10.Handles.ActionSet' handle
--
-- == Thread Safety
--
-- -   Access to @actionSet@, and any child handles, /must/ be externally
--     synchronized
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.ActionSet', 'createActionSet'
destroyActionSet :: forall io
                  . (MonadIO io)
                 => -- | @actionSet@ is the action set to destroy.
                    ActionSet
                 -> io ()
destroyActionSet :: ActionSet -> io ()
destroyActionSet actionSet :: ActionSet
actionSet = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let xrDestroyActionSetPtr :: FunPtr (Ptr ActionSet_T -> IO Result)
xrDestroyActionSetPtr = InstanceCmds -> FunPtr (Ptr ActionSet_T -> IO Result)
pXrDestroyActionSet (ActionSet -> InstanceCmds
instanceCmds (ActionSet
actionSet :: ActionSet))
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr ActionSet_T -> IO Result)
xrDestroyActionSetPtr FunPtr (Ptr ActionSet_T -> IO Result)
-> FunPtr (Ptr ActionSet_T -> IO Result) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr ActionSet_T -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrDestroyActionSet is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrDestroyActionSet' :: Ptr ActionSet_T -> IO Result
xrDestroyActionSet' = FunPtr (Ptr ActionSet_T -> IO Result)
-> Ptr ActionSet_T -> IO Result
mkXrDestroyActionSet FunPtr (Ptr ActionSet_T -> IO Result)
xrDestroyActionSetPtr
  Result
r <- String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrDestroyActionSet" (Ptr ActionSet_T -> IO Result
xrDestroyActionSet' (ActionSet -> Ptr ActionSet_T
actionSetHandle (ActionSet
actionSet)))
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrCreateAction
  :: FunPtr (Ptr ActionSet_T -> Ptr ActionCreateInfo -> Ptr (Ptr Action_T) -> IO Result) -> Ptr ActionSet_T -> Ptr ActionCreateInfo -> Ptr (Ptr Action_T) -> IO Result

-- | xrCreateAction - Creates an XrAction
--
-- == Parameter Descriptions
--
-- = Description
--
-- 'createAction' creates an action and returns its handle.
--
-- If @actionSet@ has been included in a call to 'attachSessionActionSets',
-- the implementation /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_ACTIONSETS_ALREADY_ATTACHED'.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTIONSETS_ALREADY_ATTACHED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_LIMIT_REACHED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_OUT_OF_MEMORY'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_NAME_DUPLICATED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_LOCALIZED_NAME_DUPLICATED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_NAME_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_LOCALIZED_NAME_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_FORMAT_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Action', 'ActionCreateInfo',
-- 'OpenXR.Core10.Handles.ActionSet',
-- 'OpenXR.Core10.Enums.ActionType.ActionType', 'destroyAction'
createAction :: forall io
              . (MonadIO io)
             => -- | @actionSet@ is a handle to an 'OpenXR.Core10.Handles.ActionSet'.
                --
                -- #VUID-xrCreateAction-actionSet-parameter# @actionSet@ /must/ be a valid
                -- 'OpenXR.Core10.Handles.ActionSet' handle
                ActionSet
             -> -- | @createInfo@ is a pointer to a valid 'ActionCreateInfo' structure that
                -- defines the action being created.
                --
                -- #VUID-xrCreateAction-createInfo-parameter# @createInfo@ /must/ be a
                -- pointer to a valid 'ActionCreateInfo' structure
                ActionCreateInfo
             -> io (Action)
createAction :: ActionSet -> ActionCreateInfo -> io Action
createAction actionSet :: ActionSet
actionSet createInfo :: ActionCreateInfo
createInfo = IO Action -> io Action
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Action -> io Action)
-> (ContT Action IO Action -> IO Action)
-> ContT Action IO Action
-> io Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Action IO Action -> IO Action
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Action IO Action -> io Action)
-> ContT Action IO Action -> io Action
forall a b. (a -> b) -> a -> b
$ do
  let cmds :: InstanceCmds
cmds = ActionSet -> InstanceCmds
instanceCmds (ActionSet
actionSet :: ActionSet)
  let xrCreateActionPtr :: FunPtr
  (Ptr ActionSet_T
   -> Ptr ActionCreateInfo
   -> ("action" ::: Ptr (Ptr Action_T))
   -> IO Result)
xrCreateActionPtr = InstanceCmds
-> FunPtr
     (Ptr ActionSet_T
      -> Ptr ActionCreateInfo
      -> ("action" ::: Ptr (Ptr Action_T))
      -> IO Result)
pXrCreateAction InstanceCmds
cmds
  IO () -> ContT Action IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Action IO ()) -> IO () -> ContT Action IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr ActionSet_T
   -> Ptr ActionCreateInfo
   -> ("action" ::: Ptr (Ptr Action_T))
   -> IO Result)
xrCreateActionPtr FunPtr
  (Ptr ActionSet_T
   -> Ptr ActionCreateInfo
   -> ("action" ::: Ptr (Ptr Action_T))
   -> IO Result)
-> FunPtr
     (Ptr ActionSet_T
      -> Ptr ActionCreateInfo
      -> ("action" ::: Ptr (Ptr Action_T))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr ActionSet_T
   -> Ptr ActionCreateInfo
   -> ("action" ::: Ptr (Ptr Action_T))
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrCreateAction is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrCreateAction' :: Ptr ActionSet_T
-> Ptr ActionCreateInfo
-> ("action" ::: Ptr (Ptr Action_T))
-> IO Result
xrCreateAction' = FunPtr
  (Ptr ActionSet_T
   -> Ptr ActionCreateInfo
   -> ("action" ::: Ptr (Ptr Action_T))
   -> IO Result)
-> Ptr ActionSet_T
-> Ptr ActionCreateInfo
-> ("action" ::: Ptr (Ptr Action_T))
-> IO Result
mkXrCreateAction FunPtr
  (Ptr ActionSet_T
   -> Ptr ActionCreateInfo
   -> ("action" ::: Ptr (Ptr Action_T))
   -> IO Result)
xrCreateActionPtr
  Ptr ActionCreateInfo
createInfo' <- ((Ptr ActionCreateInfo -> IO Action) -> IO Action)
-> ContT Action IO (Ptr ActionCreateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ActionCreateInfo -> IO Action) -> IO Action)
 -> ContT Action IO (Ptr ActionCreateInfo))
-> ((Ptr ActionCreateInfo -> IO Action) -> IO Action)
-> ContT Action IO (Ptr ActionCreateInfo)
forall a b. (a -> b) -> a -> b
$ ActionCreateInfo
-> (Ptr ActionCreateInfo -> IO Action) -> IO Action
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ActionCreateInfo
createInfo)
  "action" ::: Ptr (Ptr Action_T)
pAction <- ((("action" ::: Ptr (Ptr Action_T)) -> IO Action) -> IO Action)
-> ContT Action IO ("action" ::: Ptr (Ptr Action_T))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("action" ::: Ptr (Ptr Action_T)) -> IO Action) -> IO Action)
 -> ContT Action IO ("action" ::: Ptr (Ptr Action_T)))
-> ((("action" ::: Ptr (Ptr Action_T)) -> IO Action) -> IO Action)
-> ContT Action IO ("action" ::: Ptr (Ptr Action_T))
forall a b. (a -> b) -> a -> b
$ IO ("action" ::: Ptr (Ptr Action_T))
-> (("action" ::: Ptr (Ptr Action_T)) -> IO ())
-> (("action" ::: Ptr (Ptr Action_T)) -> IO Action)
-> IO Action
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("action" ::: Ptr (Ptr Action_T))
forall a. Int -> IO (Ptr a)
callocBytes @(Ptr Action_T) 8) ("action" ::: Ptr (Ptr Action_T)) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT Action IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Action IO Result)
-> IO Result -> ContT Action IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrCreateAction" (Ptr ActionSet_T
-> Ptr ActionCreateInfo
-> ("action" ::: Ptr (Ptr Action_T))
-> IO Result
xrCreateAction' (ActionSet -> Ptr ActionSet_T
actionSetHandle (ActionSet
actionSet)) Ptr ActionCreateInfo
createInfo' ("action" ::: Ptr (Ptr Action_T)
pAction))
  IO () -> ContT Action IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Action IO ()) -> IO () -> ContT Action IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  Ptr Action_T
action <- IO (Ptr Action_T) -> ContT Action IO (Ptr Action_T)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Ptr Action_T) -> ContT Action IO (Ptr Action_T))
-> IO (Ptr Action_T) -> ContT Action IO (Ptr Action_T)
forall a b. (a -> b) -> a -> b
$ ("action" ::: Ptr (Ptr Action_T)) -> IO (Ptr Action_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Action_T) "action" ::: Ptr (Ptr Action_T)
pAction
  Action -> ContT Action IO Action
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Action -> ContT Action IO Action)
-> Action -> ContT Action IO Action
forall a b. (a -> b) -> a -> b
$ (((\h :: Ptr Action_T
h -> Ptr Action_T -> InstanceCmds -> Action
Action Ptr Action_T
h InstanceCmds
cmds ) Ptr Action_T
action))

-- | A convenience wrapper to make a compatible pair of calls to
-- 'createAction' and 'destroyAction'
--
-- To ensure that 'destroyAction' is always called: pass
-- 'Control.Exception.bracket' (or the allocate function from your
-- favourite resource management library) as the last argument.
-- To just extract the pair pass '(,)' as the last argument.
--
withAction :: forall io r . MonadIO io => ActionSet -> ActionCreateInfo -> (io Action -> (Action -> io ()) -> r) -> r
withAction :: ActionSet
-> ActionCreateInfo -> (io Action -> (Action -> io ()) -> r) -> r
withAction actionSet :: ActionSet
actionSet createInfo :: ActionCreateInfo
createInfo b :: io Action -> (Action -> io ()) -> r
b =
  io Action -> (Action -> io ()) -> r
b (ActionSet -> ActionCreateInfo -> io Action
forall (io :: * -> *).
MonadIO io =>
ActionSet -> ActionCreateInfo -> io Action
createAction ActionSet
actionSet ActionCreateInfo
createInfo)
    (\(Action
o0) -> Action -> io ()
forall (io :: * -> *). MonadIO io => Action -> io ()
destroyAction Action
o0)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrDestroyAction
  :: FunPtr (Ptr Action_T -> IO Result) -> Ptr Action_T -> IO Result

-- | xrDestroyAction - Destroys an XrAction
--
-- == Parameter Descriptions
--
-- = Description
--
-- Action handles /can/ be destroyed by calling 'destroyAction'. Handles
-- for actions that are part of an action set are automatically destroyed
-- when the action set’s handle is destroyed.
--
-- The implementation /must/ not destroy the underlying resources for an
-- action when 'destroyAction' is called. Those resources are still used to
-- make
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#spaces-action-spaces-lifetime action spaces locatable>
-- and when processing action priority in 'syncActions'. Destroying the
-- action handle removes the application’s access to these resources, but
-- has no other change on actions.
--
-- Resources for all actions in an instance /must/ be freed when the
-- instance containing those actions sets is destroyed.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrDestroyAction-action-parameter# @action@ /must/ be a valid
--     'OpenXR.Core10.Handles.Action' handle
--
-- == Thread Safety
--
-- -   Access to @action@, and any child handles, /must/ be externally
--     synchronized
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Action', 'createAction'
destroyAction :: forall io
               . (MonadIO io)
              => -- | @action@ is the action to destroy.
                 Action
              -> io ()
destroyAction :: Action -> io ()
destroyAction action :: Action
action = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let xrDestroyActionPtr :: FunPtr (Ptr Action_T -> IO Result)
xrDestroyActionPtr = InstanceCmds -> FunPtr (Ptr Action_T -> IO Result)
pXrDestroyAction (Action -> InstanceCmds
instanceCmds (Action
action :: Action))
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Action_T -> IO Result)
xrDestroyActionPtr FunPtr (Ptr Action_T -> IO Result)
-> FunPtr (Ptr Action_T -> IO Result) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Action_T -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrDestroyAction is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrDestroyAction' :: Ptr Action_T -> IO Result
xrDestroyAction' = FunPtr (Ptr Action_T -> IO Result) -> Ptr Action_T -> IO Result
mkXrDestroyAction FunPtr (Ptr Action_T -> IO Result)
xrDestroyActionPtr
  Result
r <- String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrDestroyAction" (Ptr Action_T -> IO Result
xrDestroyAction' (Action -> Ptr Action_T
actionHandle (Action
action)))
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrSuggestInteractionProfileBindings
  :: FunPtr (Ptr Instance_T -> Ptr (SomeStruct InteractionProfileSuggestedBinding) -> IO Result) -> Ptr Instance_T -> Ptr (SomeStruct InteractionProfileSuggestedBinding) -> IO Result

-- | xrSuggestInteractionProfileBindings - Sets the application-suggested
-- bindings for the interaction profile
--
-- == Parameter Descriptions
--
-- = Description
--
-- 'suggestInteractionProfileBindings' sets an interaction profile for
-- which the application can provide default bindings. The application
-- /can/ call 'suggestInteractionProfileBindings' once per interaction
-- profile that it supports.
--
-- The application /can/ provide any number of bindings for each action.
--
-- If the application successfully calls
-- 'suggestInteractionProfileBindings' more than once for an interaction
-- profile, the runtime /must/ discard the previous suggested bindings and
-- replace them with the new suggested bindings for that profile.
--
-- If the interaction profile path does not follow the structure defined in
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#semantic-path-interaction-profiles Interaction Profiles>
-- or suggested bindings contain paths that do not follow the format
-- defined in
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#semantic-path-input Device input subpaths>,
-- the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'. If the interaction
-- profile or input source for any of the suggested bindings does not exist
-- in the allowlist defined in
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#semantic-path-interaction-profiles Interaction Profile Paths>,
-- the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'. A runtime /must/
-- accept every valid binding in the allowlist though it is free to ignore
-- any of them.
--
-- If the action set for any action referenced in the @suggestedBindings@
-- parameter has been included in a call to 'attachSessionActionSets', the
-- implementation /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_ACTIONSETS_ALREADY_ATTACHED'.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTIONSETS_ALREADY_ATTACHED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_INVALID'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Instance', 'InteractionProfileSuggestedBinding'
suggestInteractionProfileBindings :: forall a io
                                   . (Extendss InteractionProfileSuggestedBinding a, PokeChain a, MonadIO io)
                                  => -- | @instance@ is the 'OpenXR.Core10.Handles.Instance' for which the
                                     -- application would like to set suggested bindings
                                     --
                                     -- #VUID-xrSuggestInteractionProfileBindings-instance-parameter# @instance@
                                     -- /must/ be a valid 'OpenXR.Core10.Handles.Instance' handle
                                     Instance
                                  -> -- | @suggestedBindings@ is the 'InteractionProfileSuggestedBinding' that the
                                     -- application would like to set
                                     --
                                     -- #VUID-xrSuggestInteractionProfileBindings-suggestedBindings-parameter#
                                     -- @suggestedBindings@ /must/ be a pointer to a valid
                                     -- 'InteractionProfileSuggestedBinding' structure
                                     ("suggestedBindings" ::: InteractionProfileSuggestedBinding a)
                                  -> io ()
suggestInteractionProfileBindings :: Instance
-> ("suggestedBindings" ::: InteractionProfileSuggestedBinding a)
-> io ()
suggestInteractionProfileBindings instance' :: Instance
instance' suggestedBindings :: "suggestedBindings" ::: InteractionProfileSuggestedBinding a
suggestedBindings = IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ())
-> (ContT () IO () -> IO ()) -> ContT () IO () -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT () IO () -> IO ()
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT () IO () -> io ()) -> ContT () IO () -> io ()
forall a b. (a -> b) -> a -> b
$ do
  let xrSuggestInteractionProfileBindingsPtr :: FunPtr
  (Ptr Instance_T
   -> ("suggestedBindings"
       ::: Ptr (SomeStruct InteractionProfileSuggestedBinding))
   -> IO Result)
xrSuggestInteractionProfileBindingsPtr = InstanceCmds
-> FunPtr
     (Ptr Instance_T
      -> ("suggestedBindings"
          ::: Ptr (SomeStruct InteractionProfileSuggestedBinding))
      -> IO Result)
pXrSuggestInteractionProfileBindings (Instance -> InstanceCmds
instanceCmds (Instance
instance' :: Instance))
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Instance_T
   -> ("suggestedBindings"
       ::: Ptr (SomeStruct InteractionProfileSuggestedBinding))
   -> IO Result)
xrSuggestInteractionProfileBindingsPtr FunPtr
  (Ptr Instance_T
   -> ("suggestedBindings"
       ::: Ptr (SomeStruct InteractionProfileSuggestedBinding))
   -> IO Result)
-> FunPtr
     (Ptr Instance_T
      -> ("suggestedBindings"
          ::: Ptr (SomeStruct InteractionProfileSuggestedBinding))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Instance_T
   -> ("suggestedBindings"
       ::: Ptr (SomeStruct InteractionProfileSuggestedBinding))
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrSuggestInteractionProfileBindings is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrSuggestInteractionProfileBindings' :: Ptr Instance_T
-> ("suggestedBindings"
    ::: Ptr (SomeStruct InteractionProfileSuggestedBinding))
-> IO Result
xrSuggestInteractionProfileBindings' = FunPtr
  (Ptr Instance_T
   -> ("suggestedBindings"
       ::: Ptr (SomeStruct InteractionProfileSuggestedBinding))
   -> IO Result)
-> Ptr Instance_T
-> ("suggestedBindings"
    ::: Ptr (SomeStruct InteractionProfileSuggestedBinding))
-> IO Result
mkXrSuggestInteractionProfileBindings FunPtr
  (Ptr Instance_T
   -> ("suggestedBindings"
       ::: Ptr (SomeStruct InteractionProfileSuggestedBinding))
   -> IO Result)
xrSuggestInteractionProfileBindingsPtr
  Ptr ("suggestedBindings" ::: InteractionProfileSuggestedBinding a)
suggestedBindings' <- ((Ptr
    ("suggestedBindings" ::: InteractionProfileSuggestedBinding a)
  -> IO ())
 -> IO ())
-> ContT
     ()
     IO
     (Ptr
        ("suggestedBindings" ::: InteractionProfileSuggestedBinding a))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr
     ("suggestedBindings" ::: InteractionProfileSuggestedBinding a)
   -> IO ())
  -> IO ())
 -> ContT
      ()
      IO
      (Ptr
         ("suggestedBindings" ::: InteractionProfileSuggestedBinding a)))
-> ((Ptr
       ("suggestedBindings" ::: InteractionProfileSuggestedBinding a)
     -> IO ())
    -> IO ())
-> ContT
     ()
     IO
     (Ptr
        ("suggestedBindings" ::: InteractionProfileSuggestedBinding a))
forall a b. (a -> b) -> a -> b
$ ("suggestedBindings" ::: InteractionProfileSuggestedBinding a)
-> (Ptr
      ("suggestedBindings" ::: InteractionProfileSuggestedBinding a)
    -> IO ())
-> IO ()
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct ("suggestedBindings" ::: InteractionProfileSuggestedBinding a
suggestedBindings)
  Result
r <- IO Result -> ContT () IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT () IO Result)
-> IO Result -> ContT () IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrSuggestInteractionProfileBindings" (Ptr Instance_T
-> ("suggestedBindings"
    ::: Ptr (SomeStruct InteractionProfileSuggestedBinding))
-> IO Result
xrSuggestInteractionProfileBindings' (Instance -> Ptr Instance_T
instanceHandle (Instance
instance')) (Ptr ("suggestedBindings" ::: InteractionProfileSuggestedBinding a)
-> "suggestedBindings"
   ::: Ptr (SomeStruct InteractionProfileSuggestedBinding)
forall (a :: [*] -> *) (es :: [*]).
Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions Ptr ("suggestedBindings" ::: InteractionProfileSuggestedBinding a)
suggestedBindings'))
  IO () -> ContT () IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT () IO ()) -> IO () -> ContT () IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrAttachSessionActionSets
  :: FunPtr (Ptr Session_T -> Ptr SessionActionSetsAttachInfo -> IO Result) -> Ptr Session_T -> Ptr SessionActionSetsAttachInfo -> IO Result

-- | xrAttachSessionActionSets - Attaches action sets to a given session
--
-- == Parameter Descriptions
--
-- = Description
--
-- 'attachSessionActionSets' attaches the 'OpenXR.Core10.Handles.ActionSet'
-- handles in @attachInfo.actionSets@ to the @session@. Action sets /must/
-- be attached in order to be synchronized with 'syncActions'.
--
-- When an action set is attached to a session, that action set becomes
-- immutable. See 'createAction' and 'suggestInteractionProfileBindings'
-- for details.
--
-- The runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_ACTIONSETS_ALREADY_ATTACHED' if
-- 'attachSessionActionSets' is called more than once for a given
-- @session@. The runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_ACTIONSET_NOT_ATTACHED' for any action
-- created after 'attachSessionActionSets' is called for a given @session@
-- if that handle is used with any call for the same @session@.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTIONSETS_ALREADY_ATTACHED'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Session', 'SessionActionSetsAttachInfo'
attachSessionActionSets :: forall io
                         . (MonadIO io)
                        => -- | @session@ is the 'OpenXR.Core10.Handles.Session' to attach the action
                           -- sets to.
                           --
                           -- #VUID-xrAttachSessionActionSets-session-parameter# @session@ /must/ be a
                           -- valid 'OpenXR.Core10.Handles.Session' handle
                           Session
                        -> -- | @attachInfo@ is the 'SessionActionSetsAttachInfo' to provide information
                           -- to attach action sets to the session.
                           --
                           -- #VUID-xrAttachSessionActionSets-attachInfo-parameter# @attachInfo@
                           -- /must/ be a pointer to a valid 'SessionActionSetsAttachInfo' structure
                           SessionActionSetsAttachInfo
                        -> io (Result)
attachSessionActionSets :: Session -> SessionActionSetsAttachInfo -> io Result
attachSessionActionSets session :: Session
session attachInfo :: SessionActionSetsAttachInfo
attachInfo = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result)
-> (ContT Result IO Result -> IO Result)
-> ContT Result IO Result
-> io Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Result IO Result -> IO Result
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Result IO Result -> io Result)
-> ContT Result IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
  let xrAttachSessionActionSetsPtr :: FunPtr
  (Ptr Session_T -> Ptr SessionActionSetsAttachInfo -> IO Result)
xrAttachSessionActionSetsPtr = InstanceCmds
-> FunPtr
     (Ptr Session_T -> Ptr SessionActionSetsAttachInfo -> IO Result)
pXrAttachSessionActionSets (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Session_T -> Ptr SessionActionSetsAttachInfo -> IO Result)
xrAttachSessionActionSetsPtr FunPtr
  (Ptr Session_T -> Ptr SessionActionSetsAttachInfo -> IO Result)
-> FunPtr
     (Ptr Session_T -> Ptr SessionActionSetsAttachInfo -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Session_T -> Ptr SessionActionSetsAttachInfo -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrAttachSessionActionSets is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrAttachSessionActionSets' :: Ptr Session_T -> Ptr SessionActionSetsAttachInfo -> IO Result
xrAttachSessionActionSets' = FunPtr
  (Ptr Session_T -> Ptr SessionActionSetsAttachInfo -> IO Result)
-> Ptr Session_T -> Ptr SessionActionSetsAttachInfo -> IO Result
mkXrAttachSessionActionSets FunPtr
  (Ptr Session_T -> Ptr SessionActionSetsAttachInfo -> IO Result)
xrAttachSessionActionSetsPtr
  Ptr SessionActionSetsAttachInfo
attachInfo' <- ((Ptr SessionActionSetsAttachInfo -> IO Result) -> IO Result)
-> ContT Result IO (Ptr SessionActionSetsAttachInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr SessionActionSetsAttachInfo -> IO Result) -> IO Result)
 -> ContT Result IO (Ptr SessionActionSetsAttachInfo))
-> ((Ptr SessionActionSetsAttachInfo -> IO Result) -> IO Result)
-> ContT Result IO (Ptr SessionActionSetsAttachInfo)
forall a b. (a -> b) -> a -> b
$ SessionActionSetsAttachInfo
-> (Ptr SessionActionSetsAttachInfo -> IO Result) -> IO Result
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (SessionActionSetsAttachInfo
attachInfo)
  Result
r <- IO Result -> ContT Result IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Result IO Result)
-> IO Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrAttachSessionActionSets" (Ptr Session_T -> Ptr SessionActionSetsAttachInfo -> IO Result
xrAttachSessionActionSets' (Session -> Ptr Session_T
sessionHandle (Session
session)) Ptr SessionActionSetsAttachInfo
attachInfo')
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  Result -> ContT Result IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> ContT Result IO Result)
-> Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrGetCurrentInteractionProfile
  :: FunPtr (Ptr Session_T -> Path -> Ptr InteractionProfileState -> IO Result) -> Ptr Session_T -> Path -> Ptr InteractionProfileState -> IO Result

-- | xrGetCurrentInteractionProfile - Gets the current interaction profile
-- for a top level user paths
--
-- == Parameter Descriptions
--
-- = Description
--
-- 'getCurrentInteractionProfile' asks the runtime for the active
-- interaction profiles for a top level user path.
--
-- The runtime /must/ return only interaction profiles for which the
-- application has provided bindings with
-- 'suggestInteractionProfileBindings'. The runtime /may/ return
-- interaction profiles that do not represent physically present hardware,
-- for example if the runtime is using a known interaction profile to bind
-- to hardware that the application is not aware of. The runtime /may/
-- return the last-known interaction profile in the event that no
-- controllers are active.
--
-- If 'attachSessionActionSets' has not yet been called for the @session@,
-- the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_ACTIONSET_NOT_ATTACHED'. If
-- @topLevelUserPath@ is not one of the device input subpaths described in
-- section
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#semantic-path-user \/user paths>,
-- the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTIONSET_NOT_ATTACHED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_INVALID'
--
-- = See Also
--
-- 'InteractionProfileState',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >,
-- 'OpenXR.Core10.Handles.Session'
getCurrentInteractionProfile :: forall io
                              . (MonadIO io)
                             => -- | @session@ is the 'OpenXR.Core10.Handles.Session' for which the
                                -- application would like to retrieve the current interaction profile.
                                --
                                -- #VUID-xrGetCurrentInteractionProfile-session-parameter# @session@ /must/
                                -- be a valid 'OpenXR.Core10.Handles.Session' handle
                                Session
                             -> -- | @topLevelUserPath@ is the top level user path the application would like
                                -- to retrieve the interaction profile for.
                                ("topLevelUserPath" ::: Path)
                             -> io (Result, InteractionProfileState)
getCurrentInteractionProfile :: Session
-> ("topLevelUserPath" ::: Path)
-> io (Result, InteractionProfileState)
getCurrentInteractionProfile session :: Session
session topLevelUserPath :: "topLevelUserPath" ::: Path
topLevelUserPath = IO (Result, InteractionProfileState)
-> io (Result, InteractionProfileState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, InteractionProfileState)
 -> io (Result, InteractionProfileState))
-> (ContT
      (Result, InteractionProfileState)
      IO
      (Result, InteractionProfileState)
    -> IO (Result, InteractionProfileState))
-> ContT
     (Result, InteractionProfileState)
     IO
     (Result, InteractionProfileState)
-> io (Result, InteractionProfileState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, InteractionProfileState)
  IO
  (Result, InteractionProfileState)
-> IO (Result, InteractionProfileState)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, InteractionProfileState)
   IO
   (Result, InteractionProfileState)
 -> io (Result, InteractionProfileState))
-> ContT
     (Result, InteractionProfileState)
     IO
     (Result, InteractionProfileState)
-> io (Result, InteractionProfileState)
forall a b. (a -> b) -> a -> b
$ do
  let xrGetCurrentInteractionProfilePtr :: FunPtr
  (Ptr Session_T
   -> ("topLevelUserPath" ::: Path)
   -> Ptr InteractionProfileState
   -> IO Result)
xrGetCurrentInteractionProfilePtr = InstanceCmds
-> FunPtr
     (Ptr Session_T
      -> ("topLevelUserPath" ::: Path)
      -> Ptr InteractionProfileState
      -> IO Result)
pXrGetCurrentInteractionProfile (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO () -> ContT (Result, InteractionProfileState) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, InteractionProfileState) IO ())
-> IO () -> ContT (Result, InteractionProfileState) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Session_T
   -> ("topLevelUserPath" ::: Path)
   -> Ptr InteractionProfileState
   -> IO Result)
xrGetCurrentInteractionProfilePtr FunPtr
  (Ptr Session_T
   -> ("topLevelUserPath" ::: Path)
   -> Ptr InteractionProfileState
   -> IO Result)
-> FunPtr
     (Ptr Session_T
      -> ("topLevelUserPath" ::: Path)
      -> Ptr InteractionProfileState
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Session_T
   -> ("topLevelUserPath" ::: Path)
   -> Ptr InteractionProfileState
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrGetCurrentInteractionProfile is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrGetCurrentInteractionProfile' :: Ptr Session_T
-> ("topLevelUserPath" ::: Path)
-> Ptr InteractionProfileState
-> IO Result
xrGetCurrentInteractionProfile' = FunPtr
  (Ptr Session_T
   -> ("topLevelUserPath" ::: Path)
   -> Ptr InteractionProfileState
   -> IO Result)
-> Ptr Session_T
-> ("topLevelUserPath" ::: Path)
-> Ptr InteractionProfileState
-> IO Result
mkXrGetCurrentInteractionProfile FunPtr
  (Ptr Session_T
   -> ("topLevelUserPath" ::: Path)
   -> Ptr InteractionProfileState
   -> IO Result)
xrGetCurrentInteractionProfilePtr
  Ptr InteractionProfileState
pInteractionProfile <- ((Ptr InteractionProfileState
  -> IO (Result, InteractionProfileState))
 -> IO (Result, InteractionProfileState))
-> ContT
     (Result, InteractionProfileState) IO (Ptr InteractionProfileState)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (forall b.
ToCStruct InteractionProfileState =>
(Ptr InteractionProfileState -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @InteractionProfileState)
  Result
r <- IO Result -> ContT (Result, InteractionProfileState) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, InteractionProfileState) IO Result)
-> IO Result -> ContT (Result, InteractionProfileState) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrGetCurrentInteractionProfile" (Ptr Session_T
-> ("topLevelUserPath" ::: Path)
-> Ptr InteractionProfileState
-> IO Result
xrGetCurrentInteractionProfile' (Session -> Ptr Session_T
sessionHandle (Session
session)) ("topLevelUserPath" ::: Path
topLevelUserPath) (Ptr InteractionProfileState
pInteractionProfile))
  IO () -> ContT (Result, InteractionProfileState) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, InteractionProfileState) IO ())
-> IO () -> ContT (Result, InteractionProfileState) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  InteractionProfileState
interactionProfile <- IO InteractionProfileState
-> ContT
     (Result, InteractionProfileState) IO InteractionProfileState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO InteractionProfileState
 -> ContT
      (Result, InteractionProfileState) IO InteractionProfileState)
-> IO InteractionProfileState
-> ContT
     (Result, InteractionProfileState) IO InteractionProfileState
forall a b. (a -> b) -> a -> b
$ Ptr InteractionProfileState -> IO InteractionProfileState
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @InteractionProfileState Ptr InteractionProfileState
pInteractionProfile
  (Result, InteractionProfileState)
-> ContT
     (Result, InteractionProfileState)
     IO
     (Result, InteractionProfileState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, InteractionProfileState)
 -> ContT
      (Result, InteractionProfileState)
      IO
      (Result, InteractionProfileState))
-> (Result, InteractionProfileState)
-> ContT
     (Result, InteractionProfileState)
     IO
     (Result, InteractionProfileState)
forall a b. (a -> b) -> a -> b
$ (Result
r, InteractionProfileState
interactionProfile)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrSyncActions
  :: FunPtr (Ptr Session_T -> Ptr ActionsSyncInfo -> IO Result) -> Ptr Session_T -> Ptr ActionsSyncInfo -> IO Result

-- | xrSyncActions - Updates the current state of input actions
--
-- == Parameter Descriptions
--
-- = Description
--
-- 'syncActions' updates the current state of input actions. Repeated input
-- action state queries between subsequent synchronization calls /must/
-- return the same values. The 'OpenXR.Core10.Handles.ActionSet' structures
-- referenced in the @syncInfo.activeActionSets@ /must/ have been
-- previously attached to the session via 'attachSessionActionSets'. If any
-- action sets not attached to this session are passed to 'syncActions' it
-- /must/ return 'OpenXR.Core10.Enums.Result.ERROR_ACTIONSET_NOT_ATTACHED'.
-- Subsets of the bound action sets /can/ be synchronized in order to
-- control which actions are seen as active.
--
-- If @session@ is not focused, the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.SESSION_NOT_FOCUSED', and all action states
-- in the session /must/ be inactive.
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_NOT_FOCUSED'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTIONSET_NOT_ATTACHED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.ActionSet', 'ActionsSyncInfo', 'ActiveActionSet',
-- 'OpenXR.Core10.Handles.Session'
syncActions :: forall io
             . (MonadIO io)
            => -- | @session@ is a handle to the 'OpenXR.Core10.Handles.Session' that all
               -- provided action set handles belong to.
               --
               -- #VUID-xrSyncActions-session-parameter# @session@ /must/ be a valid
               -- 'OpenXR.Core10.Handles.Session' handle
               Session
            -> -- | @syncInfo@ is an 'ActionsSyncInfo' providing information to synchronize
               -- action states.
               --
               -- #VUID-xrSyncActions-syncInfo-parameter# @syncInfo@ /must/ be a pointer
               -- to a valid 'ActionsSyncInfo' structure
               ActionsSyncInfo
            -> io (Result)
syncActions :: Session -> ActionsSyncInfo -> io Result
syncActions session :: Session
session syncInfo :: ActionsSyncInfo
syncInfo = IO Result -> io Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> io Result)
-> (ContT Result IO Result -> IO Result)
-> ContT Result IO Result
-> io Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT Result IO Result -> IO Result
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT Result IO Result -> io Result)
-> ContT Result IO Result -> io Result
forall a b. (a -> b) -> a -> b
$ do
  let xrSyncActionsPtr :: FunPtr (Ptr Session_T -> Ptr ActionsSyncInfo -> IO Result)
xrSyncActionsPtr = InstanceCmds
-> FunPtr (Ptr Session_T -> Ptr ActionsSyncInfo -> IO Result)
pXrSyncActions (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr (Ptr Session_T -> Ptr ActionsSyncInfo -> IO Result)
xrSyncActionsPtr FunPtr (Ptr Session_T -> Ptr ActionsSyncInfo -> IO Result)
-> FunPtr (Ptr Session_T -> Ptr ActionsSyncInfo -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (Ptr Session_T -> Ptr ActionsSyncInfo -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrSyncActions is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrSyncActions' :: Ptr Session_T -> Ptr ActionsSyncInfo -> IO Result
xrSyncActions' = FunPtr (Ptr Session_T -> Ptr ActionsSyncInfo -> IO Result)
-> Ptr Session_T -> Ptr ActionsSyncInfo -> IO Result
mkXrSyncActions FunPtr (Ptr Session_T -> Ptr ActionsSyncInfo -> IO Result)
xrSyncActionsPtr
  Ptr ActionsSyncInfo
syncInfo' <- ((Ptr ActionsSyncInfo -> IO Result) -> IO Result)
-> ContT Result IO (Ptr ActionsSyncInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ActionsSyncInfo -> IO Result) -> IO Result)
 -> ContT Result IO (Ptr ActionsSyncInfo))
-> ((Ptr ActionsSyncInfo -> IO Result) -> IO Result)
-> ContT Result IO (Ptr ActionsSyncInfo)
forall a b. (a -> b) -> a -> b
$ ActionsSyncInfo -> (Ptr ActionsSyncInfo -> IO Result) -> IO Result
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (ActionsSyncInfo
syncInfo)
  Result
r <- IO Result -> ContT Result IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT Result IO Result)
-> IO Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrSyncActions" (Ptr Session_T -> Ptr ActionsSyncInfo -> IO Result
xrSyncActions' (Session -> Ptr Session_T
sessionHandle (Session
session)) Ptr ActionsSyncInfo
syncInfo')
  IO () -> ContT Result IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT Result IO ()) -> IO () -> ContT Result IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  Result -> ContT Result IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> ContT Result IO Result)
-> Result -> ContT Result IO Result
forall a b. (a -> b) -> a -> b
$ (Result
r)


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrEnumerateBoundSourcesForAction
  :: FunPtr (Ptr Session_T -> Ptr BoundSourcesForActionEnumerateInfo -> Word32 -> Ptr Word32 -> Ptr Path -> IO Result) -> Ptr Session_T -> Ptr BoundSourcesForActionEnumerateInfo -> Word32 -> Ptr Word32 -> Ptr Path -> IO Result

-- | xrEnumerateBoundSourcesForAction - Queries the bound input sources for
-- an action
--
-- == Parameter Descriptions
--
-- -   @session@ is the 'OpenXR.Core10.Handles.Session' being queried.
--
-- -   @enumerateInfo@ is an 'BoundSourcesForActionEnumerateInfo' providing
--     the query information.
--
-- -   @sourceCapacityInput@ is the capacity of the array, or 0 to indicate
--     a request to retrieve the required capacity.
--
-- -   @sourceCountOutput@ is a pointer to the count of sources, or a
--     pointer to the required capacity in the case that
--     @sourceCapacityInput@ is 0.
--
-- -   @sources@ is a pointer to an application-allocated array that will
--     be filled with the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >
--     values for all sources. It /can/ be @NULL@ if @sourceCapacityInput@
--     is 0.
--
-- -   See
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#buffer-size-parameters Buffer Size Parameters>
--     chapter for a detailed description of retrieving the required
--     @sources@ size.
--
-- = Description
--
-- If an action is unbound, 'enumerateBoundSourcesForAction' /must/ assign
-- @0@ to the value pointed-to by @sourceCountOutput@ and not modify the
-- array.
--
-- 'enumerateBoundSourcesForAction' /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_ACTIONSET_NOT_ATTACHED' if passed an
-- action in an action set never attached to the session with
-- 'attachSessionActionSets'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrEnumerateBoundSourcesForAction-session-parameter# @session@
--     /must/ be a valid 'OpenXR.Core10.Handles.Session' handle
--
-- -   #VUID-xrEnumerateBoundSourcesForAction-enumerateInfo-parameter#
--     @enumerateInfo@ /must/ be a pointer to a valid
--     'BoundSourcesForActionEnumerateInfo' structure
--
-- -   #VUID-xrEnumerateBoundSourcesForAction-sourceCountOutput-parameter#
--     @sourceCountOutput@ /must/ be a pointer to a @uint32_t@ value
--
-- -   #VUID-xrEnumerateBoundSourcesForAction-sources-parameter# If
--     @sourceCapacityInput@ is not @0@, @sources@ /must/ be a pointer to
--     an array of @sourceCapacityInput@
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >
--     values
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTIONSET_NOT_ATTACHED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SIZE_INSUFFICIENT'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_INVALID'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Action', 'BoundSourcesForActionEnumerateInfo',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >,
-- 'OpenXR.Core10.Handles.Session'
enumerateBoundSourcesForAction :: forall io
                                . (MonadIO io)
                               => -- No documentation found for Nested "xrEnumerateBoundSourcesForAction" "session"
                                  Session
                               -> -- No documentation found for Nested "xrEnumerateBoundSourcesForAction" "enumerateInfo"
                                  BoundSourcesForActionEnumerateInfo
                               -> io (Result, ("sources" ::: Vector Path))
enumerateBoundSourcesForAction :: Session
-> BoundSourcesForActionEnumerateInfo
-> io (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
enumerateBoundSourcesForAction session :: Session
session enumerateInfo :: BoundSourcesForActionEnumerateInfo
enumerateInfo = IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
-> io (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
 -> io (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> (ContT
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
      IO
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
    -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
-> io (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
  IO
  (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
-> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
   IO
   (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
 -> io (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
-> io (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
forall a b. (a -> b) -> a -> b
$ do
  let xrEnumerateBoundSourcesForActionPtr :: FunPtr
  (Ptr Session_T
   -> Ptr BoundSourcesForActionEnumerateInfo
   -> ("sourceCapacityInput" ::: Word32)
   -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
   -> IO Result)
xrEnumerateBoundSourcesForActionPtr = InstanceCmds
-> FunPtr
     (Ptr Session_T
      -> Ptr BoundSourcesForActionEnumerateInfo
      -> ("sourceCapacityInput" ::: Word32)
      -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
      -> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
      -> IO Result)
pXrEnumerateBoundSourcesForAction (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO ()
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)) IO ())
-> IO ()
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Session_T
   -> Ptr BoundSourcesForActionEnumerateInfo
   -> ("sourceCapacityInput" ::: Word32)
   -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
   -> IO Result)
xrEnumerateBoundSourcesForActionPtr FunPtr
  (Ptr Session_T
   -> Ptr BoundSourcesForActionEnumerateInfo
   -> ("sourceCapacityInput" ::: Word32)
   -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
   -> IO Result)
-> FunPtr
     (Ptr Session_T
      -> Ptr BoundSourcesForActionEnumerateInfo
      -> ("sourceCapacityInput" ::: Word32)
      -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
      -> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Session_T
   -> Ptr BoundSourcesForActionEnumerateInfo
   -> ("sourceCapacityInput" ::: Word32)
   -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrEnumerateBoundSourcesForAction is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrEnumerateBoundSourcesForAction' :: Ptr Session_T
-> Ptr BoundSourcesForActionEnumerateInfo
-> ("sourceCapacityInput" ::: Word32)
-> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> IO Result
xrEnumerateBoundSourcesForAction' = FunPtr
  (Ptr Session_T
   -> Ptr BoundSourcesForActionEnumerateInfo
   -> ("sourceCapacityInput" ::: Word32)
   -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
   -> IO Result)
-> Ptr Session_T
-> Ptr BoundSourcesForActionEnumerateInfo
-> ("sourceCapacityInput" ::: Word32)
-> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> IO Result
mkXrEnumerateBoundSourcesForAction FunPtr
  (Ptr Session_T
   -> Ptr BoundSourcesForActionEnumerateInfo
   -> ("sourceCapacityInput" ::: Word32)
   -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
   -> IO Result)
xrEnumerateBoundSourcesForActionPtr
  let session' :: Ptr Session_T
session' = Session -> Ptr Session_T
sessionHandle (Session
session)
  Ptr BoundSourcesForActionEnumerateInfo
enumerateInfo' <- ((Ptr BoundSourcesForActionEnumerateInfo
  -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
 -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     (Ptr BoundSourcesForActionEnumerateInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr BoundSourcesForActionEnumerateInfo
   -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
  -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
 -> ContT
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
      IO
      (Ptr BoundSourcesForActionEnumerateInfo))
-> ((Ptr BoundSourcesForActionEnumerateInfo
     -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
    -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     (Ptr BoundSourcesForActionEnumerateInfo)
forall a b. (a -> b) -> a -> b
$ BoundSourcesForActionEnumerateInfo
-> (Ptr BoundSourcesForActionEnumerateInfo
    -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (BoundSourcesForActionEnumerateInfo
enumerateInfo)
  "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
pSourceCountOutput <- ((("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
  -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
 -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
  -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
 -> ContT
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
      IO
      ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)))
-> ((("sourceCountOutput"
      ::: Ptr ("sourceCapacityInput" ::: Word32))
     -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
    -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
forall a b. (a -> b) -> a -> b
$ IO ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> (("sourceCountOutput"
     ::: Ptr ("sourceCapacityInput" ::: Word32))
    -> IO ())
-> (("sourceCountOutput"
     ::: Ptr ("sourceCapacityInput" ::: Word32))
    -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int
-> IO
     ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
      IO
      Result)
-> IO Result
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrEnumerateBoundSourcesForAction" (Ptr Session_T
-> Ptr BoundSourcesForActionEnumerateInfo
-> ("sourceCapacityInput" ::: Word32)
-> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> IO Result
xrEnumerateBoundSourcesForAction' Ptr Session_T
session' Ptr BoundSourcesForActionEnumerateInfo
enumerateInfo' (0) ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
pSourceCountOutput) ("sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a. Ptr a
nullPtr))
  IO ()
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)) IO ())
-> IO ()
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  "sourceCapacityInput" ::: Word32
sourceCountOutput <- IO ("sourceCapacityInput" ::: Word32)
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     ("sourceCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("sourceCapacityInput" ::: Word32)
 -> ContT
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
      IO
      ("sourceCapacityInput" ::: Word32))
-> IO ("sourceCapacityInput" ::: Word32)
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     ("sourceCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> IO ("sourceCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
pSourceCountOutput
  "sources" ::: Ptr ("topLevelUserPath" ::: Path)
pSources <- ((("sources" ::: Ptr ("topLevelUserPath" ::: Path))
  -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
 -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("sources" ::: Ptr ("topLevelUserPath" ::: Path))
   -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
  -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
 -> ContT
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
      IO
      ("sources" ::: Ptr ("topLevelUserPath" ::: Path)))
-> ((("sources" ::: Ptr ("topLevelUserPath" ::: Path))
     -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
    -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
forall a b. (a -> b) -> a -> b
$ IO ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> (("sources" ::: Ptr ("topLevelUserPath" ::: Path)) -> IO ())
-> (("sources" ::: Ptr ("topLevelUserPath" ::: Path))
    -> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> IO (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
forall a. Int -> IO (Ptr a)
callocBytes @Path ((("sourceCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ("sourceCapacityInput" ::: Word32
sourceCountOutput)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8)) ("sources" ::: Ptr ("topLevelUserPath" ::: Path)) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r' <- IO Result
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result
 -> ContT
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
      IO
      Result)
-> IO Result
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrEnumerateBoundSourcesForAction" (Ptr Session_T
-> Ptr BoundSourcesForActionEnumerateInfo
-> ("sourceCapacityInput" ::: Word32)
-> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> IO Result
xrEnumerateBoundSourcesForAction' Ptr Session_T
session' Ptr BoundSourcesForActionEnumerateInfo
enumerateInfo' (("sourceCapacityInput" ::: Word32
sourceCountOutput)) ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
pSourceCountOutput) ("sources" ::: Ptr ("topLevelUserPath" ::: Path)
pSources))
  IO ()
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> ContT
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)) IO ())
-> IO ()
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r'))
  "sourceCapacityInput" ::: Word32
sourceCountOutput' <- IO ("sourceCapacityInput" ::: Word32)
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     ("sourceCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("sourceCapacityInput" ::: Word32)
 -> ContT
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
      IO
      ("sourceCapacityInput" ::: Word32))
-> IO ("sourceCapacityInput" ::: Word32)
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     ("sourceCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> IO ("sourceCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
pSourceCountOutput
  "sources" ::: Vector ("topLevelUserPath" ::: Path)
sources' <- IO ("sources" ::: Vector ("topLevelUserPath" ::: Path))
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     ("sources" ::: Vector ("topLevelUserPath" ::: Path))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("sources" ::: Vector ("topLevelUserPath" ::: Path))
 -> ContT
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
      IO
      ("sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> IO ("sources" ::: Vector ("topLevelUserPath" ::: Path))
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     ("sources" ::: Vector ("topLevelUserPath" ::: Path))
forall a b. (a -> b) -> a -> b
$ Int
-> (Int -> IO ("topLevelUserPath" ::: Path))
-> IO ("sources" ::: Vector ("topLevelUserPath" ::: Path))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (("sourceCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ("sourceCapacityInput" ::: Word32
sourceCountOutput')) (\i :: Int
i -> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> IO ("topLevelUserPath" ::: Path)
forall a. Storable a => Ptr a -> IO a
peek @Path (("sources" ::: Ptr ("topLevelUserPath" ::: Path)
pSources ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Path)))
  (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
 -> ContT
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
      IO
      (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path)))
-> (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
-> ContT
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
     IO
     (Result, "sources" ::: Vector ("topLevelUserPath" ::: Path))
forall a b. (a -> b) -> a -> b
$ ((Result
r'), "sources" ::: Vector ("topLevelUserPath" ::: Path)
sources')


foreign import ccall
#if !defined(SAFE_FOREIGN_CALLS)
  unsafe
#endif
  "dynamic" mkXrGetInputSourceLocalizedName
  :: FunPtr (Ptr Session_T -> Ptr InputSourceLocalizedNameGetInfo -> Word32 -> Ptr Word32 -> Ptr CChar -> IO Result) -> Ptr Session_T -> Ptr InputSourceLocalizedNameGetInfo -> Word32 -> Ptr Word32 -> Ptr CChar -> IO Result

-- | xrGetInputSourceLocalizedName - Gets a localized source name
--
-- == Parameter Descriptions
--
-- -   @session@ is a handle to the 'OpenXR.Core10.Handles.Session'
--     associated with the action that reported this source.
--
-- -   @getInfo@ is an 'InputSourceLocalizedNameGetInfo' providing the
--     query information.
--
-- -   @bufferCapacityInput@ is the capacity of the buffer, or 0 to
--     indicate a request to retrieve the required capacity.
--
-- -   @bufferCountOutput@ is a pointer to the count of name characters
--     written (including the terminating @\\0@), or a pointer to the
--     required capacity in the case that @bufferCapacityInput@ is 0.
--
-- -   @buffer@ is a pointer to an application-allocated buffer that will
--     be filled with the source name. It /can/ be @NULL@ if
--     @bufferCapacityInput@ is 0.
--
-- -   See
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#buffer-size-parameters Buffer Size Parameters>
--     chapter for a detailed description of retrieving the required
--     @buffer@ size.
--
-- = Description
--
-- 'getInputSourceLocalizedName' returns a string for the input source in
-- the current system locale.
--
-- If 'attachSessionActionSets' has not yet been called for the session,
-- the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_ACTIONSET_NOT_ATTACHED'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-xrGetInputSourceLocalizedName-session-parameter# @session@
--     /must/ be a valid 'OpenXR.Core10.Handles.Session' handle
--
-- -   #VUID-xrGetInputSourceLocalizedName-getInfo-parameter# @getInfo@
--     /must/ be a pointer to a valid 'InputSourceLocalizedNameGetInfo'
--     structure
--
-- -   #VUID-xrGetInputSourceLocalizedName-bufferCountOutput-parameter#
--     @bufferCountOutput@ /must/ be a pointer to a @uint32_t@ value
--
-- -   #VUID-xrGetInputSourceLocalizedName-buffer-parameter# If
--     @bufferCapacityInput@ is not @0@, @buffer@ /must/ be a pointer to an
--     array of @bufferCapacityInput@ char values
--
-- == Return Codes
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-successcodes Success>]
--
--     -   'OpenXR.Core10.Enums.Result.SUCCESS'
--
--     -   'OpenXR.Core10.Enums.Result.SESSION_LOSS_PENDING'
--
-- [<https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#fundamentals-errorcodes Failure>]
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_INSTANCE_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SESSION_LOST'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_RUNTIME_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_HANDLE_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_VALIDATION_FAILURE'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_SIZE_INSUFFICIENT'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_INVALID'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'
--
--     -   'OpenXR.Core10.Enums.Result.ERROR_ACTIONSET_NOT_ATTACHED'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Action', 'InputSourceLocalizedNameGetInfo',
-- 'OpenXR.Core10.Handles.Session'
getInputSourceLocalizedName :: forall io
                             . (MonadIO io)
                            => -- No documentation found for Nested "xrGetInputSourceLocalizedName" "session"
                               Session
                            -> -- No documentation found for Nested "xrGetInputSourceLocalizedName" "getInfo"
                               InputSourceLocalizedNameGetInfo
                            -> io (Result, ("buffer" ::: ByteString))
getInputSourceLocalizedName :: Session
-> InputSourceLocalizedNameGetInfo
-> io (Result, "buffer" ::: ByteString)
getInputSourceLocalizedName session :: Session
session getInfo :: InputSourceLocalizedNameGetInfo
getInfo = IO (Result, "buffer" ::: ByteString)
-> io (Result, "buffer" ::: ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Result, "buffer" ::: ByteString)
 -> io (Result, "buffer" ::: ByteString))
-> (ContT
      (Result, "buffer" ::: ByteString)
      IO
      (Result, "buffer" ::: ByteString)
    -> IO (Result, "buffer" ::: ByteString))
-> ContT
     (Result, "buffer" ::: ByteString)
     IO
     (Result, "buffer" ::: ByteString)
-> io (Result, "buffer" ::: ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT
  (Result, "buffer" ::: ByteString)
  IO
  (Result, "buffer" ::: ByteString)
-> IO (Result, "buffer" ::: ByteString)
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT
   (Result, "buffer" ::: ByteString)
   IO
   (Result, "buffer" ::: ByteString)
 -> io (Result, "buffer" ::: ByteString))
-> ContT
     (Result, "buffer" ::: ByteString)
     IO
     (Result, "buffer" ::: ByteString)
-> io (Result, "buffer" ::: ByteString)
forall a b. (a -> b) -> a -> b
$ do
  let xrGetInputSourceLocalizedNamePtr :: FunPtr
  (Ptr Session_T
   -> Ptr InputSourceLocalizedNameGetInfo
   -> ("sourceCapacityInput" ::: Word32)
   -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> ("buffer" ::: Ptr CChar)
   -> IO Result)
xrGetInputSourceLocalizedNamePtr = InstanceCmds
-> FunPtr
     (Ptr Session_T
      -> Ptr InputSourceLocalizedNameGetInfo
      -> ("sourceCapacityInput" ::: Word32)
      -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
      -> ("buffer" ::: Ptr CChar)
      -> IO Result)
pXrGetInputSourceLocalizedName (Session -> InstanceCmds
instanceCmds (Session
session :: Session))
  IO () -> ContT (Result, "buffer" ::: ByteString) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "buffer" ::: ByteString) IO ())
-> IO () -> ContT (Result, "buffer" ::: ByteString) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FunPtr
  (Ptr Session_T
   -> Ptr InputSourceLocalizedNameGetInfo
   -> ("sourceCapacityInput" ::: Word32)
   -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> ("buffer" ::: Ptr CChar)
   -> IO Result)
xrGetInputSourceLocalizedNamePtr FunPtr
  (Ptr Session_T
   -> Ptr InputSourceLocalizedNameGetInfo
   -> ("sourceCapacityInput" ::: Word32)
   -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> ("buffer" ::: Ptr CChar)
   -> IO Result)
-> FunPtr
     (Ptr Session_T
      -> Ptr InputSourceLocalizedNameGetInfo
      -> ("sourceCapacityInput" ::: Word32)
      -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
      -> ("buffer" ::: Ptr CChar)
      -> IO Result)
-> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr
  (Ptr Session_T
   -> Ptr InputSourceLocalizedNameGetInfo
   -> ("sourceCapacityInput" ::: Word32)
   -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> ("buffer" ::: Ptr CChar)
   -> IO Result)
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "The function pointer for xrGetInputSourceLocalizedName is null" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
  let xrGetInputSourceLocalizedName' :: Ptr Session_T
-> Ptr InputSourceLocalizedNameGetInfo
-> ("sourceCapacityInput" ::: Word32)
-> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("buffer" ::: Ptr CChar)
-> IO Result
xrGetInputSourceLocalizedName' = FunPtr
  (Ptr Session_T
   -> Ptr InputSourceLocalizedNameGetInfo
   -> ("sourceCapacityInput" ::: Word32)
   -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> ("buffer" ::: Ptr CChar)
   -> IO Result)
-> Ptr Session_T
-> Ptr InputSourceLocalizedNameGetInfo
-> ("sourceCapacityInput" ::: Word32)
-> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("buffer" ::: Ptr CChar)
-> IO Result
mkXrGetInputSourceLocalizedName FunPtr
  (Ptr Session_T
   -> Ptr InputSourceLocalizedNameGetInfo
   -> ("sourceCapacityInput" ::: Word32)
   -> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> ("buffer" ::: Ptr CChar)
   -> IO Result)
xrGetInputSourceLocalizedNamePtr
  let session' :: Ptr Session_T
session' = Session -> Ptr Session_T
sessionHandle (Session
session)
  Ptr InputSourceLocalizedNameGetInfo
getInfo' <- ((Ptr InputSourceLocalizedNameGetInfo
  -> IO (Result, "buffer" ::: ByteString))
 -> IO (Result, "buffer" ::: ByteString))
-> ContT
     (Result, "buffer" ::: ByteString)
     IO
     (Ptr InputSourceLocalizedNameGetInfo)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr InputSourceLocalizedNameGetInfo
   -> IO (Result, "buffer" ::: ByteString))
  -> IO (Result, "buffer" ::: ByteString))
 -> ContT
      (Result, "buffer" ::: ByteString)
      IO
      (Ptr InputSourceLocalizedNameGetInfo))
-> ((Ptr InputSourceLocalizedNameGetInfo
     -> IO (Result, "buffer" ::: ByteString))
    -> IO (Result, "buffer" ::: ByteString))
-> ContT
     (Result, "buffer" ::: ByteString)
     IO
     (Ptr InputSourceLocalizedNameGetInfo)
forall a b. (a -> b) -> a -> b
$ InputSourceLocalizedNameGetInfo
-> (Ptr InputSourceLocalizedNameGetInfo
    -> IO (Result, "buffer" ::: ByteString))
-> IO (Result, "buffer" ::: ByteString)
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct (InputSourceLocalizedNameGetInfo
getInfo)
  "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
pBufferCountOutput <- ((("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
  -> IO (Result, "buffer" ::: ByteString))
 -> IO (Result, "buffer" ::: ByteString))
-> ContT
     (Result, "buffer" ::: ByteString)
     IO
     ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
   -> IO (Result, "buffer" ::: ByteString))
  -> IO (Result, "buffer" ::: ByteString))
 -> ContT
      (Result, "buffer" ::: ByteString)
      IO
      ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)))
-> ((("sourceCountOutput"
      ::: Ptr ("sourceCapacityInput" ::: Word32))
     -> IO (Result, "buffer" ::: ByteString))
    -> IO (Result, "buffer" ::: ByteString))
-> ContT
     (Result, "buffer" ::: ByteString)
     IO
     ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
forall a b. (a -> b) -> a -> b
$ IO ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> (("sourceCountOutput"
     ::: Ptr ("sourceCapacityInput" ::: Word32))
    -> IO ())
-> (("sourceCountOutput"
     ::: Ptr ("sourceCapacityInput" ::: Word32))
    -> IO (Result, "buffer" ::: ByteString))
-> IO (Result, "buffer" ::: ByteString)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int
-> IO
     ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
forall a. Int -> IO (Ptr a)
callocBytes @Word32 4) ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> IO ()
forall a. Ptr a -> IO ()
free
  Result
r <- IO Result -> ContT (Result, "buffer" ::: ByteString) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, "buffer" ::: ByteString) IO Result)
-> IO Result -> ContT (Result, "buffer" ::: ByteString) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrGetInputSourceLocalizedName" (Ptr Session_T
-> Ptr InputSourceLocalizedNameGetInfo
-> ("sourceCapacityInput" ::: Word32)
-> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("buffer" ::: Ptr CChar)
-> IO Result
xrGetInputSourceLocalizedName' Ptr Session_T
session' Ptr InputSourceLocalizedNameGetInfo
getInfo' (0) ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
pBufferCountOutput) ("buffer" ::: Ptr CChar
forall a. Ptr a
nullPtr))
  IO () -> ContT (Result, "buffer" ::: ByteString) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "buffer" ::: ByteString) IO ())
-> IO () -> ContT (Result, "buffer" ::: ByteString) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r))
  "sourceCapacityInput" ::: Word32
bufferCountOutput <- IO ("sourceCapacityInput" ::: Word32)
-> ContT
     (Result, "buffer" ::: ByteString)
     IO
     ("sourceCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("sourceCapacityInput" ::: Word32)
 -> ContT
      (Result, "buffer" ::: ByteString)
      IO
      ("sourceCapacityInput" ::: Word32))
-> IO ("sourceCapacityInput" ::: Word32)
-> ContT
     (Result, "buffer" ::: ByteString)
     IO
     ("sourceCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> IO ("sourceCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
pBufferCountOutput
  "buffer" ::: Ptr CChar
pBuffer <- ((("buffer" ::: Ptr CChar) -> IO (Result, "buffer" ::: ByteString))
 -> IO (Result, "buffer" ::: ByteString))
-> ContT
     (Result, "buffer" ::: ByteString) IO ("buffer" ::: Ptr CChar)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("buffer" ::: Ptr CChar)
   -> IO (Result, "buffer" ::: ByteString))
  -> IO (Result, "buffer" ::: ByteString))
 -> ContT
      (Result, "buffer" ::: ByteString) IO ("buffer" ::: Ptr CChar))
-> ((("buffer" ::: Ptr CChar)
     -> IO (Result, "buffer" ::: ByteString))
    -> IO (Result, "buffer" ::: ByteString))
-> ContT
     (Result, "buffer" ::: ByteString) IO ("buffer" ::: Ptr CChar)
forall a b. (a -> b) -> a -> b
$ IO ("buffer" ::: Ptr CChar)
-> (("buffer" ::: Ptr CChar) -> IO ())
-> (("buffer" ::: Ptr CChar)
    -> IO (Result, "buffer" ::: ByteString))
-> IO (Result, "buffer" ::: ByteString)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Int -> IO ("buffer" ::: Ptr CChar)
forall a. Int -> IO (Ptr a)
callocBytes @CChar (("sourceCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ("sourceCapacityInput" ::: Word32
bufferCountOutput))) ("buffer" ::: Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
free
  Result
r' <- IO Result -> ContT (Result, "buffer" ::: ByteString) IO Result
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Result -> ContT (Result, "buffer" ::: ByteString) IO Result)
-> IO Result -> ContT (Result, "buffer" ::: ByteString) IO Result
forall a b. (a -> b) -> a -> b
$ String -> IO Result -> IO Result
forall a. String -> IO a -> IO a
traceAroundEvent "xrGetInputSourceLocalizedName" (Ptr Session_T
-> Ptr InputSourceLocalizedNameGetInfo
-> ("sourceCapacityInput" ::: Word32)
-> ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("buffer" ::: Ptr CChar)
-> IO Result
xrGetInputSourceLocalizedName' Ptr Session_T
session' Ptr InputSourceLocalizedNameGetInfo
getInfo' (("sourceCapacityInput" ::: Word32
bufferCountOutput)) ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
pBufferCountOutput) ("buffer" ::: Ptr CChar
pBuffer))
  IO () -> ContT (Result, "buffer" ::: ByteString) IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT (Result, "buffer" ::: ByteString) IO ())
-> IO () -> ContT (Result, "buffer" ::: ByteString) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Result
r' Result -> Result -> Bool
forall a. Ord a => a -> a -> Bool
< Result
SUCCESS) (OpenXrException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Result -> OpenXrException
OpenXrException Result
r'))
  "buffer" ::: ByteString
buffer' <- IO ("buffer" ::: ByteString)
-> ContT
     (Result, "buffer" ::: ByteString) IO ("buffer" ::: ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("buffer" ::: ByteString)
 -> ContT
      (Result, "buffer" ::: ByteString) IO ("buffer" ::: ByteString))
-> IO ("buffer" ::: ByteString)
-> ContT
     (Result, "buffer" ::: ByteString) IO ("buffer" ::: ByteString)
forall a b. (a -> b) -> a -> b
$ ("buffer" ::: Ptr CChar) -> IO ("buffer" ::: ByteString)
packCString "buffer" ::: Ptr CChar
pBuffer
  (Result, "buffer" ::: ByteString)
-> ContT
     (Result, "buffer" ::: ByteString)
     IO
     (Result, "buffer" ::: ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Result, "buffer" ::: ByteString)
 -> ContT
      (Result, "buffer" ::: ByteString)
      IO
      (Result, "buffer" ::: ByteString))
-> (Result, "buffer" ::: ByteString)
-> ContT
     (Result, "buffer" ::: ByteString)
     IO
     (Result, "buffer" ::: ByteString)
forall a b. (a -> b) -> a -> b
$ ((Result
r'), "buffer" ::: ByteString
buffer')


-- | XrVector2f - Two-dimensional vector
--
-- == Member Descriptions
--
-- = Description
--
-- If used to represent physical distances (rather than e.g. normalized
-- direction) and not otherwise specified, values /must/ be in meters.
--
-- = See Also
--
-- 'ActionStateVector2f',
-- 'OpenXR.Extensions.XR_KHR_composition_layer_equirect.CompositionLayerEquirectKHR',
-- 'OpenXR.Core10.Space.Posef', 'OpenXR.Core10.Space.Quaternionf',
-- 'OpenXR.Core10.Space.Vector3f', 'OpenXR.Core10.OtherTypes.Vector4f',
-- 'OpenXR.Extensions.XR_KHR_visibility_mask.VisibilityMaskKHR',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#xrSetInputDeviceStateVector2fEXT xrSetInputDeviceStateVector2fEXT>
data Vector2f = Vector2f
  { -- | @x@ is the x coordinate of the vector.
    Vector2f -> Float
x :: Float
  , -- | @y@ is the y coordinate of the vector.
    Vector2f -> Float
y :: Float
  }
  deriving (Typeable, Vector2f -> Vector2f -> Bool
(Vector2f -> Vector2f -> Bool)
-> (Vector2f -> Vector2f -> Bool) -> Eq Vector2f
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vector2f -> Vector2f -> Bool
$c/= :: Vector2f -> Vector2f -> Bool
== :: Vector2f -> Vector2f -> Bool
$c== :: Vector2f -> Vector2f -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (Vector2f)
#endif
deriving instance Show Vector2f

instance ToCStruct Vector2f where
  withCStruct :: Vector2f -> (Ptr Vector2f -> IO b) -> IO b
withCStruct x :: Vector2f
x f :: Ptr Vector2f -> IO b
f = Int -> Int -> (Ptr Vector2f -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 8 4 ((Ptr Vector2f -> IO b) -> IO b) -> (Ptr Vector2f -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Vector2f
p -> Ptr Vector2f -> Vector2f -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr Vector2f
p Vector2f
x (Ptr Vector2f -> IO b
f Ptr Vector2f
p)
  pokeCStruct :: Ptr Vector2f -> Vector2f -> IO b -> IO b
pokeCStruct p :: Ptr Vector2f
p Vector2f{..} f :: IO b
f = do
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Vector2f
p Ptr Vector2f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
x))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Vector2f
p Ptr Vector2f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
y))
    IO b
f
  cStructSize :: Int
cStructSize = 8
  cStructAlignment :: Int
cStructAlignment = 4
  pokeZeroCStruct :: Ptr Vector2f -> IO b -> IO b
pokeZeroCStruct p :: Ptr Vector2f
p f :: IO b
f = do
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Vector2f
p Ptr Vector2f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr Vector2f
p Ptr Vector2f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct Vector2f where
  peekCStruct :: Ptr Vector2f -> IO Vector2f
peekCStruct p :: Ptr Vector2f
p = do
    CFloat
x <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Vector2f
p Ptr Vector2f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr CFloat))
    CFloat
y <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr Vector2f
p Ptr Vector2f -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 4 :: Ptr CFloat))
    Vector2f -> IO Vector2f
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector2f -> IO Vector2f) -> Vector2f -> IO Vector2f
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Vector2f
Vector2f
             (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
x) (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
y)

instance Storable Vector2f where
  sizeOf :: Vector2f -> Int
sizeOf ~Vector2f
_ = 8
  alignment :: Vector2f -> Int
alignment ~Vector2f
_ = 4
  peek :: Ptr Vector2f -> IO Vector2f
peek = Ptr Vector2f -> IO Vector2f
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr Vector2f -> Vector2f -> IO ()
poke ptr :: Ptr Vector2f
ptr poked :: Vector2f
poked = Ptr Vector2f -> Vector2f -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr Vector2f
ptr Vector2f
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero Vector2f where
  zero :: Vector2f
zero = Float -> Float -> Vector2f
Vector2f
           Float
forall a. Zero a => a
zero
           Float
forall a. Zero a => a
zero


-- | XrActionStateBoolean - Boolean action state
--
-- == Member Descriptions
--
-- = Description
--
-- When multiple input sources are bound to this action, the @currentState@
-- follows
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#multiple_inputs the previously defined rule to resolve ambiguity>.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrBool32 >,
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >,
-- 'getActionStateBoolean'
data ActionStateBoolean = ActionStateBoolean
  { -- | @currentState@ is the current state of the action.
    ActionStateBoolean -> Bool
currentState :: Bool
  , -- | @changedSinceLastSync@ is 'OpenXR.Core10.FundamentalTypes.TRUE' if the
    -- value of @currentState@ is different than it was before the most recent
    -- call to 'syncActions'. This parameter can be combined with
    -- @currentState@ to detect rising and falling edges since the previous
    -- call to 'syncActions'. E.g. if both @changedSinceLastSync@ and
    -- @currentState@ are 'OpenXR.Core10.FundamentalTypes.TRUE' then a rising
    -- edge ('OpenXR.Core10.FundamentalTypes.FALSE' to
    -- 'OpenXR.Core10.FundamentalTypes.TRUE') has taken place.
    ActionStateBoolean -> Bool
changedSinceLastSync :: Bool
  , -- | @lastChangeTime@ is the
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
    -- when this action’s value last changed.
    ActionStateBoolean -> Time
lastChangeTime :: Time
  , -- | @isActive@ is 'OpenXR.Core10.FundamentalTypes.TRUE' if and only if there
    -- exists an input source that is contributing to the current state of this
    -- action.
    ActionStateBoolean -> Bool
isActive :: Bool
  }
  deriving (Typeable, ActionStateBoolean -> ActionStateBoolean -> Bool
(ActionStateBoolean -> ActionStateBoolean -> Bool)
-> (ActionStateBoolean -> ActionStateBoolean -> Bool)
-> Eq ActionStateBoolean
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionStateBoolean -> ActionStateBoolean -> Bool
$c/= :: ActionStateBoolean -> ActionStateBoolean -> Bool
== :: ActionStateBoolean -> ActionStateBoolean -> Bool
$c== :: ActionStateBoolean -> ActionStateBoolean -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ActionStateBoolean)
#endif
deriving instance Show ActionStateBoolean

instance ToCStruct ActionStateBoolean where
  withCStruct :: ActionStateBoolean -> (Ptr ActionStateBoolean -> IO b) -> IO b
withCStruct x :: ActionStateBoolean
x f :: Ptr ActionStateBoolean -> IO b
f = Int -> Int -> (Ptr ActionStateBoolean -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((Ptr ActionStateBoolean -> IO b) -> IO b)
-> (Ptr ActionStateBoolean -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ActionStateBoolean
p -> Ptr ActionStateBoolean -> ActionStateBoolean -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionStateBoolean
p ActionStateBoolean
x (Ptr ActionStateBoolean -> IO b
f Ptr ActionStateBoolean
p)
  pokeCStruct :: Ptr ActionStateBoolean -> ActionStateBoolean -> IO b -> IO b
pokeCStruct p :: Ptr ActionStateBoolean
p ActionStateBoolean{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_STATE_BOOLEAN)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
currentState))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
changedSinceLastSync))
    Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Time)) (Time
lastChangeTime)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
isActive))
    IO b
f
  cStructSize :: Int
cStructSize = 40
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ActionStateBoolean -> IO b -> IO b
pokeZeroCStruct p :: Ptr ActionStateBoolean
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_STATE_BOOLEAN)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Time)) (Time
forall a. Zero a => a
zero)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct ActionStateBoolean where
  peekCStruct :: Ptr ActionStateBoolean -> IO ActionStateBoolean
peekCStruct p :: Ptr ActionStateBoolean
p = do
    Bool32
currentState <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32))
    Bool32
changedSinceLastSync <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32))
    Time
lastChangeTime <- Ptr Time -> IO Time
forall a. Storable a => Ptr a -> IO a
peek @Time ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Time))
    Bool32
isActive <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr ActionStateBoolean
p Ptr ActionStateBoolean -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Bool32))
    ActionStateBoolean -> IO ActionStateBoolean
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionStateBoolean -> IO ActionStateBoolean)
-> ActionStateBoolean -> IO ActionStateBoolean
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Time -> Bool -> ActionStateBoolean
ActionStateBoolean
             (Bool32 -> Bool
bool32ToBool Bool32
currentState) (Bool32 -> Bool
bool32ToBool Bool32
changedSinceLastSync) Time
lastChangeTime (Bool32 -> Bool
bool32ToBool Bool32
isActive)

instance Storable ActionStateBoolean where
  sizeOf :: ActionStateBoolean -> Int
sizeOf ~ActionStateBoolean
_ = 40
  alignment :: ActionStateBoolean -> Int
alignment ~ActionStateBoolean
_ = 8
  peek :: Ptr ActionStateBoolean -> IO ActionStateBoolean
peek = Ptr ActionStateBoolean -> IO ActionStateBoolean
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr ActionStateBoolean -> ActionStateBoolean -> IO ()
poke ptr :: Ptr ActionStateBoolean
ptr poked :: ActionStateBoolean
poked = Ptr ActionStateBoolean -> ActionStateBoolean -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionStateBoolean
ptr ActionStateBoolean
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ActionStateBoolean where
  zero :: ActionStateBoolean
zero = Bool -> Bool -> Time -> Bool -> ActionStateBoolean
ActionStateBoolean
           Bool
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero
           Time
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero


-- | XrActionStateFloat - Floating point action state
--
-- == Member Descriptions
--
-- = Description
--
-- When multiple input sources are bound to this action, the @currentState@
-- follows
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#multiple_inputs the previously defined rule to resolve ambiguity>.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrBool32 >,
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >,
-- 'getActionStateFloat'
data ActionStateFloat = ActionStateFloat
  { -- | @currentState@ is the current state of the Action.
    ActionStateFloat -> Float
currentState :: Float
  , -- | @changedSinceLastSync@ is 'OpenXR.Core10.FundamentalTypes.TRUE' if the
    -- value of @currentState@ is different than it was before the most recent
    -- call to 'syncActions'.
    ActionStateFloat -> Bool
changedSinceLastSync :: Bool
  , -- | @lastChangeTime@ is the
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
    -- in nanoseconds since this action’s value last changed.
    ActionStateFloat -> Time
lastChangeTime :: Time
  , -- | @isActive@ is 'OpenXR.Core10.FundamentalTypes.TRUE' if and only if there
    -- exists an input source that is contributing to the current state of this
    -- action.
    ActionStateFloat -> Bool
isActive :: Bool
  }
  deriving (Typeable, ActionStateFloat -> ActionStateFloat -> Bool
(ActionStateFloat -> ActionStateFloat -> Bool)
-> (ActionStateFloat -> ActionStateFloat -> Bool)
-> Eq ActionStateFloat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionStateFloat -> ActionStateFloat -> Bool
$c/= :: ActionStateFloat -> ActionStateFloat -> Bool
== :: ActionStateFloat -> ActionStateFloat -> Bool
$c== :: ActionStateFloat -> ActionStateFloat -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ActionStateFloat)
#endif
deriving instance Show ActionStateFloat

instance ToCStruct ActionStateFloat where
  withCStruct :: ActionStateFloat -> (Ptr ActionStateFloat -> IO b) -> IO b
withCStruct x :: ActionStateFloat
x f :: Ptr ActionStateFloat -> IO b
f = Int -> Int -> (Ptr ActionStateFloat -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((Ptr ActionStateFloat -> IO b) -> IO b)
-> (Ptr ActionStateFloat -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ActionStateFloat
p -> Ptr ActionStateFloat -> ActionStateFloat -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionStateFloat
p ActionStateFloat
x (Ptr ActionStateFloat -> IO b
f Ptr ActionStateFloat
p)
  pokeCStruct :: Ptr ActionStateFloat -> ActionStateFloat -> IO b -> IO b
pokeCStruct p :: Ptr ActionStateFloat
p ActionStateFloat{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_STATE_FLOAT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
currentState))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
changedSinceLastSync))
    Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Time)) (Time
lastChangeTime)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
isActive))
    IO b
f
  cStructSize :: Int
cStructSize = 40
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ActionStateFloat -> IO b -> IO b
pokeZeroCStruct p :: Ptr ActionStateFloat
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_STATE_FLOAT)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr CFloat -> CFloat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CFloat)) (Float -> CFloat
CFloat (Float
forall a. Zero a => a
zero))
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Time)) (Time
forall a. Zero a => a
zero)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct ActionStateFloat where
  peekCStruct :: Ptr ActionStateFloat -> IO ActionStateFloat
peekCStruct p :: Ptr ActionStateFloat
p = do
    CFloat
currentState <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek @CFloat ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr CFloat
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr CFloat))
    Bool32
changedSinceLastSync <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 20 :: Ptr Bool32))
    Time
lastChangeTime <- Ptr Time -> IO Time
forall a. Storable a => Ptr a -> IO a
peek @Time ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Time))
    Bool32
isActive <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr ActionStateFloat
p Ptr ActionStateFloat -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Bool32))
    ActionStateFloat -> IO ActionStateFloat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionStateFloat -> IO ActionStateFloat)
-> ActionStateFloat -> IO ActionStateFloat
forall a b. (a -> b) -> a -> b
$ Float -> Bool -> Time -> Bool -> ActionStateFloat
ActionStateFloat
             (CFloat -> Float
forall a b. Coercible a b => a -> b
coerce @CFloat @Float CFloat
currentState) (Bool32 -> Bool
bool32ToBool Bool32
changedSinceLastSync) Time
lastChangeTime (Bool32 -> Bool
bool32ToBool Bool32
isActive)

instance Storable ActionStateFloat where
  sizeOf :: ActionStateFloat -> Int
sizeOf ~ActionStateFloat
_ = 40
  alignment :: ActionStateFloat -> Int
alignment ~ActionStateFloat
_ = 8
  peek :: Ptr ActionStateFloat -> IO ActionStateFloat
peek = Ptr ActionStateFloat -> IO ActionStateFloat
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr ActionStateFloat -> ActionStateFloat -> IO ()
poke ptr :: Ptr ActionStateFloat
ptr poked :: ActionStateFloat
poked = Ptr ActionStateFloat -> ActionStateFloat -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionStateFloat
ptr ActionStateFloat
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ActionStateFloat where
  zero :: ActionStateFloat
zero = Float -> Bool -> Time -> Bool -> ActionStateFloat
ActionStateFloat
           Float
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero
           Time
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero


-- | XrActionStateVector2f - 2D float vector action state
--
-- == Member Descriptions
--
-- = Description
--
-- When multiple input sources are bound to this action, the @currentState@
-- follows
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#multiple_inputs the previously defined rule to resolve ambiguity>.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrBool32 >,
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >,
-- 'Vector2f', 'getActionStateVector2f'
data ActionStateVector2f = ActionStateVector2f
  { -- | @currentState@ is the current 'Vector2f' state of the Action.
    ActionStateVector2f -> Vector2f
currentState :: Vector2f
  , -- | @changedSinceLastSync@ is 'OpenXR.Core10.FundamentalTypes.TRUE' if the
    -- value of @currentState@ is different than it was before the most recent
    -- call to 'syncActions'.
    ActionStateVector2f -> Bool
changedSinceLastSync :: Bool
  , -- | @lastChangeTime@ is the
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrTime >
    -- in nanoseconds since this action’s value last changed.
    ActionStateVector2f -> Time
lastChangeTime :: Time
  , -- | @isActive@ is 'OpenXR.Core10.FundamentalTypes.TRUE' if and only if there
    -- exists an input source that is contributing to the current state of this
    -- action.
    ActionStateVector2f -> Bool
isActive :: Bool
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ActionStateVector2f)
#endif
deriving instance Show ActionStateVector2f

instance ToCStruct ActionStateVector2f where
  withCStruct :: ActionStateVector2f -> (Ptr ActionStateVector2f -> IO b) -> IO b
withCStruct x :: ActionStateVector2f
x f :: Ptr ActionStateVector2f -> IO b
f = Int -> Int -> (Ptr ActionStateVector2f -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 48 8 ((Ptr ActionStateVector2f -> IO b) -> IO b)
-> (Ptr ActionStateVector2f -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ActionStateVector2f
p -> Ptr ActionStateVector2f -> ActionStateVector2f -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionStateVector2f
p ActionStateVector2f
x (Ptr ActionStateVector2f -> IO b
f Ptr ActionStateVector2f
p)
  pokeCStruct :: Ptr ActionStateVector2f -> ActionStateVector2f -> IO b -> IO b
pokeCStruct p :: Ptr ActionStateVector2f
p ActionStateVector2f{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_STATE_VECTOR2F)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Vector2f -> Vector2f -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr Vector2f
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Vector2f)) (Vector2f
currentState)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
changedSinceLastSync))
    Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Time)) (Time
lastChangeTime)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
isActive))
    IO b
f
  cStructSize :: Int
cStructSize = 48
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ActionStateVector2f -> IO b -> IO b
pokeZeroCStruct p :: Ptr ActionStateVector2f
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_STATE_VECTOR2F)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Vector2f -> Vector2f -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr Vector2f
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Vector2f)) (Vector2f
forall a. Zero a => a
zero)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    Ptr Time -> Time -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Time)) (Time
forall a. Zero a => a
zero)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct ActionStateVector2f where
  peekCStruct :: Ptr ActionStateVector2f -> IO ActionStateVector2f
peekCStruct p :: Ptr ActionStateVector2f
p = do
    Vector2f
currentState <- Ptr Vector2f -> IO Vector2f
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @Vector2f ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr Vector2f
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Vector2f))
    Bool32
changedSinceLastSync <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Bool32))
    Time
lastChangeTime <- Ptr Time -> IO Time
forall a. Storable a => Ptr a -> IO a
peek @Time ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr Time
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr Time))
    Bool32
isActive <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr ActionStateVector2f
p Ptr ActionStateVector2f -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 40 :: Ptr Bool32))
    ActionStateVector2f -> IO ActionStateVector2f
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionStateVector2f -> IO ActionStateVector2f)
-> ActionStateVector2f -> IO ActionStateVector2f
forall a b. (a -> b) -> a -> b
$ Vector2f -> Bool -> Time -> Bool -> ActionStateVector2f
ActionStateVector2f
             Vector2f
currentState (Bool32 -> Bool
bool32ToBool Bool32
changedSinceLastSync) Time
lastChangeTime (Bool32 -> Bool
bool32ToBool Bool32
isActive)

instance Storable ActionStateVector2f where
  sizeOf :: ActionStateVector2f -> Int
sizeOf ~ActionStateVector2f
_ = 48
  alignment :: ActionStateVector2f -> Int
alignment ~ActionStateVector2f
_ = 8
  peek :: Ptr ActionStateVector2f -> IO ActionStateVector2f
peek = Ptr ActionStateVector2f -> IO ActionStateVector2f
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr ActionStateVector2f -> ActionStateVector2f -> IO ()
poke ptr :: Ptr ActionStateVector2f
ptr poked :: ActionStateVector2f
poked = Ptr ActionStateVector2f -> ActionStateVector2f -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionStateVector2f
ptr ActionStateVector2f
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ActionStateVector2f where
  zero :: ActionStateVector2f
zero = Vector2f -> Bool -> Time -> Bool -> ActionStateVector2f
ActionStateVector2f
           Vector2f
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero
           Time
forall a. Zero a => a
zero
           Bool
forall a. Zero a => a
zero


-- | XrActionStatePose - Pose action metadata
--
-- == Member Descriptions
--
-- = Description
--
-- A pose action /must/ not be bound to multiple input sources, according
-- to
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#multiple_inputs the previously defined rule>.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrBool32 >,
-- 'OpenXR.Core10.Enums.StructureType.StructureType', 'getActionStatePose'
data ActionStatePose = ActionStatePose
  { -- | @isActive@ is 'OpenXR.Core10.FundamentalTypes.TRUE' if and only if there
    -- exists an input source that is being tracked by this pose action.
    ActionStatePose -> Bool
isActive :: Bool }
  deriving (Typeable, ActionStatePose -> ActionStatePose -> Bool
(ActionStatePose -> ActionStatePose -> Bool)
-> (ActionStatePose -> ActionStatePose -> Bool)
-> Eq ActionStatePose
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionStatePose -> ActionStatePose -> Bool
$c/= :: ActionStatePose -> ActionStatePose -> Bool
== :: ActionStatePose -> ActionStatePose -> Bool
$c== :: ActionStatePose -> ActionStatePose -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ActionStatePose)
#endif
deriving instance Show ActionStatePose

instance ToCStruct ActionStatePose where
  withCStruct :: ActionStatePose -> (Ptr ActionStatePose -> IO b) -> IO b
withCStruct x :: ActionStatePose
x f :: Ptr ActionStatePose -> IO b
f = Int -> Int -> (Ptr ActionStatePose -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr ActionStatePose -> IO b) -> IO b)
-> (Ptr ActionStatePose -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ActionStatePose
p -> Ptr ActionStatePose -> ActionStatePose -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionStatePose
p ActionStatePose
x (Ptr ActionStatePose -> IO b
f Ptr ActionStatePose
p)
  pokeCStruct :: Ptr ActionStatePose -> ActionStatePose -> IO b -> IO b
pokeCStruct p :: Ptr ActionStatePose
p ActionStatePose{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStatePose
p Ptr ActionStatePose -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_STATE_POSE)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStatePose
p Ptr ActionStatePose -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStatePose
p Ptr ActionStatePose -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
isActive))
    IO b
f
  cStructSize :: Int
cStructSize = 24
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ActionStatePose -> IO b -> IO b
pokeZeroCStruct p :: Ptr ActionStatePose
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStatePose
p Ptr ActionStatePose -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_STATE_POSE)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStatePose
p Ptr ActionStatePose -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr Bool32 -> Bool32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStatePose
p Ptr ActionStatePose -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32)) (Bool -> Bool32
boolToBool32 (Bool
forall a. Zero a => a
zero))
    IO b
f

instance FromCStruct ActionStatePose where
  peekCStruct :: Ptr ActionStatePose -> IO ActionStatePose
peekCStruct p :: Ptr ActionStatePose
p = do
    Bool32
isActive <- Ptr Bool32 -> IO Bool32
forall a. Storable a => Ptr a -> IO a
peek @Bool32 ((Ptr ActionStatePose
p Ptr ActionStatePose -> Int -> Ptr Bool32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Bool32))
    ActionStatePose -> IO ActionStatePose
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionStatePose -> IO ActionStatePose)
-> ActionStatePose -> IO ActionStatePose
forall a b. (a -> b) -> a -> b
$ Bool -> ActionStatePose
ActionStatePose
             (Bool32 -> Bool
bool32ToBool Bool32
isActive)

instance Storable ActionStatePose where
  sizeOf :: ActionStatePose -> Int
sizeOf ~ActionStatePose
_ = 24
  alignment :: ActionStatePose -> Int
alignment ~ActionStatePose
_ = 8
  peek :: Ptr ActionStatePose -> IO ActionStatePose
peek = Ptr ActionStatePose -> IO ActionStatePose
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr ActionStatePose -> ActionStatePose -> IO ()
poke ptr :: Ptr ActionStatePose
ptr poked :: ActionStatePose
poked = Ptr ActionStatePose -> ActionStatePose -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionStatePose
ptr ActionStatePose
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ActionStatePose where
  zero :: ActionStatePose
zero = Bool -> ActionStatePose
ActionStatePose
           Bool
forall a. Zero a => a
zero


-- | XrActionStateGetInfo - Information to get action state
--
-- == Member Descriptions
--
-- = Description
--
-- See 'ActionCreateInfo' for a description of subaction paths, and the
-- restrictions on their use.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Action',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >,
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'getActionStateBoolean', 'getActionStateFloat', 'getActionStatePose',
-- 'getActionStateVector2f'
data ActionStateGetInfo = ActionStateGetInfo
  { -- | @action@ is the 'OpenXR.Core10.Handles.Action' being queried.
    --
    -- #VUID-XrActionStateGetInfo-action-parameter# @action@ /must/ be a valid
    -- 'OpenXR.Core10.Handles.Action' handle
    ActionStateGetInfo -> Ptr Action_T
action :: Ptr Action_T
  , -- | @subactionPath@ is the subaction path
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >
    -- to query data from, or 'OpenXR.Core10.APIConstants.NULL_PATH' to specify
    -- all subaction paths. If the subaction path is specified, it is one of
    -- the subaction paths that were specified when the action was created. If
    -- the subaction path was not specified when the action was created, the
    -- runtime /must/ return
    -- 'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'. If this parameter
    -- is specified, the runtime /must/ return data that originates only from
    -- the subaction paths specified.
    ActionStateGetInfo -> "topLevelUserPath" ::: Path
subactionPath :: Path
  }
  deriving (Typeable, ActionStateGetInfo -> ActionStateGetInfo -> Bool
(ActionStateGetInfo -> ActionStateGetInfo -> Bool)
-> (ActionStateGetInfo -> ActionStateGetInfo -> Bool)
-> Eq ActionStateGetInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionStateGetInfo -> ActionStateGetInfo -> Bool
$c/= :: ActionStateGetInfo -> ActionStateGetInfo -> Bool
== :: ActionStateGetInfo -> ActionStateGetInfo -> Bool
$c== :: ActionStateGetInfo -> ActionStateGetInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ActionStateGetInfo)
#endif
deriving instance Show ActionStateGetInfo

instance ToCStruct ActionStateGetInfo where
  withCStruct :: ActionStateGetInfo -> (Ptr ActionStateGetInfo -> IO b) -> IO b
withCStruct x :: ActionStateGetInfo
x f :: Ptr ActionStateGetInfo -> IO b
f = Int -> Int -> (Ptr ActionStateGetInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr ActionStateGetInfo -> IO b) -> IO b)
-> (Ptr ActionStateGetInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ActionStateGetInfo
p -> Ptr ActionStateGetInfo -> ActionStateGetInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionStateGetInfo
p ActionStateGetInfo
x (Ptr ActionStateGetInfo -> IO b
f Ptr ActionStateGetInfo
p)
  pokeCStruct :: Ptr ActionStateGetInfo -> ActionStateGetInfo -> IO b -> IO b
pokeCStruct p :: Ptr ActionStateGetInfo
p ActionStateGetInfo{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateGetInfo
p Ptr ActionStateGetInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_STATE_GET_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateGetInfo
p Ptr ActionStateGetInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("action" ::: Ptr (Ptr Action_T)) -> Ptr Action_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateGetInfo
p Ptr ActionStateGetInfo -> Int -> "action" ::: Ptr (Ptr Action_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr Action_T))) (Ptr Action_T
action)
    ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("topLevelUserPath" ::: Path) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateGetInfo
p Ptr ActionStateGetInfo
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Path)) ("topLevelUserPath" ::: Path
subactionPath)
    IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ActionStateGetInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr ActionStateGetInfo
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateGetInfo
p Ptr ActionStateGetInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_STATE_GET_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateGetInfo
p Ptr ActionStateGetInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("action" ::: Ptr (Ptr Action_T)) -> Ptr Action_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionStateGetInfo
p Ptr ActionStateGetInfo -> Int -> "action" ::: Ptr (Ptr Action_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr Action_T))) (Ptr Action_T
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ActionStateGetInfo where
  peekCStruct :: Ptr ActionStateGetInfo -> IO ActionStateGetInfo
peekCStruct p :: Ptr ActionStateGetInfo
p = do
    Ptr Action_T
action <- ("action" ::: Ptr (Ptr Action_T)) -> IO (Ptr Action_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Action_T) ((Ptr ActionStateGetInfo
p Ptr ActionStateGetInfo -> Int -> "action" ::: Ptr (Ptr Action_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr Action_T)))
    "topLevelUserPath" ::: Path
subactionPath <- ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> IO ("topLevelUserPath" ::: Path)
forall a. Storable a => Ptr a -> IO a
peek @Path ((Ptr ActionStateGetInfo
p Ptr ActionStateGetInfo
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Path))
    ActionStateGetInfo -> IO ActionStateGetInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionStateGetInfo -> IO ActionStateGetInfo)
-> ActionStateGetInfo -> IO ActionStateGetInfo
forall a b. (a -> b) -> a -> b
$ Ptr Action_T -> ("topLevelUserPath" ::: Path) -> ActionStateGetInfo
ActionStateGetInfo
             Ptr Action_T
action "topLevelUserPath" ::: Path
subactionPath

instance Storable ActionStateGetInfo where
  sizeOf :: ActionStateGetInfo -> Int
sizeOf ~ActionStateGetInfo
_ = 32
  alignment :: ActionStateGetInfo -> Int
alignment ~ActionStateGetInfo
_ = 8
  peek :: Ptr ActionStateGetInfo -> IO ActionStateGetInfo
peek = Ptr ActionStateGetInfo -> IO ActionStateGetInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr ActionStateGetInfo -> ActionStateGetInfo -> IO ()
poke ptr :: Ptr ActionStateGetInfo
ptr poked :: ActionStateGetInfo
poked = Ptr ActionStateGetInfo -> ActionStateGetInfo -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionStateGetInfo
ptr ActionStateGetInfo
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ActionStateGetInfo where
  zero :: ActionStateGetInfo
zero = Ptr Action_T -> ("topLevelUserPath" ::: Path) -> ActionStateGetInfo
ActionStateGetInfo
           Ptr Action_T
forall a. Zero a => a
zero
           "topLevelUserPath" ::: Path
forall a. Zero a => a
zero


-- | XrActionSetCreateInfo - XrActionSet creation info
--
-- == Member Descriptions
--
-- = Description
--
-- When multiple actions are bound to the same input source, the @priority@
-- of each action set determines which bindings are suppressed. Runtimes
-- /must/ ignore input sources from action sets with a lower priority
-- number if those specific input sources are also present in active
-- actions within a higher priority action set. If multiple action sets
-- with the same priority are bound to the same input source and that is
-- the highest priority number, runtimes /must/ process all those bindings
-- at the same time.
--
-- Two actions are considered to be bound to the same input source if they
-- use the same
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#semantic-path-input identifier and optional location>
-- path segments, even if they have different component segments.
--
-- When runtimes are ignoring bindings because of priority, they /must/
-- treat the binding to that input source as though they do not exist. That
-- means the @isActive@ field /must/ be
-- 'OpenXR.Core10.FundamentalTypes.FALSE' when retrieving action data, and
-- that the runtime /must/ not provide any visual, haptic, or other
-- feedback related to the binding of that action to that input source.
-- Other actions in the same action set which are bound to input sources
-- that do not collide are not affected and are processed as normal.
--
-- If @actionSetName@ or @localizedActionSetName@ are empty strings, the
-- runtime /must/ return 'OpenXR.Core10.Enums.Result.ERROR_NAME_INVALID' or
-- 'OpenXR.Core10.Enums.Result.ERROR_LOCALIZED_NAME_INVALID' respectively.
-- If @actionSetName@ or @localizedActionSetName@ are duplicates of the
-- corresponding field for any existing action set in the specified
-- instance, the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_NAME_DUPLICATED' or
-- 'OpenXR.Core10.Enums.Result.ERROR_LOCALIZED_NAME_DUPLICATED'
-- respectively. If the conflicting action set is destroyed, the
-- conflicting field is no longer considered duplicated. If @actionSetName@
-- contains characters which are not allowed in a single level of a
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#well-formed-path-strings well-formed path string>,
-- the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_PATH_FORMAT_INVALID'.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.ActionSet',
-- 'OpenXR.Core10.Enums.StructureType.StructureType', 'createActionSet'
data ActionSetCreateInfo = ActionSetCreateInfo
  { -- | @actionSetName@ is an array containing a @NULL@ terminated non-empty
    -- string with the name of this action set.
    --
    -- #VUID-XrActionSetCreateInfo-actionSetName-parameter# @actionSetName@
    -- /must/ be a null-terminated UTF-8 string whose length is less than or
    -- equal to 'OpenXR.Core10.APIConstants.MAX_ACTION_SET_NAME_SIZE'
    ActionSetCreateInfo -> "buffer" ::: ByteString
actionSetName :: ByteString
  , -- | @localizedActionSetName@ is an array containing a @NULL@ terminated
    -- @UTF@-8 string that can be presented to the user as a description of the
    -- action set. This string should be presented in the system’s current
    -- active locale.
    --
    -- #VUID-XrActionSetCreateInfo-localizedActionSetName-parameter#
    -- @localizedActionSetName@ /must/ be a null-terminated UTF-8 string whose
    -- length is less than or equal to
    -- 'OpenXR.Core10.APIConstants.MAX_LOCALIZED_ACTION_SET_NAME_SIZE'
    ActionSetCreateInfo -> "buffer" ::: ByteString
localizedActionSetName :: ByteString
  , -- | @priority@ defines which action sets\' actions are active on a given
    -- input source when actions on multiple active action sets are bound to
    -- the same input source. Larger priority numbers take precedence over
    -- smaller priority numbers.
    ActionSetCreateInfo -> "sourceCapacityInput" ::: Word32
priority :: Word32
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ActionSetCreateInfo)
#endif
deriving instance Show ActionSetCreateInfo

instance ToCStruct ActionSetCreateInfo where
  withCStruct :: ActionSetCreateInfo -> (Ptr ActionSetCreateInfo -> IO b) -> IO b
withCStruct x :: ActionSetCreateInfo
x f :: Ptr ActionSetCreateInfo -> IO b
f = Int -> Int -> (Ptr ActionSetCreateInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 216 8 ((Ptr ActionSetCreateInfo -> IO b) -> IO b)
-> (Ptr ActionSetCreateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ActionSetCreateInfo
p -> Ptr ActionSetCreateInfo -> ActionSetCreateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionSetCreateInfo
p ActionSetCreateInfo
x (Ptr ActionSetCreateInfo -> IO b
f Ptr ActionSetCreateInfo
p)
  pokeCStruct :: Ptr ActionSetCreateInfo -> ActionSetCreateInfo -> IO b -> IO b
pokeCStruct p :: Ptr ActionSetCreateInfo
p ActionSetCreateInfo{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionSetCreateInfo
p Ptr ActionSetCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_SET_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionSetCreateInfo
p Ptr ActionSetCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar)
-> ("buffer" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("buffer" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr ActionSetCreateInfo
p Ptr ActionSetCreateInfo
-> Int -> Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar))) ("buffer" ::: ByteString
actionSetName)
    Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar)
-> ("buffer" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("buffer" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr ActionSetCreateInfo
p Ptr ActionSetCreateInfo
-> Int -> Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 80 :: Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar))) ("buffer" ::: ByteString
localizedActionSetName)
    ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("sourceCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionSetCreateInfo
p Ptr ActionSetCreateInfo
-> Int
-> "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 208 :: Ptr Word32)) ("sourceCapacityInput" ::: Word32
priority)
    IO b
f
  cStructSize :: Int
cStructSize = 216
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ActionSetCreateInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr ActionSetCreateInfo
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionSetCreateInfo
p Ptr ActionSetCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_SET_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionSetCreateInfo
p Ptr ActionSetCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar)
-> ("buffer" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("buffer" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr ActionSetCreateInfo
p Ptr ActionSetCreateInfo
-> Int -> Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar))) ("buffer" ::: ByteString
forall a. Monoid a => a
mempty)
    Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar)
-> ("buffer" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("buffer" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr ActionSetCreateInfo
p Ptr ActionSetCreateInfo
-> Int -> Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 80 :: Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar))) ("buffer" ::: ByteString
forall a. Monoid a => a
mempty)
    ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("sourceCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionSetCreateInfo
p Ptr ActionSetCreateInfo
-> Int
-> "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 208 :: Ptr Word32)) ("sourceCapacityInput" ::: Word32
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ActionSetCreateInfo where
  peekCStruct :: Ptr ActionSetCreateInfo -> IO ActionSetCreateInfo
peekCStruct p :: Ptr ActionSetCreateInfo
p = do
    "buffer" ::: ByteString
actionSetName <- ("buffer" ::: Ptr CChar) -> IO ("buffer" ::: ByteString)
packCString (Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar)
-> "buffer" ::: Ptr CChar
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr ActionSetCreateInfo
p Ptr ActionSetCreateInfo
-> Int -> Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar))))
    "buffer" ::: ByteString
localizedActionSetName <- ("buffer" ::: Ptr CChar) -> IO ("buffer" ::: ByteString)
packCString (Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar)
-> "buffer" ::: Ptr CChar
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr ActionSetCreateInfo
p Ptr ActionSetCreateInfo
-> Int -> Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 80 :: Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar))))
    "sourceCapacityInput" ::: Word32
priority <- ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> IO ("sourceCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ActionSetCreateInfo
p Ptr ActionSetCreateInfo
-> Int
-> "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 208 :: Ptr Word32))
    ActionSetCreateInfo -> IO ActionSetCreateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionSetCreateInfo -> IO ActionSetCreateInfo)
-> ActionSetCreateInfo -> IO ActionSetCreateInfo
forall a b. (a -> b) -> a -> b
$ ("buffer" ::: ByteString)
-> ("buffer" ::: ByteString)
-> ("sourceCapacityInput" ::: Word32)
-> ActionSetCreateInfo
ActionSetCreateInfo
             "buffer" ::: ByteString
actionSetName "buffer" ::: ByteString
localizedActionSetName "sourceCapacityInput" ::: Word32
priority

instance Storable ActionSetCreateInfo where
  sizeOf :: ActionSetCreateInfo -> Int
sizeOf ~ActionSetCreateInfo
_ = 216
  alignment :: ActionSetCreateInfo -> Int
alignment ~ActionSetCreateInfo
_ = 8
  peek :: Ptr ActionSetCreateInfo -> IO ActionSetCreateInfo
peek = Ptr ActionSetCreateInfo -> IO ActionSetCreateInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr ActionSetCreateInfo -> ActionSetCreateInfo -> IO ()
poke ptr :: Ptr ActionSetCreateInfo
ptr poked :: ActionSetCreateInfo
poked = Ptr ActionSetCreateInfo -> ActionSetCreateInfo -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionSetCreateInfo
ptr ActionSetCreateInfo
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ActionSetCreateInfo where
  zero :: ActionSetCreateInfo
zero = ("buffer" ::: ByteString)
-> ("buffer" ::: ByteString)
-> ("sourceCapacityInput" ::: Word32)
-> ActionSetCreateInfo
ActionSetCreateInfo
           "buffer" ::: ByteString
forall a. Monoid a => a
mempty
           "buffer" ::: ByteString
forall a. Monoid a => a
mempty
           "sourceCapacityInput" ::: Word32
forall a. Zero a => a
zero


-- | XrActionSuggestedBinding - Suggested binding for a single action
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Action', 'InteractionProfileSuggestedBinding',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >,
-- 'suggestInteractionProfileBindings'
data ActionSuggestedBinding = ActionSuggestedBinding
  { -- | @action@ is the 'OpenXR.Core10.Handles.Action' handle for an action
    --
    -- #VUID-XrActionSuggestedBinding-action-parameter# @action@ /must/ be a
    -- valid 'OpenXR.Core10.Handles.Action' handle
    ActionSuggestedBinding -> Ptr Action_T
action :: Ptr Action_T
  , -- | @binding@ is the
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >
    -- of a binding for the action specified in @action@. This path is any top
    -- level user path plus input source path, for example
    -- \/user\/hand\/right\/input\/trigger\/click. See
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#input-suggested-bindings suggested bindings>
    -- for more details.
    ActionSuggestedBinding -> "topLevelUserPath" ::: Path
binding :: Path
  }
  deriving (Typeable, ActionSuggestedBinding -> ActionSuggestedBinding -> Bool
(ActionSuggestedBinding -> ActionSuggestedBinding -> Bool)
-> (ActionSuggestedBinding -> ActionSuggestedBinding -> Bool)
-> Eq ActionSuggestedBinding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionSuggestedBinding -> ActionSuggestedBinding -> Bool
$c/= :: ActionSuggestedBinding -> ActionSuggestedBinding -> Bool
== :: ActionSuggestedBinding -> ActionSuggestedBinding -> Bool
$c== :: ActionSuggestedBinding -> ActionSuggestedBinding -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ActionSuggestedBinding)
#endif
deriving instance Show ActionSuggestedBinding

instance ToCStruct ActionSuggestedBinding where
  withCStruct :: ActionSuggestedBinding
-> (Ptr ActionSuggestedBinding -> IO b) -> IO b
withCStruct x :: ActionSuggestedBinding
x f :: Ptr ActionSuggestedBinding -> IO b
f = Int -> Int -> (Ptr ActionSuggestedBinding -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr ActionSuggestedBinding -> IO b) -> IO b)
-> (Ptr ActionSuggestedBinding -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ActionSuggestedBinding
p -> Ptr ActionSuggestedBinding
-> ActionSuggestedBinding -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionSuggestedBinding
p ActionSuggestedBinding
x (Ptr ActionSuggestedBinding -> IO b
f Ptr ActionSuggestedBinding
p)
  pokeCStruct :: Ptr ActionSuggestedBinding
-> ActionSuggestedBinding -> IO b -> IO b
pokeCStruct p :: Ptr ActionSuggestedBinding
p ActionSuggestedBinding{..} f :: IO b
f = do
    ("action" ::: Ptr (Ptr Action_T)) -> Ptr Action_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionSuggestedBinding
p Ptr ActionSuggestedBinding
-> Int -> "action" ::: Ptr (Ptr Action_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr (Ptr Action_T))) (Ptr Action_T
action)
    ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("topLevelUserPath" ::: Path) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionSuggestedBinding
p Ptr ActionSuggestedBinding
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Path)) ("topLevelUserPath" ::: Path
binding)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ActionSuggestedBinding -> IO b -> IO b
pokeZeroCStruct p :: Ptr ActionSuggestedBinding
p f :: IO b
f = do
    ("action" ::: Ptr (Ptr Action_T)) -> Ptr Action_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionSuggestedBinding
p Ptr ActionSuggestedBinding
-> Int -> "action" ::: Ptr (Ptr Action_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr (Ptr Action_T))) (Ptr Action_T
forall a. Zero a => a
zero)
    ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("topLevelUserPath" ::: Path) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionSuggestedBinding
p Ptr ActionSuggestedBinding
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Path)) ("topLevelUserPath" ::: Path
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ActionSuggestedBinding where
  peekCStruct :: Ptr ActionSuggestedBinding -> IO ActionSuggestedBinding
peekCStruct p :: Ptr ActionSuggestedBinding
p = do
    Ptr Action_T
action <- ("action" ::: Ptr (Ptr Action_T)) -> IO (Ptr Action_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Action_T) ((Ptr ActionSuggestedBinding
p Ptr ActionSuggestedBinding
-> Int -> "action" ::: Ptr (Ptr Action_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr (Ptr Action_T)))
    "topLevelUserPath" ::: Path
binding <- ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> IO ("topLevelUserPath" ::: Path)
forall a. Storable a => Ptr a -> IO a
peek @Path ((Ptr ActionSuggestedBinding
p Ptr ActionSuggestedBinding
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Path))
    ActionSuggestedBinding -> IO ActionSuggestedBinding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionSuggestedBinding -> IO ActionSuggestedBinding)
-> ActionSuggestedBinding -> IO ActionSuggestedBinding
forall a b. (a -> b) -> a -> b
$ Ptr Action_T
-> ("topLevelUserPath" ::: Path) -> ActionSuggestedBinding
ActionSuggestedBinding
             Ptr Action_T
action "topLevelUserPath" ::: Path
binding

instance Storable ActionSuggestedBinding where
  sizeOf :: ActionSuggestedBinding -> Int
sizeOf ~ActionSuggestedBinding
_ = 16
  alignment :: ActionSuggestedBinding -> Int
alignment ~ActionSuggestedBinding
_ = 8
  peek :: Ptr ActionSuggestedBinding -> IO ActionSuggestedBinding
peek = Ptr ActionSuggestedBinding -> IO ActionSuggestedBinding
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr ActionSuggestedBinding -> ActionSuggestedBinding -> IO ()
poke ptr :: Ptr ActionSuggestedBinding
ptr poked :: ActionSuggestedBinding
poked = Ptr ActionSuggestedBinding
-> ActionSuggestedBinding -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionSuggestedBinding
ptr ActionSuggestedBinding
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ActionSuggestedBinding where
  zero :: ActionSuggestedBinding
zero = Ptr Action_T
-> ("topLevelUserPath" ::: Path) -> ActionSuggestedBinding
ActionSuggestedBinding
           Ptr Action_T
forall a. Zero a => a
zero
           "topLevelUserPath" ::: Path
forall a. Zero a => a
zero


-- | XrInteractionProfileSuggestedBinding - Suggested bindings for a
-- interaction profile
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrInteractionProfileSuggestedBinding-type-type# @type@ /must/
--     be
--     'OpenXR.Core10.Enums.StructureType.TYPE_INTERACTION_PROFILE_SUGGESTED_BINDING'
--
-- -   #VUID-XrInteractionProfileSuggestedBinding-next-next# @next@ /must/
--     be @NULL@ or a valid pointer to the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>.
--     See also:
--     'OpenXR.Extensions.XR_KHR_binding_modification.BindingModificationsKHR',
--     'OpenXR.Extensions.XR_VALVE_analog_threshold.InteractionProfileAnalogThresholdVALVE'
--
-- -   #VUID-XrInteractionProfileSuggestedBinding-suggestedBindings-parameter#
--     @suggestedBindings@ /must/ be a pointer to an array of
--     @countSuggestedBindings@ valid 'ActionSuggestedBinding' structures
--
-- -   #VUID-XrInteractionProfileSuggestedBinding-countSuggestedBindings-arraylength#
--     The @countSuggestedBindings@ parameter /must/ be greater than @0@
--
-- = See Also
--
-- 'ActionSuggestedBinding',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >,
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'suggestInteractionProfileBindings'
data InteractionProfileSuggestedBinding (es :: [Type]) = InteractionProfileSuggestedBinding
  { -- | @next@ is @NULL@ or a pointer to the next structure in a structure
    -- chain. No such structures are defined in core OpenXR.
    InteractionProfileSuggestedBinding es -> Chain es
next :: Chain es
  , -- | @interactionProfile@ is the
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >
    -- of an interaction profile.
    InteractionProfileSuggestedBinding es
-> "topLevelUserPath" ::: Path
interactionProfile :: Path
  , -- | @suggestedBindings@ is a pointer to an array of 'ActionSuggestedBinding'
    -- structures that define all of the application’s suggested bindings for
    -- the specified interaction profile.
    InteractionProfileSuggestedBinding es
-> Vector ActionSuggestedBinding
suggestedBindings :: Vector ActionSuggestedBinding
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (InteractionProfileSuggestedBinding (es :: [Type]))
#endif
deriving instance Show (Chain es) => Show (InteractionProfileSuggestedBinding es)

instance Extensible InteractionProfileSuggestedBinding where
  extensibleTypeName :: String
extensibleTypeName = "InteractionProfileSuggestedBinding"
  setNext :: InteractionProfileSuggestedBinding ds
-> Chain es -> InteractionProfileSuggestedBinding es
setNext x :: InteractionProfileSuggestedBinding ds
x next :: Chain es
next = InteractionProfileSuggestedBinding ds
x{$sel:next:InteractionProfileSuggestedBinding :: Chain es
next = Chain es
next}
  getNext :: InteractionProfileSuggestedBinding es -> Chain es
getNext InteractionProfileSuggestedBinding{..} = Chain es
next
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends InteractionProfileSuggestedBinding e => b) -> Maybe b
  extends :: proxy e
-> (Extends InteractionProfileSuggestedBinding e => b) -> Maybe b
extends _ f :: Extends InteractionProfileSuggestedBinding e => b
f
    | Just Refl <- (Typeable e, Typeable BindingModificationsKHR) =>
Maybe (e :~: BindingModificationsKHR)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @BindingModificationsKHR = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends InteractionProfileSuggestedBinding e => b
f
    | Just Refl <- (Typeable e, Typeable InteractionProfileAnalogThresholdVALVE) =>
Maybe (e :~: InteractionProfileAnalogThresholdVALVE)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @e @InteractionProfileAnalogThresholdVALVE = b -> Maybe b
forall a. a -> Maybe a
Just b
Extends InteractionProfileSuggestedBinding e => b
f
    | Bool
otherwise = Maybe b
forall a. Maybe a
Nothing

instance (Extendss InteractionProfileSuggestedBinding es, PokeChain es) => ToCStruct (InteractionProfileSuggestedBinding es) where
  withCStruct :: InteractionProfileSuggestedBinding es
-> (Ptr (InteractionProfileSuggestedBinding es) -> IO b) -> IO b
withCStruct x :: InteractionProfileSuggestedBinding es
x f :: Ptr (InteractionProfileSuggestedBinding es) -> IO b
f = Int
-> Int
-> (Ptr (InteractionProfileSuggestedBinding es) -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 40 8 ((Ptr (InteractionProfileSuggestedBinding es) -> IO b) -> IO b)
-> (Ptr (InteractionProfileSuggestedBinding es) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (InteractionProfileSuggestedBinding es)
p -> Ptr (InteractionProfileSuggestedBinding es)
-> InteractionProfileSuggestedBinding es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr (InteractionProfileSuggestedBinding es)
p InteractionProfileSuggestedBinding es
x (Ptr (InteractionProfileSuggestedBinding es) -> IO b
f Ptr (InteractionProfileSuggestedBinding es)
p)
  pokeCStruct :: Ptr (InteractionProfileSuggestedBinding es)
-> InteractionProfileSuggestedBinding es -> IO b -> IO b
pokeCStruct p :: Ptr (InteractionProfileSuggestedBinding es)
p InteractionProfileSuggestedBinding{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InteractionProfileSuggestedBinding es)
p Ptr (InteractionProfileSuggestedBinding es)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_INTERACTION_PROFILE_SUGGESTED_BINDING)
    Ptr ()
next'' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO b) -> IO b
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain (Chain es
next)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InteractionProfileSuggestedBinding es)
p Ptr (InteractionProfileSuggestedBinding es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
next''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("topLevelUserPath" ::: Path) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InteractionProfileSuggestedBinding es)
p Ptr (InteractionProfileSuggestedBinding es)
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Path)) ("topLevelUserPath" ::: Path
interactionProfile)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("sourceCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InteractionProfileSuggestedBinding es)
p Ptr (InteractionProfileSuggestedBinding es)
-> Int
-> "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32)) ((Int -> "sourceCapacityInput" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector ActionSuggestedBinding -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ActionSuggestedBinding -> Int)
-> Vector ActionSuggestedBinding -> Int
forall a b. (a -> b) -> a -> b
$ (Vector ActionSuggestedBinding
suggestedBindings)) :: Word32))
    Ptr ActionSuggestedBinding
pSuggestedBindings' <- ((Ptr ActionSuggestedBinding -> IO b) -> IO b)
-> ContT b IO (Ptr ActionSuggestedBinding)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ActionSuggestedBinding -> IO b) -> IO b)
 -> ContT b IO (Ptr ActionSuggestedBinding))
-> ((Ptr ActionSuggestedBinding -> IO b) -> IO b)
-> ContT b IO (Ptr ActionSuggestedBinding)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr ActionSuggestedBinding -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @ActionSuggestedBinding ((Vector ActionSuggestedBinding -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ActionSuggestedBinding
suggestedBindings)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16) 8
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> ActionSuggestedBinding -> IO ())
-> Vector ActionSuggestedBinding -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: ActionSuggestedBinding
e -> Ptr ActionSuggestedBinding -> ActionSuggestedBinding -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionSuggestedBinding
pSuggestedBindings' Ptr ActionSuggestedBinding -> Int -> Ptr ActionSuggestedBinding
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ActionSuggestedBinding) (ActionSuggestedBinding
e)) (Vector ActionSuggestedBinding
suggestedBindings)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ActionSuggestedBinding)
-> Ptr ActionSuggestedBinding -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InteractionProfileSuggestedBinding es)
p Ptr (InteractionProfileSuggestedBinding es)
-> Int -> Ptr (Ptr ActionSuggestedBinding)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr ActionSuggestedBinding))) (Ptr ActionSuggestedBinding
pSuggestedBindings')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 40
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr (InteractionProfileSuggestedBinding es) -> IO b -> IO b
pokeZeroCStruct p :: Ptr (InteractionProfileSuggestedBinding es)
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InteractionProfileSuggestedBinding es)
p Ptr (InteractionProfileSuggestedBinding es)
-> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_INTERACTION_PROFILE_SUGGESTED_BINDING)
    Ptr ()
pNext' <- (Ptr (Chain es) -> Ptr ())
-> ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr (Chain es) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr (ContT b IO (Ptr (Chain es)) -> ContT b IO (Ptr ()))
-> (((Ptr (Chain es) -> IO b) -> IO b)
    -> ContT b IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO b) -> IO b)
-> ContT b IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr (Chain es))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ()))
-> ((Ptr (Chain es) -> IO b) -> IO b) -> ContT b IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ forall a. PokeChain es => (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
(Ptr (Chain es) -> IO a) -> IO a
withZeroChain @es
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InteractionProfileSuggestedBinding es)
p Ptr (InteractionProfileSuggestedBinding es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) Ptr ()
pNext'
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("topLevelUserPath" ::: Path) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InteractionProfileSuggestedBinding es)
p Ptr (InteractionProfileSuggestedBinding es)
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Path)) ("topLevelUserPath" ::: Path
forall a. Zero a => a
zero)
    Ptr ActionSuggestedBinding
pSuggestedBindings' <- ((Ptr ActionSuggestedBinding -> IO b) -> IO b)
-> ContT b IO (Ptr ActionSuggestedBinding)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ActionSuggestedBinding -> IO b) -> IO b)
 -> ContT b IO (Ptr ActionSuggestedBinding))
-> ((Ptr ActionSuggestedBinding -> IO b) -> IO b)
-> ContT b IO (Ptr ActionSuggestedBinding)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr ActionSuggestedBinding -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @ActionSuggestedBinding ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16) 8
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> ActionSuggestedBinding -> IO ())
-> Vector ActionSuggestedBinding -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: ActionSuggestedBinding
e -> Ptr ActionSuggestedBinding -> ActionSuggestedBinding -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionSuggestedBinding
pSuggestedBindings' Ptr ActionSuggestedBinding -> Int -> Ptr ActionSuggestedBinding
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ActionSuggestedBinding) (ActionSuggestedBinding
e)) (Vector ActionSuggestedBinding
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ActionSuggestedBinding)
-> Ptr ActionSuggestedBinding -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr (InteractionProfileSuggestedBinding es)
p Ptr (InteractionProfileSuggestedBinding es)
-> Int -> Ptr (Ptr ActionSuggestedBinding)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr ActionSuggestedBinding))) (Ptr ActionSuggestedBinding
pSuggestedBindings')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance (Extendss InteractionProfileSuggestedBinding es, PeekChain es) => FromCStruct (InteractionProfileSuggestedBinding es) where
  peekCStruct :: Ptr (InteractionProfileSuggestedBinding es)
-> IO (InteractionProfileSuggestedBinding es)
peekCStruct p :: Ptr (InteractionProfileSuggestedBinding es)
p = do
    Ptr ()
next <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ()) ((Ptr (InteractionProfileSuggestedBinding es)
p Ptr (InteractionProfileSuggestedBinding es) -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ())))
    Chain es
next' <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain (Ptr () -> Ptr (Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
next)
    "topLevelUserPath" ::: Path
interactionProfile <- ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> IO ("topLevelUserPath" ::: Path)
forall a. Storable a => Ptr a -> IO a
peek @Path ((Ptr (InteractionProfileSuggestedBinding es)
p Ptr (InteractionProfileSuggestedBinding es)
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Path))
    "sourceCapacityInput" ::: Word32
countSuggestedBindings <- ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> IO ("sourceCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr (InteractionProfileSuggestedBinding es)
p Ptr (InteractionProfileSuggestedBinding es)
-> Int
-> "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr Word32))
    Ptr ActionSuggestedBinding
suggestedBindings <- Ptr (Ptr ActionSuggestedBinding) -> IO (Ptr ActionSuggestedBinding)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ActionSuggestedBinding) ((Ptr (InteractionProfileSuggestedBinding es)
p Ptr (InteractionProfileSuggestedBinding es)
-> Int -> Ptr (Ptr ActionSuggestedBinding)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 32 :: Ptr (Ptr ActionSuggestedBinding)))
    Vector ActionSuggestedBinding
suggestedBindings' <- Int
-> (Int -> IO ActionSuggestedBinding)
-> IO (Vector ActionSuggestedBinding)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (("sourceCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral "sourceCapacityInput" ::: Word32
countSuggestedBindings) (\i :: Int
i -> Ptr ActionSuggestedBinding -> IO ActionSuggestedBinding
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ActionSuggestedBinding ((Ptr ActionSuggestedBinding
suggestedBindings Ptr ActionSuggestedBinding -> Int -> Ptr ActionSuggestedBinding
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ActionSuggestedBinding)))
    InteractionProfileSuggestedBinding es
-> IO (InteractionProfileSuggestedBinding es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InteractionProfileSuggestedBinding es
 -> IO (InteractionProfileSuggestedBinding es))
-> InteractionProfileSuggestedBinding es
-> IO (InteractionProfileSuggestedBinding es)
forall a b. (a -> b) -> a -> b
$ Chain es
-> ("topLevelUserPath" ::: Path)
-> Vector ActionSuggestedBinding
-> InteractionProfileSuggestedBinding es
forall (es :: [*]).
Chain es
-> ("topLevelUserPath" ::: Path)
-> Vector ActionSuggestedBinding
-> InteractionProfileSuggestedBinding es
InteractionProfileSuggestedBinding
             Chain es
next' "topLevelUserPath" ::: Path
interactionProfile Vector ActionSuggestedBinding
suggestedBindings'

instance es ~ '[] => Zero (InteractionProfileSuggestedBinding es) where
  zero :: InteractionProfileSuggestedBinding es
zero = Chain es
-> ("topLevelUserPath" ::: Path)
-> Vector ActionSuggestedBinding
-> InteractionProfileSuggestedBinding es
forall (es :: [*]).
Chain es
-> ("topLevelUserPath" ::: Path)
-> Vector ActionSuggestedBinding
-> InteractionProfileSuggestedBinding es
InteractionProfileSuggestedBinding
           ()
           "topLevelUserPath" ::: Path
forall a. Zero a => a
zero
           Vector ActionSuggestedBinding
forall a. Monoid a => a
mempty


-- | XrActiveActionSet - Describes an active action set
--
-- == Member Descriptions
--
-- = Description
--
-- This structure defines a single active action set and subaction path
-- combination. Applications /can/ provide a list of these structures to
-- the 'syncActions' function.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.ActionSet', 'ActionsSyncInfo',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >,
-- 'syncActions'
data ActiveActionSet = ActiveActionSet
  { -- | @actionSet@ is the handle of the action set to activate.
    --
    -- #VUID-XrActiveActionSet-actionSet-parameter# @actionSet@ /must/ be a
    -- valid 'OpenXR.Core10.Handles.ActionSet' handle
    ActiveActionSet -> Ptr ActionSet_T
actionSet :: Ptr ActionSet_T
  , -- | @subactionPath@ is a subaction path that was declared when one or more
    -- actions in the action set was created or
    -- 'OpenXR.Core10.APIConstants.NULL_PATH'. If the application wants to
    -- activate the action set on more than one subaction path, it /can/
    -- include additional 'ActiveActionSet' structs with the other
    -- @subactionPath@ values. Using 'OpenXR.Core10.APIConstants.NULL_PATH' as
    -- the value for @subactionPath@, acts as a wildcard for all subaction
    -- paths on the actions in the action set. If the subaction path was not
    -- specified on any of the actions in the actionSet when that action was
    -- created, the runtime /must/ return
    -- 'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED'.
    ActiveActionSet -> "topLevelUserPath" ::: Path
subactionPath :: Path
  }
  deriving (Typeable, ActiveActionSet -> ActiveActionSet -> Bool
(ActiveActionSet -> ActiveActionSet -> Bool)
-> (ActiveActionSet -> ActiveActionSet -> Bool)
-> Eq ActiveActionSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActiveActionSet -> ActiveActionSet -> Bool
$c/= :: ActiveActionSet -> ActiveActionSet -> Bool
== :: ActiveActionSet -> ActiveActionSet -> Bool
$c== :: ActiveActionSet -> ActiveActionSet -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ActiveActionSet)
#endif
deriving instance Show ActiveActionSet

instance ToCStruct ActiveActionSet where
  withCStruct :: ActiveActionSet -> (Ptr ActiveActionSet -> IO b) -> IO b
withCStruct x :: ActiveActionSet
x f :: Ptr ActiveActionSet -> IO b
f = Int -> Int -> (Ptr ActiveActionSet -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr ActiveActionSet -> IO b) -> IO b)
-> (Ptr ActiveActionSet -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ActiveActionSet
p -> Ptr ActiveActionSet -> ActiveActionSet -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActiveActionSet
p ActiveActionSet
x (Ptr ActiveActionSet -> IO b
f Ptr ActiveActionSet
p)
  pokeCStruct :: Ptr ActiveActionSet -> ActiveActionSet -> IO b -> IO b
pokeCStruct p :: Ptr ActiveActionSet
p ActiveActionSet{..} f :: IO b
f = do
    ("actionSet" ::: Ptr (Ptr ActionSet_T)) -> Ptr ActionSet_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActiveActionSet
p Ptr ActiveActionSet -> Int -> "actionSet" ::: Ptr (Ptr ActionSet_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr (Ptr ActionSet_T))) (Ptr ActionSet_T
actionSet)
    ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("topLevelUserPath" ::: Path) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActiveActionSet
p Ptr ActiveActionSet
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Path)) ("topLevelUserPath" ::: Path
subactionPath)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ActiveActionSet -> IO b -> IO b
pokeZeroCStruct p :: Ptr ActiveActionSet
p f :: IO b
f = do
    ("actionSet" ::: Ptr (Ptr ActionSet_T)) -> Ptr ActionSet_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActiveActionSet
p Ptr ActiveActionSet -> Int -> "actionSet" ::: Ptr (Ptr ActionSet_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr (Ptr ActionSet_T))) (Ptr ActionSet_T
forall a. Zero a => a
zero)
    ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("topLevelUserPath" ::: Path) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActiveActionSet
p Ptr ActiveActionSet
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Path)) ("topLevelUserPath" ::: Path
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct ActiveActionSet where
  peekCStruct :: Ptr ActiveActionSet -> IO ActiveActionSet
peekCStruct p :: Ptr ActiveActionSet
p = do
    Ptr ActionSet_T
actionSet <- ("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO (Ptr ActionSet_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ActionSet_T) ((Ptr ActiveActionSet
p Ptr ActiveActionSet -> Int -> "actionSet" ::: Ptr (Ptr ActionSet_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr (Ptr ActionSet_T)))
    "topLevelUserPath" ::: Path
subactionPath <- ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> IO ("topLevelUserPath" ::: Path)
forall a. Storable a => Ptr a -> IO a
peek @Path ((Ptr ActiveActionSet
p Ptr ActiveActionSet
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr Path))
    ActiveActionSet -> IO ActiveActionSet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActiveActionSet -> IO ActiveActionSet)
-> ActiveActionSet -> IO ActiveActionSet
forall a b. (a -> b) -> a -> b
$ Ptr ActionSet_T -> ("topLevelUserPath" ::: Path) -> ActiveActionSet
ActiveActionSet
             Ptr ActionSet_T
actionSet "topLevelUserPath" ::: Path
subactionPath

instance Storable ActiveActionSet where
  sizeOf :: ActiveActionSet -> Int
sizeOf ~ActiveActionSet
_ = 16
  alignment :: ActiveActionSet -> Int
alignment ~ActiveActionSet
_ = 8
  peek :: Ptr ActiveActionSet -> IO ActiveActionSet
peek = Ptr ActiveActionSet -> IO ActiveActionSet
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr ActiveActionSet -> ActiveActionSet -> IO ()
poke ptr :: Ptr ActiveActionSet
ptr poked :: ActiveActionSet
poked = Ptr ActiveActionSet -> ActiveActionSet -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActiveActionSet
ptr ActiveActionSet
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero ActiveActionSet where
  zero :: ActiveActionSet
zero = Ptr ActionSet_T -> ("topLevelUserPath" ::: Path) -> ActiveActionSet
ActiveActionSet
           Ptr ActionSet_T
forall a. Zero a => a
zero
           "topLevelUserPath" ::: Path
forall a. Zero a => a
zero


-- | XrSessionActionSetsAttachInfo - Information to attach action sets to a
-- session
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrSessionActionSetsAttachInfo-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_SESSION_ACTION_SETS_ATTACH_INFO'
--
-- -   #VUID-XrSessionActionSetsAttachInfo-next-next# @next@ /must/ be
--     @NULL@ or a valid pointer to the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>
--
-- -   #VUID-XrSessionActionSetsAttachInfo-actionSets-parameter#
--     @actionSets@ /must/ be a pointer to an array of @countActionSets@
--     valid 'OpenXR.Core10.Handles.ActionSet' handles
--
-- -   #VUID-XrSessionActionSetsAttachInfo-countActionSets-arraylength# The
--     @countActionSets@ parameter /must/ be greater than @0@
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.ActionSet',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'attachSessionActionSets'
data SessionActionSetsAttachInfo = SessionActionSetsAttachInfo
  { -- | @actionSets@ is a pointer to an array of one or more
    -- 'OpenXR.Core10.Handles.ActionSet' handles to be attached to the session.
    SessionActionSetsAttachInfo -> Vector (Ptr ActionSet_T)
actionSets :: Vector (Ptr ActionSet_T) }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (SessionActionSetsAttachInfo)
#endif
deriving instance Show SessionActionSetsAttachInfo

instance ToCStruct SessionActionSetsAttachInfo where
  withCStruct :: SessionActionSetsAttachInfo
-> (Ptr SessionActionSetsAttachInfo -> IO b) -> IO b
withCStruct x :: SessionActionSetsAttachInfo
x f :: Ptr SessionActionSetsAttachInfo -> IO b
f = Int -> Int -> (Ptr SessionActionSetsAttachInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr SessionActionSetsAttachInfo -> IO b) -> IO b)
-> (Ptr SessionActionSetsAttachInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr SessionActionSetsAttachInfo
p -> Ptr SessionActionSetsAttachInfo
-> SessionActionSetsAttachInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr SessionActionSetsAttachInfo
p SessionActionSetsAttachInfo
x (Ptr SessionActionSetsAttachInfo -> IO b
f Ptr SessionActionSetsAttachInfo
p)
  pokeCStruct :: Ptr SessionActionSetsAttachInfo
-> SessionActionSetsAttachInfo -> IO b -> IO b
pokeCStruct p :: Ptr SessionActionSetsAttachInfo
p SessionActionSetsAttachInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SessionActionSetsAttachInfo
p Ptr SessionActionSetsAttachInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SESSION_ACTION_SETS_ATTACH_INFO)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SessionActionSetsAttachInfo
p Ptr SessionActionSetsAttachInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("sourceCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SessionActionSetsAttachInfo
p Ptr SessionActionSetsAttachInfo
-> Int
-> "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) ((Int -> "sourceCapacityInput" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (Ptr ActionSet_T) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (Ptr ActionSet_T) -> Int)
-> Vector (Ptr ActionSet_T) -> Int
forall a b. (a -> b) -> a -> b
$ (Vector (Ptr ActionSet_T)
actionSets)) :: Word32))
    "actionSet" ::: Ptr (Ptr ActionSet_T)
pActionSets' <- ((("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO b) -> IO b)
-> ContT b IO ("actionSet" ::: Ptr (Ptr ActionSet_T))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO b) -> IO b)
 -> ContT b IO ("actionSet" ::: Ptr (Ptr ActionSet_T)))
-> ((("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO b) -> IO b)
-> ContT b IO ("actionSet" ::: Ptr (Ptr ActionSet_T))
forall a b. (a -> b) -> a -> b
$ Int
-> Int -> (("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(Ptr ActionSet_T) ((Vector (Ptr ActionSet_T) -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector (Ptr ActionSet_T)
actionSets)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Ptr ActionSet_T -> IO ())
-> Vector (Ptr ActionSet_T) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Ptr ActionSet_T
e -> ("actionSet" ::: Ptr (Ptr ActionSet_T)) -> Ptr ActionSet_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("actionSet" ::: Ptr (Ptr ActionSet_T)
pActionSets' ("actionSet" ::: Ptr (Ptr ActionSet_T))
-> Int -> "actionSet" ::: Ptr (Ptr ActionSet_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ActionSet_T)) (Ptr ActionSet_T
e)) (Vector (Ptr ActionSet_T)
actionSets)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("actionSet" ::: Ptr (Ptr ActionSet_T))
-> ("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SessionActionSetsAttachInfo
p Ptr SessionActionSetsAttachInfo
-> Int -> Ptr ("actionSet" ::: Ptr (Ptr ActionSet_T))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr (Ptr ActionSet_T)))) ("actionSet" ::: Ptr (Ptr ActionSet_T)
pActionSets')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr SessionActionSetsAttachInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr SessionActionSetsAttachInfo
p f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SessionActionSetsAttachInfo
p Ptr SessionActionSetsAttachInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_SESSION_ACTION_SETS_ATTACH_INFO)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SessionActionSetsAttachInfo
p Ptr SessionActionSetsAttachInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    "actionSet" ::: Ptr (Ptr ActionSet_T)
pActionSets' <- ((("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO b) -> IO b)
-> ContT b IO ("actionSet" ::: Ptr (Ptr ActionSet_T))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO b) -> IO b)
 -> ContT b IO ("actionSet" ::: Ptr (Ptr ActionSet_T)))
-> ((("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO b) -> IO b)
-> ContT b IO ("actionSet" ::: Ptr (Ptr ActionSet_T))
forall a b. (a -> b) -> a -> b
$ Int
-> Int -> (("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @(Ptr ActionSet_T) ((Vector Any -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector Any
forall a. Monoid a => a
mempty)) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Ptr ActionSet_T -> IO ())
-> Vector (Ptr ActionSet_T) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: Ptr ActionSet_T
e -> ("actionSet" ::: Ptr (Ptr ActionSet_T)) -> Ptr ActionSet_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("actionSet" ::: Ptr (Ptr ActionSet_T)
pActionSets' ("actionSet" ::: Ptr (Ptr ActionSet_T))
-> Int -> "actionSet" ::: Ptr (Ptr ActionSet_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ActionSet_T)) (Ptr ActionSet_T
e)) (Vector (Ptr ActionSet_T)
forall a. Monoid a => a
mempty)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("actionSet" ::: Ptr (Ptr ActionSet_T))
-> ("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr SessionActionSetsAttachInfo
p Ptr SessionActionSetsAttachInfo
-> Int -> Ptr ("actionSet" ::: Ptr (Ptr ActionSet_T))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr (Ptr ActionSet_T)))) ("actionSet" ::: Ptr (Ptr ActionSet_T)
pActionSets')
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f

instance FromCStruct SessionActionSetsAttachInfo where
  peekCStruct :: Ptr SessionActionSetsAttachInfo -> IO SessionActionSetsAttachInfo
peekCStruct p :: Ptr SessionActionSetsAttachInfo
p = do
    "sourceCapacityInput" ::: Word32
countActionSets <- ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> IO ("sourceCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr SessionActionSetsAttachInfo
p Ptr SessionActionSetsAttachInfo
-> Int
-> "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32))
    "actionSet" ::: Ptr (Ptr ActionSet_T)
actionSets <- Ptr ("actionSet" ::: Ptr (Ptr ActionSet_T))
-> IO ("actionSet" ::: Ptr (Ptr ActionSet_T))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr (Ptr ActionSet_T)) ((Ptr SessionActionSetsAttachInfo
p Ptr SessionActionSetsAttachInfo
-> Int -> Ptr ("actionSet" ::: Ptr (Ptr ActionSet_T))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr (Ptr ActionSet_T))))
    Vector (Ptr ActionSet_T)
actionSets' <- Int
-> (Int -> IO (Ptr ActionSet_T)) -> IO (Vector (Ptr ActionSet_T))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM (("sourceCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral "sourceCapacityInput" ::: Word32
countActionSets) (\i :: Int
i -> ("actionSet" ::: Ptr (Ptr ActionSet_T)) -> IO (Ptr ActionSet_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ActionSet_T) (("actionSet" ::: Ptr (Ptr ActionSet_T)
actionSets ("actionSet" ::: Ptr (Ptr ActionSet_T))
-> Int -> "actionSet" ::: Ptr (Ptr ActionSet_T)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr (Ptr ActionSet_T))))
    SessionActionSetsAttachInfo -> IO SessionActionSetsAttachInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SessionActionSetsAttachInfo -> IO SessionActionSetsAttachInfo)
-> SessionActionSetsAttachInfo -> IO SessionActionSetsAttachInfo
forall a b. (a -> b) -> a -> b
$ Vector (Ptr ActionSet_T) -> SessionActionSetsAttachInfo
SessionActionSetsAttachInfo
             Vector (Ptr ActionSet_T)
actionSets'

instance Zero SessionActionSetsAttachInfo where
  zero :: SessionActionSetsAttachInfo
zero = Vector (Ptr ActionSet_T) -> SessionActionSetsAttachInfo
SessionActionSetsAttachInfo
           Vector (Ptr ActionSet_T)
forall a. Monoid a => a
mempty


-- | XrActionsSyncInfo - Information to sync actions
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrActionsSyncInfo-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_ACTIONS_SYNC_INFO'
--
-- -   #VUID-XrActionsSyncInfo-next-next# @next@ /must/ be @NULL@ or a
--     valid pointer to the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>
--
-- -   #VUID-XrActionsSyncInfo-activeActionSets-parameter# If
--     @countActiveActionSets@ is not @0@, @activeActionSets@ /must/ be a
--     pointer to an array of @countActiveActionSets@ valid
--     'ActiveActionSet' structures
--
-- = See Also
--
-- 'ActiveActionSet', 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'syncActions'
data ActionsSyncInfo = ActionsSyncInfo
  { -- | @countActiveActionSets@ is an integer specifying the number of valid
    -- elements in the @activeActionSets@ array.
    ActionsSyncInfo -> "sourceCapacityInput" ::: Word32
countActiveActionSets :: Word32
  , -- | @activeActionSets@ is @NULL@ or a pointer to an array of one or more
    -- 'ActiveActionSet' structures that should be synchronized.
    ActionsSyncInfo -> Vector ActiveActionSet
activeActionSets :: Vector ActiveActionSet
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ActionsSyncInfo)
#endif
deriving instance Show ActionsSyncInfo

instance ToCStruct ActionsSyncInfo where
  withCStruct :: ActionsSyncInfo -> (Ptr ActionsSyncInfo -> IO b) -> IO b
withCStruct x :: ActionsSyncInfo
x f :: Ptr ActionsSyncInfo -> IO b
f = Int -> Int -> (Ptr ActionsSyncInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr ActionsSyncInfo -> IO b) -> IO b)
-> (Ptr ActionsSyncInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ActionsSyncInfo
p -> Ptr ActionsSyncInfo -> ActionsSyncInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionsSyncInfo
p ActionsSyncInfo
x (Ptr ActionsSyncInfo -> IO b
f Ptr ActionsSyncInfo
p)
  pokeCStruct :: Ptr ActionsSyncInfo -> ActionsSyncInfo -> IO b -> IO b
pokeCStruct p :: Ptr ActionsSyncInfo
p ActionsSyncInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionsSyncInfo
p Ptr ActionsSyncInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTIONS_SYNC_INFO)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionsSyncInfo
p Ptr ActionsSyncInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    let activeActionSetsLength :: Int
activeActionSetsLength = Vector ActiveActionSet -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ActiveActionSet -> Int) -> Vector ActiveActionSet -> Int
forall a b. (a -> b) -> a -> b
$ (Vector ActiveActionSet
activeActionSets)
    "sourceCapacityInput" ::: Word32
countActiveActionSets'' <- IO ("sourceCapacityInput" ::: Word32)
-> ContT b IO ("sourceCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("sourceCapacityInput" ::: Word32)
 -> ContT b IO ("sourceCapacityInput" ::: Word32))
-> IO ("sourceCapacityInput" ::: Word32)
-> ContT b IO ("sourceCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ if ("sourceCapacityInput" ::: Word32
countActiveActionSets) ("sourceCapacityInput" ::: Word32)
-> ("sourceCapacityInput" ::: Word32) -> Bool
forall a. Eq a => a -> a -> Bool
== 0
      then ("sourceCapacityInput" ::: Word32)
-> IO ("sourceCapacityInput" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("sourceCapacityInput" ::: Word32)
 -> IO ("sourceCapacityInput" ::: Word32))
-> ("sourceCapacityInput" ::: Word32)
-> IO ("sourceCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ Int -> "sourceCapacityInput" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
activeActionSetsLength
      else do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> "sourceCapacityInput" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
activeActionSetsLength ("sourceCapacityInput" ::: Word32)
-> ("sourceCapacityInput" ::: Word32) -> Bool
forall a. Eq a => a -> a -> Bool
== ("sourceCapacityInput" ::: Word32
countActiveActionSets) Bool -> Bool -> Bool
|| Int
activeActionSetsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "activeActionSets must be empty or have 'countActiveActionSets' elements" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
        ("sourceCapacityInput" ::: Word32)
-> IO ("sourceCapacityInput" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ("sourceCapacityInput" ::: Word32
countActiveActionSets)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("sourceCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionsSyncInfo
p Ptr ActionsSyncInfo
-> Int
-> "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32)) ("sourceCapacityInput" ::: Word32
countActiveActionSets'')
    Ptr ActiveActionSet
activeActionSets'' <- if Vector ActiveActionSet -> Bool
forall a. Vector a -> Bool
Data.Vector.null (Vector ActiveActionSet
activeActionSets)
      then Ptr ActiveActionSet -> ContT b IO (Ptr ActiveActionSet)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr ActiveActionSet
forall a. Ptr a
nullPtr
      else do
        Ptr ActiveActionSet
pActiveActionSets <- ((Ptr ActiveActionSet -> IO b) -> IO b)
-> ContT b IO (Ptr ActiveActionSet)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr ActiveActionSet -> IO b) -> IO b)
 -> ContT b IO (Ptr ActiveActionSet))
-> ((Ptr ActiveActionSet -> IO b) -> IO b)
-> ContT b IO (Ptr ActiveActionSet)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> (Ptr ActiveActionSet -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @ActiveActionSet (((Vector ActiveActionSet -> Int
forall a. Vector a -> Int
Data.Vector.length (Vector ActiveActionSet
activeActionSets))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16) 8
        IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> ActiveActionSet -> IO ())
-> Vector ActiveActionSet -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: ActiveActionSet
e -> Ptr ActiveActionSet -> ActiveActionSet -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActiveActionSet
pActiveActionSets Ptr ActiveActionSet -> Int -> Ptr ActiveActionSet
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ActiveActionSet) (ActiveActionSet
e)) ((Vector ActiveActionSet
activeActionSets))
        Ptr ActiveActionSet -> ContT b IO (Ptr ActiveActionSet)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr ActiveActionSet -> ContT b IO (Ptr ActiveActionSet))
-> Ptr ActiveActionSet -> ContT b IO (Ptr ActiveActionSet)
forall a b. (a -> b) -> a -> b
$ Ptr ActiveActionSet
pActiveActionSets
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ActiveActionSet) -> Ptr ActiveActionSet -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionsSyncInfo
p Ptr ActionsSyncInfo -> Int -> Ptr (Ptr ActiveActionSet)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr ActiveActionSet))) Ptr ActiveActionSet
activeActionSets''
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ActionsSyncInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr ActionsSyncInfo
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionsSyncInfo
p Ptr ActionsSyncInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTIONS_SYNC_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionsSyncInfo
p Ptr ActionsSyncInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO b
f

instance FromCStruct ActionsSyncInfo where
  peekCStruct :: Ptr ActionsSyncInfo -> IO ActionsSyncInfo
peekCStruct p :: Ptr ActionsSyncInfo
p = do
    "sourceCapacityInput" ::: Word32
countActiveActionSets <- ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> IO ("sourceCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ActionsSyncInfo
p Ptr ActionsSyncInfo
-> Int
-> "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Word32))
    Ptr ActiveActionSet
activeActionSets <- Ptr (Ptr ActiveActionSet) -> IO (Ptr ActiveActionSet)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr ActiveActionSet) ((Ptr ActionsSyncInfo
p Ptr ActionsSyncInfo -> Int -> Ptr (Ptr ActiveActionSet)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr (Ptr ActiveActionSet)))
    let activeActionSetsLength :: Int
activeActionSetsLength = if Ptr ActiveActionSet
activeActionSets Ptr ActiveActionSet -> Ptr ActiveActionSet -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ActiveActionSet
forall a. Ptr a
nullPtr then 0 else (("sourceCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral "sourceCapacityInput" ::: Word32
countActiveActionSets)
    Vector ActiveActionSet
activeActionSets' <- Int -> (Int -> IO ActiveActionSet) -> IO (Vector ActiveActionSet)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM Int
activeActionSetsLength (\i :: Int
i -> Ptr ActiveActionSet -> IO ActiveActionSet
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @ActiveActionSet ((Ptr ActiveActionSet
activeActionSets Ptr ActiveActionSet -> Int -> Ptr ActiveActionSet
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr ActiveActionSet)))
    ActionsSyncInfo -> IO ActionsSyncInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionsSyncInfo -> IO ActionsSyncInfo)
-> ActionsSyncInfo -> IO ActionsSyncInfo
forall a b. (a -> b) -> a -> b
$ ("sourceCapacityInput" ::: Word32)
-> Vector ActiveActionSet -> ActionsSyncInfo
ActionsSyncInfo
             "sourceCapacityInput" ::: Word32
countActiveActionSets Vector ActiveActionSet
activeActionSets'

instance Zero ActionsSyncInfo where
  zero :: ActionsSyncInfo
zero = ("sourceCapacityInput" ::: Word32)
-> Vector ActiveActionSet -> ActionsSyncInfo
ActionsSyncInfo
           "sourceCapacityInput" ::: Word32
forall a. Zero a => a
zero
           Vector ActiveActionSet
forall a. Monoid a => a
mempty


-- | XrBoundSourcesForActionEnumerateInfo - Information to query the bound
-- input sources for an action
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Action',
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'enumerateBoundSourcesForAction'
data BoundSourcesForActionEnumerateInfo = BoundSourcesForActionEnumerateInfo
  { -- | @action@ is the handle of the action to query.
    --
    -- #VUID-XrBoundSourcesForActionEnumerateInfo-action-parameter# @action@
    -- /must/ be a valid 'OpenXR.Core10.Handles.Action' handle
    BoundSourcesForActionEnumerateInfo -> Ptr Action_T
action :: Ptr Action_T }
  deriving (Typeable, BoundSourcesForActionEnumerateInfo
-> BoundSourcesForActionEnumerateInfo -> Bool
(BoundSourcesForActionEnumerateInfo
 -> BoundSourcesForActionEnumerateInfo -> Bool)
-> (BoundSourcesForActionEnumerateInfo
    -> BoundSourcesForActionEnumerateInfo -> Bool)
-> Eq BoundSourcesForActionEnumerateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoundSourcesForActionEnumerateInfo
-> BoundSourcesForActionEnumerateInfo -> Bool
$c/= :: BoundSourcesForActionEnumerateInfo
-> BoundSourcesForActionEnumerateInfo -> Bool
== :: BoundSourcesForActionEnumerateInfo
-> BoundSourcesForActionEnumerateInfo -> Bool
$c== :: BoundSourcesForActionEnumerateInfo
-> BoundSourcesForActionEnumerateInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BoundSourcesForActionEnumerateInfo)
#endif
deriving instance Show BoundSourcesForActionEnumerateInfo

instance ToCStruct BoundSourcesForActionEnumerateInfo where
  withCStruct :: BoundSourcesForActionEnumerateInfo
-> (Ptr BoundSourcesForActionEnumerateInfo -> IO b) -> IO b
withCStruct x :: BoundSourcesForActionEnumerateInfo
x f :: Ptr BoundSourcesForActionEnumerateInfo -> IO b
f = Int
-> Int -> (Ptr BoundSourcesForActionEnumerateInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr BoundSourcesForActionEnumerateInfo -> IO b) -> IO b)
-> (Ptr BoundSourcesForActionEnumerateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr BoundSourcesForActionEnumerateInfo
p -> Ptr BoundSourcesForActionEnumerateInfo
-> BoundSourcesForActionEnumerateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr BoundSourcesForActionEnumerateInfo
p BoundSourcesForActionEnumerateInfo
x (Ptr BoundSourcesForActionEnumerateInfo -> IO b
f Ptr BoundSourcesForActionEnumerateInfo
p)
  pokeCStruct :: Ptr BoundSourcesForActionEnumerateInfo
-> BoundSourcesForActionEnumerateInfo -> IO b -> IO b
pokeCStruct p :: Ptr BoundSourcesForActionEnumerateInfo
p BoundSourcesForActionEnumerateInfo{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BoundSourcesForActionEnumerateInfo
p Ptr BoundSourcesForActionEnumerateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_BOUND_SOURCES_FOR_ACTION_ENUMERATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BoundSourcesForActionEnumerateInfo
p Ptr BoundSourcesForActionEnumerateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("action" ::: Ptr (Ptr Action_T)) -> Ptr Action_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BoundSourcesForActionEnumerateInfo
p Ptr BoundSourcesForActionEnumerateInfo
-> Int -> "action" ::: Ptr (Ptr Action_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr Action_T))) (Ptr Action_T
action)
    IO b
f
  cStructSize :: Int
cStructSize = 24
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr BoundSourcesForActionEnumerateInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr BoundSourcesForActionEnumerateInfo
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BoundSourcesForActionEnumerateInfo
p Ptr BoundSourcesForActionEnumerateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_BOUND_SOURCES_FOR_ACTION_ENUMERATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BoundSourcesForActionEnumerateInfo
p Ptr BoundSourcesForActionEnumerateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("action" ::: Ptr (Ptr Action_T)) -> Ptr Action_T -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BoundSourcesForActionEnumerateInfo
p Ptr BoundSourcesForActionEnumerateInfo
-> Int -> "action" ::: Ptr (Ptr Action_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr Action_T))) (Ptr Action_T
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct BoundSourcesForActionEnumerateInfo where
  peekCStruct :: Ptr BoundSourcesForActionEnumerateInfo
-> IO BoundSourcesForActionEnumerateInfo
peekCStruct p :: Ptr BoundSourcesForActionEnumerateInfo
p = do
    Ptr Action_T
action <- ("action" ::: Ptr (Ptr Action_T)) -> IO (Ptr Action_T)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Action_T) ((Ptr BoundSourcesForActionEnumerateInfo
p Ptr BoundSourcesForActionEnumerateInfo
-> Int -> "action" ::: Ptr (Ptr Action_T)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (Ptr Action_T)))
    BoundSourcesForActionEnumerateInfo
-> IO BoundSourcesForActionEnumerateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BoundSourcesForActionEnumerateInfo
 -> IO BoundSourcesForActionEnumerateInfo)
-> BoundSourcesForActionEnumerateInfo
-> IO BoundSourcesForActionEnumerateInfo
forall a b. (a -> b) -> a -> b
$ Ptr Action_T -> BoundSourcesForActionEnumerateInfo
BoundSourcesForActionEnumerateInfo
             Ptr Action_T
action

instance Storable BoundSourcesForActionEnumerateInfo where
  sizeOf :: BoundSourcesForActionEnumerateInfo -> Int
sizeOf ~BoundSourcesForActionEnumerateInfo
_ = 24
  alignment :: BoundSourcesForActionEnumerateInfo -> Int
alignment ~BoundSourcesForActionEnumerateInfo
_ = 8
  peek :: Ptr BoundSourcesForActionEnumerateInfo
-> IO BoundSourcesForActionEnumerateInfo
peek = Ptr BoundSourcesForActionEnumerateInfo
-> IO BoundSourcesForActionEnumerateInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr BoundSourcesForActionEnumerateInfo
-> BoundSourcesForActionEnumerateInfo -> IO ()
poke ptr :: Ptr BoundSourcesForActionEnumerateInfo
ptr poked :: BoundSourcesForActionEnumerateInfo
poked = Ptr BoundSourcesForActionEnumerateInfo
-> BoundSourcesForActionEnumerateInfo -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr BoundSourcesForActionEnumerateInfo
ptr BoundSourcesForActionEnumerateInfo
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero BoundSourcesForActionEnumerateInfo where
  zero :: BoundSourcesForActionEnumerateInfo
zero = Ptr Action_T -> BoundSourcesForActionEnumerateInfo
BoundSourcesForActionEnumerateInfo
           Ptr Action_T
forall a. Zero a => a
zero


-- | XrInputSourceLocalizedNameGetInfo - Information to query the bound input
-- sources for an action
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'OpenXR.Core10.Enums.InputSourceLocalizedNameFlags.InputSourceLocalizedNameFlags',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >,
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'enumerateBoundSourcesForAction', 'getInputSourceLocalizedName'
data InputSourceLocalizedNameGetInfo = InputSourceLocalizedNameGetInfo
  { -- No documentation found for Nested "XrInputSourceLocalizedNameGetInfo" "sourcePath"
    InputSourceLocalizedNameGetInfo -> "topLevelUserPath" ::: Path
sourcePath :: Path
  , -- | @whichComponents@ is any set of flags from
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrInputSourceLocalizedNameFlagBits XrInputSourceLocalizedNameFlagBits>.
    --
    -- #VUID-XrInputSourceLocalizedNameGetInfo-whichComponents-parameter#
    -- @whichComponents@ /must/ be a valid combination of
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrInputSourceLocalizedNameFlagBits XrInputSourceLocalizedNameFlagBits>
    -- values
    --
    -- #VUID-XrInputSourceLocalizedNameGetInfo-whichComponents-requiredbitmask#
    -- @whichComponents@ /must/ not be @0@
    InputSourceLocalizedNameGetInfo -> InputSourceLocalizedNameFlags
whichComponents :: InputSourceLocalizedNameFlags
  }
  deriving (Typeable, InputSourceLocalizedNameGetInfo
-> InputSourceLocalizedNameGetInfo -> Bool
(InputSourceLocalizedNameGetInfo
 -> InputSourceLocalizedNameGetInfo -> Bool)
-> (InputSourceLocalizedNameGetInfo
    -> InputSourceLocalizedNameGetInfo -> Bool)
-> Eq InputSourceLocalizedNameGetInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputSourceLocalizedNameGetInfo
-> InputSourceLocalizedNameGetInfo -> Bool
$c/= :: InputSourceLocalizedNameGetInfo
-> InputSourceLocalizedNameGetInfo -> Bool
== :: InputSourceLocalizedNameGetInfo
-> InputSourceLocalizedNameGetInfo -> Bool
$c== :: InputSourceLocalizedNameGetInfo
-> InputSourceLocalizedNameGetInfo -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (InputSourceLocalizedNameGetInfo)
#endif
deriving instance Show InputSourceLocalizedNameGetInfo

instance ToCStruct InputSourceLocalizedNameGetInfo where
  withCStruct :: InputSourceLocalizedNameGetInfo
-> (Ptr InputSourceLocalizedNameGetInfo -> IO b) -> IO b
withCStruct x :: InputSourceLocalizedNameGetInfo
x f :: Ptr InputSourceLocalizedNameGetInfo -> IO b
f = Int -> Int -> (Ptr InputSourceLocalizedNameGetInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 32 8 ((Ptr InputSourceLocalizedNameGetInfo -> IO b) -> IO b)
-> (Ptr InputSourceLocalizedNameGetInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr InputSourceLocalizedNameGetInfo
p -> Ptr InputSourceLocalizedNameGetInfo
-> InputSourceLocalizedNameGetInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr InputSourceLocalizedNameGetInfo
p InputSourceLocalizedNameGetInfo
x (Ptr InputSourceLocalizedNameGetInfo -> IO b
f Ptr InputSourceLocalizedNameGetInfo
p)
  pokeCStruct :: Ptr InputSourceLocalizedNameGetInfo
-> InputSourceLocalizedNameGetInfo -> IO b -> IO b
pokeCStruct p :: Ptr InputSourceLocalizedNameGetInfo
p InputSourceLocalizedNameGetInfo{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InputSourceLocalizedNameGetInfo
p Ptr InputSourceLocalizedNameGetInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_INPUT_SOURCE_LOCALIZED_NAME_GET_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InputSourceLocalizedNameGetInfo
p Ptr InputSourceLocalizedNameGetInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("topLevelUserPath" ::: Path) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InputSourceLocalizedNameGetInfo
p Ptr InputSourceLocalizedNameGetInfo
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Path)) ("topLevelUserPath" ::: Path
sourcePath)
    Ptr InputSourceLocalizedNameFlags
-> InputSourceLocalizedNameFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InputSourceLocalizedNameGetInfo
p Ptr InputSourceLocalizedNameGetInfo
-> Int -> Ptr InputSourceLocalizedNameFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr InputSourceLocalizedNameFlags)) (InputSourceLocalizedNameFlags
whichComponents)
    IO b
f
  cStructSize :: Int
cStructSize = 32
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr InputSourceLocalizedNameGetInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr InputSourceLocalizedNameGetInfo
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InputSourceLocalizedNameGetInfo
p Ptr InputSourceLocalizedNameGetInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_INPUT_SOURCE_LOCALIZED_NAME_GET_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InputSourceLocalizedNameGetInfo
p Ptr InputSourceLocalizedNameGetInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("topLevelUserPath" ::: Path) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InputSourceLocalizedNameGetInfo
p Ptr InputSourceLocalizedNameGetInfo
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Path)) ("topLevelUserPath" ::: Path
forall a. Zero a => a
zero)
    Ptr InputSourceLocalizedNameFlags
-> InputSourceLocalizedNameFlags -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InputSourceLocalizedNameGetInfo
p Ptr InputSourceLocalizedNameGetInfo
-> Int -> Ptr InputSourceLocalizedNameFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr InputSourceLocalizedNameFlags)) (InputSourceLocalizedNameFlags
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct InputSourceLocalizedNameGetInfo where
  peekCStruct :: Ptr InputSourceLocalizedNameGetInfo
-> IO InputSourceLocalizedNameGetInfo
peekCStruct p :: Ptr InputSourceLocalizedNameGetInfo
p = do
    "topLevelUserPath" ::: Path
sourcePath <- ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> IO ("topLevelUserPath" ::: Path)
forall a. Storable a => Ptr a -> IO a
peek @Path ((Ptr InputSourceLocalizedNameGetInfo
p Ptr InputSourceLocalizedNameGetInfo
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Path))
    InputSourceLocalizedNameFlags
whichComponents <- Ptr InputSourceLocalizedNameFlags
-> IO InputSourceLocalizedNameFlags
forall a. Storable a => Ptr a -> IO a
peek @InputSourceLocalizedNameFlags ((Ptr InputSourceLocalizedNameGetInfo
p Ptr InputSourceLocalizedNameGetInfo
-> Int -> Ptr InputSourceLocalizedNameFlags
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24 :: Ptr InputSourceLocalizedNameFlags))
    InputSourceLocalizedNameGetInfo
-> IO InputSourceLocalizedNameGetInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InputSourceLocalizedNameGetInfo
 -> IO InputSourceLocalizedNameGetInfo)
-> InputSourceLocalizedNameGetInfo
-> IO InputSourceLocalizedNameGetInfo
forall a b. (a -> b) -> a -> b
$ ("topLevelUserPath" ::: Path)
-> InputSourceLocalizedNameFlags -> InputSourceLocalizedNameGetInfo
InputSourceLocalizedNameGetInfo
             "topLevelUserPath" ::: Path
sourcePath InputSourceLocalizedNameFlags
whichComponents

instance Storable InputSourceLocalizedNameGetInfo where
  sizeOf :: InputSourceLocalizedNameGetInfo -> Int
sizeOf ~InputSourceLocalizedNameGetInfo
_ = 32
  alignment :: InputSourceLocalizedNameGetInfo -> Int
alignment ~InputSourceLocalizedNameGetInfo
_ = 8
  peek :: Ptr InputSourceLocalizedNameGetInfo
-> IO InputSourceLocalizedNameGetInfo
peek = Ptr InputSourceLocalizedNameGetInfo
-> IO InputSourceLocalizedNameGetInfo
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr InputSourceLocalizedNameGetInfo
-> InputSourceLocalizedNameGetInfo -> IO ()
poke ptr :: Ptr InputSourceLocalizedNameGetInfo
ptr poked :: InputSourceLocalizedNameGetInfo
poked = Ptr InputSourceLocalizedNameGetInfo
-> InputSourceLocalizedNameGetInfo -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr InputSourceLocalizedNameGetInfo
ptr InputSourceLocalizedNameGetInfo
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero InputSourceLocalizedNameGetInfo where
  zero :: InputSourceLocalizedNameGetInfo
zero = ("topLevelUserPath" ::: Path)
-> InputSourceLocalizedNameFlags -> InputSourceLocalizedNameGetInfo
InputSourceLocalizedNameGetInfo
           "topLevelUserPath" ::: Path
forall a. Zero a => a
zero
           InputSourceLocalizedNameFlags
forall a. Zero a => a
zero


-- | XrInteractionProfileState - Receives active interaction profile for a
-- top level path
--
-- == Member Descriptions
--
-- = Description
--
-- The runtime /must/ only include interaction profiles that the
-- application has provided bindings for via
-- 'suggestInteractionProfileBindings' or
-- 'OpenXR.Core10.APIConstants.NULL_PATH'. If the runtime is rebinding an
-- interaction profile provided by the application to a device that the
-- application did not provide bindings for, it /must/ return the
-- interaction profile path that it is emulating. If the runtime is unable
-- to provide input because it cannot emulate any of the
-- application-provided interaction profiles, it /must/ return
-- 'OpenXR.Core10.APIConstants.NULL_PATH'.
--
-- == Valid Usage (Implicit)
--
-- = See Also
--
-- 'ActionSuggestedBinding',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >,
-- 'OpenXR.Core10.Enums.StructureType.StructureType',
-- 'getCurrentInteractionProfile', 'suggestInteractionProfileBindings'
data InteractionProfileState = InteractionProfileState
  { -- | @interactionProfile@ is the
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >
    -- of the interaction profile path for the @topLevelUserPath@ used to
    -- retrieve this state, or 'OpenXR.Core10.APIConstants.NULL_PATH' if there
    -- is no active interaction profile at that top level user path.
    InteractionProfileState -> "topLevelUserPath" ::: Path
interactionProfile :: Path }
  deriving (Typeable, InteractionProfileState -> InteractionProfileState -> Bool
(InteractionProfileState -> InteractionProfileState -> Bool)
-> (InteractionProfileState -> InteractionProfileState -> Bool)
-> Eq InteractionProfileState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InteractionProfileState -> InteractionProfileState -> Bool
$c/= :: InteractionProfileState -> InteractionProfileState -> Bool
== :: InteractionProfileState -> InteractionProfileState -> Bool
$c== :: InteractionProfileState -> InteractionProfileState -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (InteractionProfileState)
#endif
deriving instance Show InteractionProfileState

instance ToCStruct InteractionProfileState where
  withCStruct :: InteractionProfileState
-> (Ptr InteractionProfileState -> IO b) -> IO b
withCStruct x :: InteractionProfileState
x f :: Ptr InteractionProfileState -> IO b
f = Int -> Int -> (Ptr InteractionProfileState -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 24 8 ((Ptr InteractionProfileState -> IO b) -> IO b)
-> (Ptr InteractionProfileState -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr InteractionProfileState
p -> Ptr InteractionProfileState
-> InteractionProfileState -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr InteractionProfileState
p InteractionProfileState
x (Ptr InteractionProfileState -> IO b
f Ptr InteractionProfileState
p)
  pokeCStruct :: Ptr InteractionProfileState
-> InteractionProfileState -> IO b -> IO b
pokeCStruct p :: Ptr InteractionProfileState
p InteractionProfileState{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileState
p Ptr InteractionProfileState -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_INTERACTION_PROFILE_STATE)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileState
p Ptr InteractionProfileState -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("topLevelUserPath" ::: Path) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileState
p Ptr InteractionProfileState
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Path)) ("topLevelUserPath" ::: Path
interactionProfile)
    IO b
f
  cStructSize :: Int
cStructSize = 24
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr InteractionProfileState -> IO b -> IO b
pokeZeroCStruct p :: Ptr InteractionProfileState
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileState
p Ptr InteractionProfileState -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_INTERACTION_PROFILE_STATE)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileState
p Ptr InteractionProfileState -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("topLevelUserPath" ::: Path) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr InteractionProfileState
p Ptr InteractionProfileState
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Path)) ("topLevelUserPath" ::: Path
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct InteractionProfileState where
  peekCStruct :: Ptr InteractionProfileState -> IO InteractionProfileState
peekCStruct p :: Ptr InteractionProfileState
p = do
    "topLevelUserPath" ::: Path
interactionProfile <- ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> IO ("topLevelUserPath" ::: Path)
forall a. Storable a => Ptr a -> IO a
peek @Path ((Ptr InteractionProfileState
p Ptr InteractionProfileState
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr Path))
    InteractionProfileState -> IO InteractionProfileState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InteractionProfileState -> IO InteractionProfileState)
-> InteractionProfileState -> IO InteractionProfileState
forall a b. (a -> b) -> a -> b
$ ("topLevelUserPath" ::: Path) -> InteractionProfileState
InteractionProfileState
             "topLevelUserPath" ::: Path
interactionProfile

instance Storable InteractionProfileState where
  sizeOf :: InteractionProfileState -> Int
sizeOf ~InteractionProfileState
_ = 24
  alignment :: InteractionProfileState -> Int
alignment ~InteractionProfileState
_ = 8
  peek :: Ptr InteractionProfileState -> IO InteractionProfileState
peek = Ptr InteractionProfileState -> IO InteractionProfileState
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct
  poke :: Ptr InteractionProfileState -> InteractionProfileState -> IO ()
poke ptr :: Ptr InteractionProfileState
ptr poked :: InteractionProfileState
poked = Ptr InteractionProfileState
-> InteractionProfileState -> IO () -> IO ()
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr InteractionProfileState
ptr InteractionProfileState
poked (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Zero InteractionProfileState where
  zero :: InteractionProfileState
zero = ("topLevelUserPath" ::: Path) -> InteractionProfileState
InteractionProfileState
           "topLevelUserPath" ::: Path
forall a. Zero a => a
zero


-- | XrActionCreateInfo - XrAction creation info
--
-- == Member Descriptions
--
-- = Description
--
-- Subaction paths are a mechanism that enables applications to use the
-- same action name and handle on multiple devices. Applications can query
-- action state using subaction paths that differentiate data coming from
-- each device. This allows the runtime to group logically equivalent
-- actions together in system UI. For instance, an application could create
-- a single @pick_up@ action with the \/user\/hand\/left and
-- \/user\/hand\/right subaction paths and use the subaction paths to
-- independently query the state of @pick_up_with_left_hand@ and
-- @pick_up_with_right_hand@.
--
-- Applications /can/ create actions with or without the @subactionPaths@
-- set to a list of paths. If this list of paths is omitted (i.e.
-- @subactionPaths@ is set to @NULL@, and @countSubactionPaths@ is set to
-- @0@), the application is opting out of filtering action results by
-- subaction paths and any call to get action data must also omit subaction
-- paths.
--
-- If @subactionPaths@ is specified and any of the following conditions are
-- not satisfied, the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED':
--
-- -   Each path provided is one of:
--
--     -   \/user\/head
--
--     -   \/user\/hand\/left
--
--     -   \/user\/hand\/right
--
--     -   \/user\/gamepad
--
-- -   No path appears in the list more than once
--
-- Extensions /may/ append additional top level user paths to the above
-- list.
--
-- Note
--
-- Earlier revisions of the spec mentioned \/user but it could not be
-- implemented as specified and was removed as errata.
--
-- The runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_PATH_UNSUPPORTED' in the following
-- circumstances:
--
-- -   The application specified subaction paths at action creation and the
--     application called @xrGetActionState*@ or a haptic function with an
--     empty subaction path array.
--
-- -   The application called @xrGetActionState*@ or a haptic function with
--     a subaction path that was not specified when the action was created.
--
-- If @actionName@ or @localizedActionName@ are empty strings, the runtime
-- /must/ return 'OpenXR.Core10.Enums.Result.ERROR_NAME_INVALID' or
-- 'OpenXR.Core10.Enums.Result.ERROR_LOCALIZED_NAME_INVALID' respectively.
-- If @actionName@ or @localizedActionName@ are duplicates of the
-- corresponding field for any existing action in the specified action set,
-- the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_NAME_DUPLICATED' or
-- 'OpenXR.Core10.Enums.Result.ERROR_LOCALIZED_NAME_DUPLICATED'
-- respectively. If the conflicting action is destroyed, the conflicting
-- field is no longer considered duplicated. If @actionName@ contains
-- characters which are not allowed in a single level of a
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#well-formed-path-strings well-formed path string>,
-- the runtime /must/ return
-- 'OpenXR.Core10.Enums.Result.ERROR_PATH_FORMAT_INVALID'.
--
-- == Valid Usage (Implicit)
--
-- -   #VUID-XrActionCreateInfo-type-type# @type@ /must/ be
--     'OpenXR.Core10.Enums.StructureType.TYPE_ACTION_CREATE_INFO'
--
-- -   #VUID-XrActionCreateInfo-next-next# @next@ /must/ be @NULL@ or a
--     valid pointer to the
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#valid-usage-for-structure-pointer-chains next structure in a structure chain>
--
-- -   #VUID-XrActionCreateInfo-actionName-parameter# @actionName@ /must/
--     be a null-terminated UTF-8 string whose length is less than or equal
--     to 'OpenXR.Core10.APIConstants.MAX_ACTION_NAME_SIZE'
--
-- -   #VUID-XrActionCreateInfo-actionType-parameter# @actionType@ /must/
--     be a valid 'OpenXR.Core10.Enums.ActionType.ActionType' value
--
-- -   #VUID-XrActionCreateInfo-subactionPaths-parameter# If
--     @countSubactionPaths@ is not @0@, @subactionPaths@ /must/ be a
--     pointer to an array of @countSubactionPaths@ valid
--     <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >
--     values
--
-- -   #VUID-XrActionCreateInfo-localizedActionName-parameter#
--     @localizedActionName@ /must/ be a null-terminated UTF-8 string whose
--     length is less than or equal to
--     'OpenXR.Core10.APIConstants.MAX_LOCALIZED_ACTION_NAME_SIZE'
--
-- = See Also
--
-- 'OpenXR.Core10.Handles.Action',
-- 'OpenXR.Core10.Enums.ActionType.ActionType',
-- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >,
-- 'OpenXR.Core10.Enums.StructureType.StructureType', 'createAction',
-- 'createActionSet'
data ActionCreateInfo = ActionCreateInfo
  { -- | @actionName@ is an array containing a @NULL@ terminated string with the
    -- name of this action.
    ActionCreateInfo -> "buffer" ::: ByteString
actionName :: ByteString
  , -- | @actionType@ is the 'OpenXR.Core10.Enums.ActionType.ActionType' of the
    -- action to be created.
    ActionCreateInfo -> ActionType
actionType :: ActionType
  , -- | @countSubactionPaths@ is the number of elements in the @subactionPaths@
    -- array. If @subactionPaths@ is NULL, this parameter must be 0.
    ActionCreateInfo -> "sourceCapacityInput" ::: Word32
countSubactionPaths :: Word32
  , -- | @subactionPaths@ is an array of
    -- <https://www.khronos.org/registry/OpenXR/specs/1.0/html/xrspec.html#XrPath >
    -- or @NULL@. If this array is specified, it contains one or more subaction
    -- paths that the application intends to query action state for.
    ActionCreateInfo
-> "sources" ::: Vector ("topLevelUserPath" ::: Path)
subactionPaths :: Vector Path
  , -- | @localizedActionName@ is an array containing a @NULL@ terminated @UTF@-8
    -- string that can be presented to the user as a description of the action.
    -- This string should be in the system’s current active locale.
    ActionCreateInfo -> "buffer" ::: ByteString
localizedActionName :: ByteString
  }
  deriving (Typeable)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (ActionCreateInfo)
#endif
deriving instance Show ActionCreateInfo

instance ToCStruct ActionCreateInfo where
  withCStruct :: ActionCreateInfo -> (Ptr ActionCreateInfo -> IO b) -> IO b
withCStruct x :: ActionCreateInfo
x f :: Ptr ActionCreateInfo -> IO b
f = Int -> Int -> (Ptr ActionCreateInfo -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 224 8 ((Ptr ActionCreateInfo -> IO b) -> IO b)
-> (Ptr ActionCreateInfo -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr ActionCreateInfo
p -> Ptr ActionCreateInfo -> ActionCreateInfo -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr ActionCreateInfo
p ActionCreateInfo
x (Ptr ActionCreateInfo -> IO b
f Ptr ActionCreateInfo
p)
  pokeCStruct :: Ptr ActionCreateInfo -> ActionCreateInfo -> IO b -> IO b
pokeCStruct p :: Ptr ActionCreateInfo
p ActionCreateInfo{..} f :: IO b
f = ContT b IO b -> IO b
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT b IO b -> IO b) -> ContT b IO b -> IO b
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_CREATE_INFO)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar)
-> ("buffer" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("buffer" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo
-> Int -> Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (FixedArray MAX_ACTION_NAME_SIZE CChar))) ("buffer" ::: ByteString
actionName)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ActionType -> ActionType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo -> Int -> Ptr ActionType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 80 :: Ptr ActionType)) (ActionType
actionType)
    let subactionPathsLength :: Int
subactionPathsLength = ("sources" ::: Vector ("topLevelUserPath" ::: Path)) -> Int
forall a. Vector a -> Int
Data.Vector.length (("sources" ::: Vector ("topLevelUserPath" ::: Path)) -> Int)
-> ("sources" ::: Vector ("topLevelUserPath" ::: Path)) -> Int
forall a b. (a -> b) -> a -> b
$ ("sources" ::: Vector ("topLevelUserPath" ::: Path)
subactionPaths)
    "sourceCapacityInput" ::: Word32
countSubactionPaths'' <- IO ("sourceCapacityInput" ::: Word32)
-> ContT b IO ("sourceCapacityInput" ::: Word32)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ("sourceCapacityInput" ::: Word32)
 -> ContT b IO ("sourceCapacityInput" ::: Word32))
-> IO ("sourceCapacityInput" ::: Word32)
-> ContT b IO ("sourceCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ if ("sourceCapacityInput" ::: Word32
countSubactionPaths) ("sourceCapacityInput" ::: Word32)
-> ("sourceCapacityInput" ::: Word32) -> Bool
forall a. Eq a => a -> a -> Bool
== 0
      then ("sourceCapacityInput" ::: Word32)
-> IO ("sourceCapacityInput" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("sourceCapacityInput" ::: Word32)
 -> IO ("sourceCapacityInput" ::: Word32))
-> ("sourceCapacityInput" ::: Word32)
-> IO ("sourceCapacityInput" ::: Word32)
forall a b. (a -> b) -> a -> b
$ Int -> "sourceCapacityInput" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
subactionPathsLength
      else do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> "sourceCapacityInput" ::: Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
subactionPathsLength ("sourceCapacityInput" ::: Word32)
-> ("sourceCapacityInput" ::: Word32) -> Bool
forall a. Eq a => a -> a -> Bool
== ("sourceCapacityInput" ::: Word32
countSubactionPaths) Bool -> Bool -> Bool
|| Int
subactionPathsLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
InvalidArgument "" "subactionPaths must be empty or have 'countSubactionPaths' elements" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
        ("sourceCapacityInput" ::: Word32)
-> IO ("sourceCapacityInput" ::: Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ("sourceCapacityInput" ::: Word32
countSubactionPaths)
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> ("sourceCapacityInput" ::: Word32) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo
-> Int
-> "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 84 :: Ptr Word32)) ("sourceCapacityInput" ::: Word32
countSubactionPaths'')
    "sources" ::: Ptr ("topLevelUserPath" ::: Path)
subactionPaths'' <- if ("sources" ::: Vector ("topLevelUserPath" ::: Path)) -> Bool
forall a. Vector a -> Bool
Data.Vector.null ("sources" ::: Vector ("topLevelUserPath" ::: Path)
subactionPaths)
      then ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ContT b IO ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
forall (f :: * -> *) a. Applicative f => a -> f a
pure "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a. Ptr a
nullPtr
      else do
        "sources" ::: Ptr ("topLevelUserPath" ::: Path)
pSubactionPaths <- ((("sources" ::: Ptr ("topLevelUserPath" ::: Path)) -> IO b)
 -> IO b)
-> ContT b IO ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((("sources" ::: Ptr ("topLevelUserPath" ::: Path)) -> IO b)
  -> IO b)
 -> ContT b IO ("sources" ::: Ptr ("topLevelUserPath" ::: Path)))
-> ((("sources" ::: Ptr ("topLevelUserPath" ::: Path)) -> IO b)
    -> IO b)
-> ContT b IO ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (("sources" ::: Ptr ("topLevelUserPath" ::: Path)) -> IO b)
-> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned @Path (((("sources" ::: Vector ("topLevelUserPath" ::: Path)) -> Int
forall a. Vector a -> Int
Data.Vector.length ("sources" ::: Vector ("topLevelUserPath" ::: Path)
subactionPaths))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) 8
        IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> ("topLevelUserPath" ::: Path) -> IO ())
-> ("sources" ::: Vector ("topLevelUserPath" ::: Path)) -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
Data.Vector.imapM_ (\i :: Int
i e :: "topLevelUserPath" ::: Path
e -> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("topLevelUserPath" ::: Path) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ("sources" ::: Ptr ("topLevelUserPath" ::: Path)
pSubactionPaths ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Path) ("topLevelUserPath" ::: Path
e)) (("sources" ::: Vector ("topLevelUserPath" ::: Path)
subactionPaths))
        ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ContT b IO ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (("sources" ::: Ptr ("topLevelUserPath" ::: Path))
 -> ContT b IO ("sources" ::: Ptr ("topLevelUserPath" ::: Path)))
-> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ContT b IO ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
forall a b. (a -> b) -> a -> b
$ "sources" ::: Ptr ("topLevelUserPath" ::: Path)
pSubactionPaths
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("sources" ::: Ptr ("topLevelUserPath" ::: Path)) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo
-> Int -> Ptr ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 88 :: Ptr (Ptr Path))) "sources" ::: Ptr ("topLevelUserPath" ::: Path)
subactionPaths''
    IO () -> ContT b IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT b IO ()) -> IO () -> ContT b IO ()
forall a b. (a -> b) -> a -> b
$ Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar)
-> ("buffer" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("buffer" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo
-> Int -> Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 96 :: Ptr (FixedArray MAX_LOCALIZED_ACTION_NAME_SIZE CChar))) ("buffer" ::: ByteString
localizedActionName)
    IO b -> ContT b IO b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO b -> ContT b IO b) -> IO b -> ContT b IO b
forall a b. (a -> b) -> a -> b
$ IO b
f
  cStructSize :: Int
cStructSize = 224
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr ActionCreateInfo -> IO b -> IO b
pokeZeroCStruct p :: Ptr ActionCreateInfo
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
TYPE_ACTION_CREATE_INFO)
    Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr ()))) (Ptr ()
forall a. Ptr a
nullPtr)
    Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar)
-> ("buffer" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("buffer" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo
-> Int -> Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (FixedArray MAX_ACTION_NAME_SIZE CChar))) ("buffer" ::: ByteString
forall a. Monoid a => a
mempty)
    Ptr ActionType -> ActionType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo -> Int -> Ptr ActionType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 80 :: Ptr ActionType)) (ActionType
forall a. Zero a => a
zero)
    Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar)
-> ("buffer" ::: ByteString) -> IO ()
forall (n :: Nat).
KnownNat n =>
Ptr (FixedArray n CChar) -> ("buffer" ::: ByteString) -> IO ()
pokeFixedLengthNullTerminatedByteString ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo
-> Int -> Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 96 :: Ptr (FixedArray MAX_LOCALIZED_ACTION_NAME_SIZE CChar))) ("buffer" ::: ByteString
forall a. Monoid a => a
mempty)
    IO b
f

instance FromCStruct ActionCreateInfo where
  peekCStruct :: Ptr ActionCreateInfo -> IO ActionCreateInfo
peekCStruct p :: Ptr ActionCreateInfo
p = do
    "buffer" ::: ByteString
actionName <- ("buffer" ::: Ptr CChar) -> IO ("buffer" ::: ByteString)
packCString (Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar)
-> "buffer" ::: Ptr CChar
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo
-> Int -> Ptr (FixedArray MAX_ACTION_SET_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16 :: Ptr (FixedArray MAX_ACTION_NAME_SIZE CChar))))
    ActionType
actionType <- Ptr ActionType -> IO ActionType
forall a. Storable a => Ptr a -> IO a
peek @ActionType ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo -> Int -> Ptr ActionType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 80 :: Ptr ActionType))
    "sourceCapacityInput" ::: Word32
countSubactionPaths <- ("sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32))
-> IO ("sourceCapacityInput" ::: Word32)
forall a. Storable a => Ptr a -> IO a
peek @Word32 ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo
-> Int
-> "sourceCountOutput" ::: Ptr ("sourceCapacityInput" ::: Word32)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 84 :: Ptr Word32))
    "sources" ::: Ptr ("topLevelUserPath" ::: Path)
subactionPaths <- Ptr ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> IO ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
forall a. Storable a => Ptr a -> IO a
peek @(Ptr Path) ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo
-> Int -> Ptr ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 88 :: Ptr (Ptr Path)))
    let subactionPathsLength :: Int
subactionPathsLength = if "sources" ::: Ptr ("topLevelUserPath" ::: Path)
subactionPaths ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> ("sources" ::: Ptr ("topLevelUserPath" ::: Path)) -> Bool
forall a. Eq a => a -> a -> Bool
== "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a. Ptr a
nullPtr then 0 else (("sourceCapacityInput" ::: Word32) -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral "sourceCapacityInput" ::: Word32
countSubactionPaths)
    "sources" ::: Vector ("topLevelUserPath" ::: Path)
subactionPaths' <- Int
-> (Int -> IO ("topLevelUserPath" ::: Path))
-> IO ("sources" ::: Vector ("topLevelUserPath" ::: Path))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
generateM Int
subactionPathsLength (\i :: Int
i -> ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> IO ("topLevelUserPath" ::: Path)
forall a. Storable a => Ptr a -> IO a
peek @Path (("sources" ::: Ptr ("topLevelUserPath" ::: Path)
subactionPaths ("sources" ::: Ptr ("topLevelUserPath" ::: Path))
-> Int -> "sources" ::: Ptr ("topLevelUserPath" ::: Path)
forall a. Ptr a -> Int -> Ptr a
`advancePtrBytes` (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i)) :: Ptr Path)))
    "buffer" ::: ByteString
localizedActionName <- ("buffer" ::: Ptr CChar) -> IO ("buffer" ::: ByteString)
packCString (Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar)
-> "buffer" ::: Ptr CChar
forall a (n :: Nat). Ptr (FixedArray n a) -> Ptr a
lowerArrayPtr ((Ptr ActionCreateInfo
p Ptr ActionCreateInfo
-> Int -> Ptr (FixedArray MAX_LOCALIZED_ACTION_SET_NAME_SIZE CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 96 :: Ptr (FixedArray MAX_LOCALIZED_ACTION_NAME_SIZE CChar))))
    ActionCreateInfo -> IO ActionCreateInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionCreateInfo -> IO ActionCreateInfo)
-> ActionCreateInfo -> IO ActionCreateInfo
forall a b. (a -> b) -> a -> b
$ ("buffer" ::: ByteString)
-> ActionType
-> ("sourceCapacityInput" ::: Word32)
-> ("sources" ::: Vector ("topLevelUserPath" ::: Path))
-> ("buffer" ::: ByteString)
-> ActionCreateInfo
ActionCreateInfo
             "buffer" ::: ByteString
actionName ActionType
actionType "sourceCapacityInput" ::: Word32
countSubactionPaths "sources" ::: Vector ("topLevelUserPath" ::: Path)
subactionPaths' "buffer" ::: ByteString
localizedActionName

instance Zero ActionCreateInfo where
  zero :: ActionCreateInfo
zero = ("buffer" ::: ByteString)
-> ActionType
-> ("sourceCapacityInput" ::: Word32)
-> ("sources" ::: Vector ("topLevelUserPath" ::: Path))
-> ("buffer" ::: ByteString)
-> ActionCreateInfo
ActionCreateInfo
           "buffer" ::: ByteString
forall a. Monoid a => a
mempty
           ActionType
forall a. Zero a => a
zero
           "sourceCapacityInput" ::: Word32
forall a. Zero a => a
zero
           "sources" ::: Vector ("topLevelUserPath" ::: Path)
forall a. Monoid a => a
mempty
           "buffer" ::: ByteString
forall a. Monoid a => a
mempty