{-# language CPP #-}
-- No documentation found for Chapter "Extends"
module OpenXR.CStruct.Extends  ( BaseInStructure(..)
                               , BaseOutStructure(..)
                               , Extends
                               , PeekChain(..)
                               , PokeChain(..)
                               , Chain
                               , Extendss
                               , SomeStruct(..)
                               , extendSomeStruct
                               , withSomeStruct
                               , withSomeCStruct
                               , peekSomeCStruct
                               , pokeSomeCStruct
                               , forgetExtensions
                               , Extensible(..)
                               , pattern (::&)
                               , pattern (:&)
                               , SomeChild(..)
                               , withSomeChild
                               , lowerChildPointer
                               , Inherits
                               , Inheritable(..)
                               ) where

import Data.Maybe (fromMaybe)
import Type.Reflection (typeRep)
import Foreign.Marshal.Alloc (allocaBytesAligned)
import GHC.Base (join)
import GHC.IO (throwIO)
import GHC.Ptr (castPtr)
import Foreign.Ptr (nullPtr)
import Foreign.Ptr (plusPtr)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (evalContT)
import OpenXR.CStruct (FromCStruct)
import OpenXR.CStruct (FromCStruct(..))
import OpenXR.CStruct (ToCStruct)
import OpenXR.CStruct (ToCStruct(..))
import OpenXR.Zero (Zero(..))
import Data.Proxy (Proxy(Proxy))
import Data.Typeable (Typeable)
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 (Ptr)
import GHC.TypeLits (ErrorMessage(..))
import GHC.TypeLits (TypeError)
import Data.Kind (Constraint)
import Data.Kind (Type)
import Control.Monad.Trans.Cont (ContT(..))
import {-# SOURCE #-} OpenXR.Core10.Input (ActionCreateInfo)
import {-# SOURCE #-} OpenXR.Core10.Input (ActionSetCreateInfo)
import {-# SOURCE #-} OpenXR.Core10.Space (ActionSpaceCreateInfo)
import {-# SOURCE #-} OpenXR.Core10.Input (ActionStateBoolean)
import {-# SOURCE #-} OpenXR.Core10.Input (ActionStateFloat)
import {-# SOURCE #-} OpenXR.Core10.Input (ActionStateGetInfo)
import {-# SOURCE #-} OpenXR.Core10.Input (ActionStatePose)
import {-# SOURCE #-} OpenXR.Core10.Input (ActionStateVector2f)
import {-# SOURCE #-} OpenXR.Core10.Input (ActionSuggestedBinding)
import {-# SOURCE #-} OpenXR.Core10.Input (ActionsSyncInfo)
import {-# SOURCE #-} OpenXR.Core10.Input (ActiveActionSet)
import {-# SOURCE #-} OpenXR.Core10.Instance (ApiLayerProperties)
import {-# SOURCE #-} OpenXR.Core10.Instance (ApplicationInfo)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_binding_modification (BindingModificationBaseHeaderKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_binding_modification (BindingModificationsKHR)
import {-# SOURCE #-} OpenXR.Core10.Input (BoundSourcesForActionEnumerateInfo)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (Color4f)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (CompositionLayerBaseHeader)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_composition_layer_color_scale_bias (CompositionLayerColorScaleBiasKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_composition_layer_cube (CompositionLayerCubeKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_composition_layer_cylinder (CompositionLayerCylinderKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_composition_layer_depth (CompositionLayerDepthInfoKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_composition_layer_equirect2 (CompositionLayerEquirect2KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_composition_layer_equirect (CompositionLayerEquirectKHR)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (CompositionLayerProjection)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (CompositionLayerProjectionView)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (CompositionLayerQuad)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_controller_model (ControllerModelKeyStateMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_controller_model (ControllerModelNodePropertiesMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_controller_model (ControllerModelNodeStateMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_controller_model (ControllerModelPropertiesMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_controller_model (ControllerModelStateMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_debug_utils (DebugUtilsLabelEXT)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_debug_utils (DebugUtilsMessengerCallbackDataEXT)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_debug_utils (DebugUtilsMessengerCreateInfoEXT)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_debug_utils (DebugUtilsObjectNameInfoEXT)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (EventDataBaseHeader)
import {-# SOURCE #-} OpenXR.Core10.Instance (EventDataBuffer)
import {-# SOURCE #-} OpenXR.Extensions.XR_FB_display_refresh_rate (EventDataDisplayRefreshRateChangedFB)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (EventDataEventsLost)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (EventDataInstanceLossPending)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (EventDataInteractionProfileChanged)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXTX_overlay (EventDataMainSessionVisibilityChangedEXTX)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_performance_settings (EventDataPerfSettingsEXT)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (EventDataReferenceSpaceChangePending)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (EventDataSessionStateChanged)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_visibility_mask (EventDataVisibilityMaskChangedKHR)
import {-# SOURCE #-} OpenXR.Core10.Instance (ExtensionProperties)
import {-# SOURCE #-} OpenXR.Core10.FundamentalTypes (Extent2Df)
import {-# SOURCE #-} OpenXR.Core10.FundamentalTypes (Extent2Di)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_eye_gaze_interaction (EyeGazeSampleTimeEXT)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (Fovf)
import {-# SOURCE #-} OpenXR.Core10.DisplayTiming (FrameBeginInfo)
import {-# SOURCE #-} OpenXR.Core10.DisplayTiming (FrameEndInfo)
import {-# SOURCE #-} OpenXR.Core10.DisplayTiming (FrameState)
import {-# SOURCE #-} OpenXR.Core10.DisplayTiming (FrameWaitInfo)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_D3D11_enable (GraphicsBindingD3D11KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_D3D12_enable (GraphicsBindingD3D12KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_MNDX_egl_enable (GraphicsBindingEGLMNDX)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_es_enable (GraphicsBindingOpenGLESAndroidKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_enable (GraphicsBindingOpenGLWaylandKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_enable (GraphicsBindingOpenGLWin32KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_enable (GraphicsBindingOpenGLXcbKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_enable (GraphicsBindingOpenGLXlibKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_vulkan_enable (GraphicsBindingVulkanKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_D3D11_enable (GraphicsRequirementsD3D11KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_D3D12_enable (GraphicsRequirementsD3D12KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_es_enable (GraphicsRequirementsOpenGLESKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_enable (GraphicsRequirementsOpenGLKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_vulkan_enable (GraphicsRequirementsVulkanKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_hand_tracking (HandJointLocationEXT)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_hand_tracking (HandJointLocationsEXT)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_hand_tracking (HandJointVelocitiesEXT)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_hand_tracking (HandJointVelocityEXT)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_hand_tracking (HandJointsLocateInfoEXT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_hand_tracking_mesh (HandMeshIndexBufferMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_hand_tracking_mesh (HandMeshMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_hand_tracking_mesh (HandMeshSpaceCreateInfoMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_hand_tracking_mesh (HandMeshUpdateInfoMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_hand_tracking_mesh (HandMeshVertexBufferMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_hand_tracking_mesh (HandMeshVertexMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_hand_tracking_mesh (HandPoseTypeInfoMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_hand_tracking (HandTrackerCreateInfoEXT)
import {-# SOURCE #-} OpenXR.Core10.Haptics (HapticActionInfo)
import {-# SOURCE #-} OpenXR.Core10.Haptics (HapticBaseHeader)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (HapticVibration)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_holographic_window_attachment (HolographicWindowAttachmentMSFT)
import {-# SOURCE #-} OpenXR.Core10.Input (InputSourceLocalizedNameGetInfo)
import {-# SOURCE #-} OpenXR.Core10.Instance (InstanceCreateInfo)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_android_create_instance (InstanceCreateInfoAndroidKHR)
import {-# SOURCE #-} OpenXR.Core10.Instance (InstanceProperties)
import {-# SOURCE #-} OpenXR.Extensions.XR_VALVE_analog_threshold (InteractionProfileAnalogThresholdVALVE)
import {-# SOURCE #-} OpenXR.Core10.Input (InteractionProfileState)
import {-# SOURCE #-} OpenXR.Core10.Input (InteractionProfileSuggestedBinding)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_loader_init_android (LoaderInitInfoAndroidKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_loader_init (LoaderInitInfoBaseHeaderKHR)
import {-# SOURCE #-} OpenXR.Core10.FundamentalTypes (Offset2Df)
import {-# SOURCE #-} OpenXR.Core10.FundamentalTypes (Offset2Di)
import {-# SOURCE #-} OpenXR.Core10.Space (Posef)
import {-# SOURCE #-} OpenXR.Core10.Space (Quaternionf)
import {-# SOURCE #-} OpenXR.Core10.FundamentalTypes (Rect2Df)
import {-# SOURCE #-} OpenXR.Core10.FundamentalTypes (Rect2Di)
import {-# SOURCE #-} OpenXR.Core10.Space (ReferenceSpaceCreateInfo)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_secondary_view_configuration (SecondaryViewConfigurationFrameEndInfoMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_secondary_view_configuration (SecondaryViewConfigurationFrameStateMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_secondary_view_configuration (SecondaryViewConfigurationLayerInfoMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_secondary_view_configuration (SecondaryViewConfigurationSessionBeginInfoMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_secondary_view_configuration (SecondaryViewConfigurationStateMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_secondary_view_configuration (SecondaryViewConfigurationSwapchainCreateInfoMSFT)
import {-# SOURCE #-} OpenXR.Core10.Input (SessionActionSetsAttachInfo)
import {-# SOURCE #-} OpenXR.Core10.Session (SessionBeginInfo)
import {-# SOURCE #-} OpenXR.Core10.Device (SessionCreateInfo)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXTX_overlay (SessionCreateInfoOverlayEXTX)
import {-# SOURCE #-} OpenXR.Core10.Space (SpaceLocation)
import {-# SOURCE #-} OpenXR.Core10.Space (SpaceVelocity)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_spatial_anchor (SpatialAnchorCreateInfoMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_spatial_anchor (SpatialAnchorSpaceCreateInfoMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_spatial_graph_bridge (SpatialGraphNodeSpaceCreateInfoMSFT)
import OpenXR.Core10.Enums.StructureType (StructureType)
import OpenXR.Core10.Enums.StructureType (StructureType(..))
import {-# SOURCE #-} OpenXR.Core10.Image (SwapchainCreateInfo)
import {-# SOURCE #-} OpenXR.Core10.Image (SwapchainImageAcquireInfo)
import {-# SOURCE #-} OpenXR.Core10.Image (SwapchainImageBaseHeader)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_D3D11_enable (SwapchainImageD3D11KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_D3D12_enable (SwapchainImageD3D12KHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_es_enable (SwapchainImageOpenGLESKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_opengl_enable (SwapchainImageOpenGLKHR)
import {-# SOURCE #-} OpenXR.Core10.Image (SwapchainImageReleaseInfo)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_vulkan_enable (SwapchainImageVulkanKHR)
import {-# SOURCE #-} OpenXR.Core10.Image (SwapchainImageWaitInfo)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (SwapchainSubImage)
import {-# SOURCE #-} OpenXR.Extensions.XR_FB_color_space (SystemColorSpacePropertiesFB)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_eye_gaze_interaction (SystemEyeGazeInteractionPropertiesEXT)
import {-# SOURCE #-} OpenXR.Core10.Device (SystemGetInfo)
import {-# SOURCE #-} OpenXR.Core10.Device (SystemGraphicsProperties)
import {-# SOURCE #-} OpenXR.Extensions.XR_MSFT_hand_tracking_mesh (SystemHandTrackingMeshPropertiesMSFT)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_hand_tracking (SystemHandTrackingPropertiesEXT)
import {-# SOURCE #-} OpenXR.Core10.Device (SystemProperties)
import {-# SOURCE #-} OpenXR.Core10.Device (SystemTrackingProperties)
import {-# SOURCE #-} OpenXR.Core10.Input (Vector2f)
import {-# SOURCE #-} OpenXR.Core10.Space (Vector3f)
import {-# SOURCE #-} OpenXR.Core10.OtherTypes (Vector4f)
import {-# SOURCE #-} OpenXR.Core10.DisplayTiming (View)
import {-# SOURCE #-} OpenXR.Extensions.XR_EXT_view_configuration_depth_range (ViewConfigurationDepthRangeEXT)
import {-# SOURCE #-} OpenXR.Core10.ViewConfigurations (ViewConfigurationProperties)
import {-# SOURCE #-} OpenXR.Core10.ViewConfigurations (ViewConfigurationView)
import {-# SOURCE #-} OpenXR.Extensions.XR_EPIC_view_configuration_fov (ViewConfigurationViewFovEPIC)
import {-# SOURCE #-} OpenXR.Core10.DisplayTiming (ViewLocateInfo)
import {-# SOURCE #-} OpenXR.Core10.DisplayTiming (ViewState)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_visibility_mask (VisibilityMaskKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_vulkan_enable2 (VulkanDeviceCreateInfoKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_vulkan_enable2 (VulkanGraphicsDeviceGetInfoKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_vulkan_enable2 (VulkanInstanceCreateInfoKHR)
import {-# SOURCE #-} OpenXR.Extensions.XR_KHR_vulkan_swapchain_format_list (VulkanSwapchainFormatListCreateInfoKHR)
-- | XrBaseInStructure - Convenience type for iterating (read only)
--
-- == Member Descriptions
--
-- = Description
--
-- 'BaseInStructure' can be used to facilitate iterating through a
-- read-only structure pointer chain.
--
-- = See Also
--
-- 'BaseInStructure', 'BaseOutStructure',
-- 'OpenXR.Core10.Enums.StructureType.StructureType'
data BaseInStructure = BaseInStructure
  { -- | @type@ is the 'OpenXR.Core10.Enums.StructureType.StructureType' of this
    -- structure. This base structure itself has no associated
    -- 'OpenXR.Core10.Enums.StructureType.StructureType' value.
    BaseInStructure -> StructureType
type' :: StructureType
  , -- | @next@ is @NULL@ or a pointer to the next structure in a structure
    -- chain. No such structures are defined in core OpenXR.
    BaseInStructure -> Ptr BaseInStructure
next :: Ptr BaseInStructure
  }
  deriving (Typeable, BaseInStructure -> BaseInStructure -> Bool
(BaseInStructure -> BaseInStructure -> Bool)
-> (BaseInStructure -> BaseInStructure -> Bool)
-> Eq BaseInStructure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BaseInStructure -> BaseInStructure -> Bool
$c/= :: BaseInStructure -> BaseInStructure -> Bool
== :: BaseInStructure -> BaseInStructure -> Bool
$c== :: BaseInStructure -> BaseInStructure -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BaseInStructure)
#endif
deriving instance Show BaseInStructure

instance ToCStruct BaseInStructure where
  withCStruct :: BaseInStructure -> (Ptr BaseInStructure -> IO b) -> IO b
withCStruct x :: BaseInStructure
x f :: Ptr BaseInStructure -> IO b
f = Int -> Int -> (Ptr BaseInStructure -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr BaseInStructure -> IO b) -> IO b)
-> (Ptr BaseInStructure -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr BaseInStructure
p -> Ptr BaseInStructure -> BaseInStructure -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr BaseInStructure
p BaseInStructure
x (Ptr BaseInStructure -> IO b
f Ptr BaseInStructure
p)
  pokeCStruct :: Ptr BaseInStructure -> BaseInStructure -> IO b -> IO b
pokeCStruct p :: Ptr BaseInStructure
p BaseInStructure{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BaseInStructure
p Ptr BaseInStructure -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
type')
    Ptr (Ptr BaseInStructure) -> Ptr BaseInStructure -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BaseInStructure
p Ptr BaseInStructure -> Int -> Ptr (Ptr BaseInStructure)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr BaseInStructure))) (Ptr BaseInStructure
next)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr BaseInStructure -> IO b -> IO b
pokeZeroCStruct p :: Ptr BaseInStructure
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BaseInStructure
p Ptr BaseInStructure -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
forall a. Zero a => a
zero)
    Ptr (Ptr BaseInStructure) -> Ptr BaseInStructure -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BaseInStructure
p Ptr BaseInStructure -> Int -> Ptr (Ptr BaseInStructure)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr BaseInStructure))) (Ptr BaseInStructure
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct BaseInStructure where
  peekCStruct :: Ptr BaseInStructure -> IO BaseInStructure
peekCStruct p :: Ptr BaseInStructure
p = do
    StructureType
type' <- Ptr StructureType -> IO StructureType
forall a. Storable a => Ptr a -> IO a
peek @StructureType ((Ptr BaseInStructure
p Ptr BaseInStructure -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType))
    Ptr BaseInStructure
next <- Ptr (Ptr BaseInStructure) -> IO (Ptr BaseInStructure)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr BaseInStructure) ((Ptr BaseInStructure
p Ptr BaseInStructure -> Int -> Ptr (Ptr BaseInStructure)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr BaseInStructure)))
    BaseInStructure -> IO BaseInStructure
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BaseInStructure -> IO BaseInStructure)
-> BaseInStructure -> IO BaseInStructure
forall a b. (a -> b) -> a -> b
$ StructureType -> Ptr BaseInStructure -> BaseInStructure
BaseInStructure
             StructureType
type' Ptr BaseInStructure
next

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

instance Zero BaseInStructure where
  zero :: BaseInStructure
zero = StructureType -> Ptr BaseInStructure -> BaseInStructure
BaseInStructure
           StructureType
forall a. Zero a => a
zero
           Ptr BaseInStructure
forall a. Zero a => a
zero


-- | XrBaseOutStructure - Convenience type for iterating (mutable)
--
-- == Member Descriptions
--
-- = Description
--
-- 'BaseOutStructure' can be used to facilitate iterating through a
-- structure pointer chain that returns data back to the application.
--
-- = See Also
--
-- 'BaseInStructure', 'BaseOutStructure',
-- 'OpenXR.Core10.Enums.StructureType.StructureType'
data BaseOutStructure = BaseOutStructure
  { -- | @type@ is the 'OpenXR.Core10.Enums.StructureType.StructureType' of this
    -- structure. This base structure itself has no associated
    -- 'OpenXR.Core10.Enums.StructureType.StructureType' value.
    BaseOutStructure -> StructureType
type' :: StructureType
  , -- | @next@ is @NULL@ or a pointer to the next structure in a structure
    -- chain. No such structures are defined in core OpenXR.
    BaseOutStructure -> Ptr BaseOutStructure
next :: Ptr BaseOutStructure
  }
  deriving (Typeable, BaseOutStructure -> BaseOutStructure -> Bool
(BaseOutStructure -> BaseOutStructure -> Bool)
-> (BaseOutStructure -> BaseOutStructure -> Bool)
-> Eq BaseOutStructure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BaseOutStructure -> BaseOutStructure -> Bool
$c/= :: BaseOutStructure -> BaseOutStructure -> Bool
== :: BaseOutStructure -> BaseOutStructure -> Bool
$c== :: BaseOutStructure -> BaseOutStructure -> Bool
Eq)
#if defined(GENERIC_INSTANCES)
deriving instance Generic (BaseOutStructure)
#endif
deriving instance Show BaseOutStructure

instance ToCStruct BaseOutStructure where
  withCStruct :: BaseOutStructure -> (Ptr BaseOutStructure -> IO b) -> IO b
withCStruct x :: BaseOutStructure
x f :: Ptr BaseOutStructure -> IO b
f = Int -> Int -> (Ptr BaseOutStructure -> IO b) -> IO b
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned 16 8 ((Ptr BaseOutStructure -> IO b) -> IO b)
-> (Ptr BaseOutStructure -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \p :: Ptr BaseOutStructure
p -> Ptr BaseOutStructure -> BaseOutStructure -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct Ptr BaseOutStructure
p BaseOutStructure
x (Ptr BaseOutStructure -> IO b
f Ptr BaseOutStructure
p)
  pokeCStruct :: Ptr BaseOutStructure -> BaseOutStructure -> IO b -> IO b
pokeCStruct p :: Ptr BaseOutStructure
p BaseOutStructure{..} f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BaseOutStructure
p Ptr BaseOutStructure -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
type')
    Ptr (Ptr BaseOutStructure) -> Ptr BaseOutStructure -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BaseOutStructure
p Ptr BaseOutStructure -> Int -> Ptr (Ptr BaseOutStructure)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr BaseOutStructure))) (Ptr BaseOutStructure
next)
    IO b
f
  cStructSize :: Int
cStructSize = 16
  cStructAlignment :: Int
cStructAlignment = 8
  pokeZeroCStruct :: Ptr BaseOutStructure -> IO b -> IO b
pokeZeroCStruct p :: Ptr BaseOutStructure
p f :: IO b
f = do
    Ptr StructureType -> StructureType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BaseOutStructure
p Ptr BaseOutStructure -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType)) (StructureType
forall a. Zero a => a
zero)
    Ptr (Ptr BaseOutStructure) -> Ptr BaseOutStructure -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke ((Ptr BaseOutStructure
p Ptr BaseOutStructure -> Int -> Ptr (Ptr BaseOutStructure)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr BaseOutStructure))) (Ptr BaseOutStructure
forall a. Zero a => a
zero)
    IO b
f

instance FromCStruct BaseOutStructure where
  peekCStruct :: Ptr BaseOutStructure -> IO BaseOutStructure
peekCStruct p :: Ptr BaseOutStructure
p = do
    StructureType
type' <- Ptr StructureType -> IO StructureType
forall a. Storable a => Ptr a -> IO a
peek @StructureType ((Ptr BaseOutStructure
p Ptr BaseOutStructure -> Int -> Ptr StructureType
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0 :: Ptr StructureType))
    Ptr BaseOutStructure
next <- Ptr (Ptr BaseOutStructure) -> IO (Ptr BaseOutStructure)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr BaseOutStructure) ((Ptr BaseOutStructure
p Ptr BaseOutStructure -> Int -> Ptr (Ptr BaseOutStructure)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8 :: Ptr (Ptr BaseOutStructure)))
    BaseOutStructure -> IO BaseOutStructure
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BaseOutStructure -> IO BaseOutStructure)
-> BaseOutStructure -> IO BaseOutStructure
forall a b. (a -> b) -> a -> b
$ StructureType -> Ptr BaseOutStructure -> BaseOutStructure
BaseOutStructure
             StructureType
type' Ptr BaseOutStructure
next

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

instance Zero BaseOutStructure where
  zero :: BaseOutStructure
zero = StructureType -> Ptr BaseOutStructure -> BaseOutStructure
BaseOutStructure
           StructureType
forall a. Zero a => a
zero
           Ptr BaseOutStructure
forall a. Zero a => a
zero


type family Extends (a :: [Type] -> Type) (b :: Type) :: Constraint where
  Extends CompositionLayerBaseHeader CompositionLayerColorScaleBiasKHR = ()
  Extends CompositionLayerProjectionView CompositionLayerDepthInfoKHR = ()
  Extends FrameEndInfo SecondaryViewConfigurationFrameEndInfoMSFT = ()
  Extends FrameState SecondaryViewConfigurationFrameStateMSFT = ()
  Extends HandJointLocationsEXT HandJointVelocitiesEXT = ()
  Extends HandTrackerCreateInfoEXT HandPoseTypeInfoMSFT = ()
  Extends InstanceCreateInfo InstanceCreateInfoAndroidKHR = ()
  Extends InstanceCreateInfo DebugUtilsMessengerCreateInfoEXT = ()
  Extends InteractionProfileSuggestedBinding InteractionProfileAnalogThresholdVALVE = ()
  Extends InteractionProfileSuggestedBinding BindingModificationsKHR = ()
  Extends SessionBeginInfo SecondaryViewConfigurationSessionBeginInfoMSFT = ()
  Extends SessionCreateInfo GraphicsBindingOpenGLWin32KHR = ()
  Extends SessionCreateInfo GraphicsBindingOpenGLXlibKHR = ()
  Extends SessionCreateInfo GraphicsBindingOpenGLXcbKHR = ()
  Extends SessionCreateInfo GraphicsBindingOpenGLWaylandKHR = ()
  Extends SessionCreateInfo GraphicsBindingD3D11KHR = ()
  Extends SessionCreateInfo GraphicsBindingD3D12KHR = ()
  Extends SessionCreateInfo GraphicsBindingOpenGLESAndroidKHR = ()
  Extends SessionCreateInfo GraphicsBindingVulkanKHR = ()
  Extends SessionCreateInfo SessionCreateInfoOverlayEXTX = ()
  Extends SessionCreateInfo GraphicsBindingEGLMNDX = ()
  Extends SessionCreateInfo HolographicWindowAttachmentMSFT = ()
  Extends SpaceLocation SpaceVelocity = ()
  Extends SpaceLocation EyeGazeSampleTimeEXT = ()
  Extends SwapchainCreateInfo SecondaryViewConfigurationSwapchainCreateInfoMSFT = ()
  Extends SystemProperties SystemEyeGazeInteractionPropertiesEXT = ()
  Extends SystemProperties SystemHandTrackingPropertiesEXT = ()
  Extends SystemProperties SystemHandTrackingMeshPropertiesMSFT = ()
  Extends ViewConfigurationView ViewConfigurationDepthRangeEXT = ()
  Extends ViewConfigurationView ViewConfigurationViewFovEPIC = ()
  Extends a b = TypeError (ShowType a :<>: Text " is not extended by " :<>: ShowType b)

data SomeStruct (a :: [Type] -> Type) where
  SomeStruct
    :: forall a es
     . (Extendss a es, PokeChain es, Show (Chain es))
    => a es
    -> SomeStruct a

deriving instance (forall es. Show (Chain es) => Show (a es)) => Show (SomeStruct a)

-- | The constraint is so on this instance to encourage type inference
instance Zero (a '[]) => Zero (SomeStruct a) where
  zero :: SomeStruct a
zero = a '[] -> SomeStruct a
forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct (a '[]
forall a. Zero a => a
zero :: a '[])

-- | Forget which extensions a pointed-to struct has by casting the pointer
forgetExtensions :: Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions :: Ptr (a es) -> Ptr (SomeStruct a)
forgetExtensions = Ptr (a es) -> Ptr (SomeStruct a)
forall a b. Ptr a -> Ptr b
castPtr

-- | Add an extension to the beginning of the struct chain
--
-- This can be used to optionally extend structs based on some condition (for
-- example, an extension or layer being available)
extendSomeStruct
  :: (Extensible a, Extends a e, ToCStruct e, Show e)
  => e
  -> SomeStruct a
  -> SomeStruct a
extendSomeStruct :: e -> SomeStruct a -> SomeStruct a
extendSomeStruct e :: e
e (SomeStruct a :: a es
a) = a (e : es) -> SomeStruct a
forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct (a es -> Chain (e : es) -> a (e : es)
forall (a :: [*] -> *) (ds :: [*]) (es :: [*]).
Extensible a =>
a ds -> Chain es -> a es
setNext a es
a (e
e, a es -> Chain es
forall (a :: [*] -> *) (es :: [*]).
Extensible a =>
a es -> Chain es
getNext a es
a))

-- | Consume a 'SomeStruct' value
withSomeStruct
  :: forall a b
   . SomeStruct a
  -> (forall es . (Extendss a es, PokeChain es, Show (Chain es)) => a es -> b)
  -> b
withSomeStruct :: SomeStruct a
-> (forall (es :: [*]).
    (Extendss a es, PokeChain es, Show (Chain es)) =>
    a es -> b)
-> b
withSomeStruct (SomeStruct s :: a es
s) f :: forall (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> b
f = a es -> b
forall (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> b
f a es
s

-- | Write the C representation of some extended @a@ and use the pointer,
-- the pointer must not be returned from the continuation.
withSomeCStruct
  :: forall a b
   . (forall es . (Extendss a es, PokeChain es) => ToCStruct (a es))
  => SomeStruct a
  -> (forall es . (Extendss a es, PokeChain es) => Ptr (a es) -> IO b)
  -> IO b
withSomeCStruct :: SomeStruct a
-> (forall (es :: [*]).
    (Extendss a es, PokeChain es) =>
    Ptr (a es) -> IO b)
-> IO b
withSomeCStruct s :: SomeStruct a
s f :: forall (es :: [*]).
(Extendss a es, PokeChain es) =>
Ptr (a es) -> IO b
f = SomeStruct a
-> (forall (es :: [*]).
    (Extendss a es, PokeChain es, Show (Chain es)) =>
    a es -> IO b)
-> IO b
forall (a :: [*] -> *) b.
SomeStruct a
-> (forall (es :: [*]).
    (Extendss a es, PokeChain es, Show (Chain es)) =>
    a es -> b)
-> b
withSomeStruct SomeStruct a
s (a es -> (Ptr (a es) -> IO b) -> IO b
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
`withCStruct` Ptr (a es) -> IO b
forall (es :: [*]).
(Extendss a es, PokeChain es) =>
Ptr (a es) -> IO b
f)

-- | Given some memory for the head of the chain, allocate and poke the
-- tail and run an action.
pokeSomeCStruct
  :: (forall es . (Extendss a es, PokeChain es) => ToCStruct (a es))
  => Ptr (SomeStruct a)
  -- ^ Pointer to some memory at least the size of the head of the struct
  -- chain.
  -> SomeStruct a
  -- ^ The struct to poke
  -> IO b
  -- ^ Computation to run while the poked tail is valid
  -> IO b
pokeSomeCStruct :: Ptr (SomeStruct a) -> SomeStruct a -> IO b -> IO b
pokeSomeCStruct p :: Ptr (SomeStruct a)
p (SomeStruct s :: a es
s) = Ptr (a es) -> a es -> IO b -> IO b
forall a b. ToCStruct a => Ptr a -> a -> IO b -> IO b
pokeCStruct (Ptr (SomeStruct a) -> Ptr (a es)
forall a b. Ptr a -> Ptr b
castPtr Ptr (SomeStruct a)
p) a es
s

-- | Given a pointer to a struct with an unknown chain, peek the struct and
-- its chain.
peekSomeCStruct
  :: forall a
   . (Extensible a, forall es . (Extendss a es, PeekChain es) => FromCStruct (a es))
  => Ptr (SomeStruct a)
  -> IO (SomeStruct a)
peekSomeCStruct :: Ptr (SomeStruct a) -> IO (SomeStruct a)
peekSomeCStruct p :: Ptr (SomeStruct a)
p = do
  a '[]
head'  <- Ptr (a '[]) -> IO (a '[])
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct (Ptr (SomeStruct a) -> Ptr (a '[])
forall a b. Ptr a -> Ptr b
castPtr @_ @(a '[]) Ptr (SomeStruct a)
p)
  Ptr BaseOutStructure
pNext <- Ptr (Ptr BaseOutStructure) -> IO (Ptr BaseOutStructure)
forall a. Storable a => Ptr a -> IO a
peek @(Ptr BaseOutStructure) (Ptr (SomeStruct a)
p Ptr (SomeStruct a) -> Int -> Ptr (Ptr BaseOutStructure)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8)
  Ptr BaseOutStructure
-> (forall (es :: [*]).
    (Extendss a es, PokeChain es, Show (Chain es)) =>
    Chain es -> SomeStruct a)
-> IO (SomeStruct a)
forall (a :: [*] -> *) b.
Extensible a =>
Ptr BaseOutStructure
-> (forall (es :: [*]).
    (Extendss a es, PokeChain es, Show (Chain es)) =>
    Chain es -> b)
-> IO b
peekSomeChain @a Ptr BaseOutStructure
pNext ((forall (es :: [*]).
  (Extendss a es, PokeChain es, Show (Chain es)) =>
  Chain es -> SomeStruct a)
 -> IO (SomeStruct a))
-> (forall (es :: [*]).
    (Extendss a es, PokeChain es, Show (Chain es)) =>
    Chain es -> SomeStruct a)
-> IO (SomeStruct a)
forall a b. (a -> b) -> a -> b
$ \tail' :: Chain es
tail' -> a es -> SomeStruct a
forall (a :: [*] -> *) (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
a es -> SomeStruct a
SomeStruct (a '[] -> Chain es -> a es
forall (a :: [*] -> *) (ds :: [*]) (es :: [*]).
Extensible a =>
a ds -> Chain es -> a es
setNext a '[]
head' Chain es
tail')

peekSomeChain
  :: forall a b
   . (Extensible a)
  => Ptr BaseOutStructure
  -> (  forall es
      . (Extendss a es, PokeChain es, Show (Chain es))
     => Chain es
     -> b
     )
  -> IO b
peekSomeChain :: Ptr BaseOutStructure
-> (forall (es :: [*]).
    (Extendss a es, PokeChain es, Show (Chain es)) =>
    Chain es -> b)
-> IO b
peekSomeChain p :: Ptr BaseOutStructure
p c :: forall (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
Chain es -> b
c = if Ptr BaseOutStructure
p Ptr BaseOutStructure -> Ptr BaseOutStructure -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr BaseOutStructure
forall a. Ptr a
nullPtr
  then b -> IO b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chain '[] -> b
forall (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
Chain es -> b
c ())
  else do
    BaseOutStructure
baseOut <- Ptr BaseOutStructure -> IO BaseOutStructure
forall a. Storable a => Ptr a -> IO a
peek Ptr BaseOutStructure
p
    IO (IO b) -> IO b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
      (IO (IO b) -> IO b) -> IO (IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ StructureType
-> Ptr ()
-> (forall e. (Extends a e, ToCStruct e, Show e) => e -> IO b)
-> IO (IO b)
forall (a :: [*] -> *) b.
Extensible a =>
StructureType
-> Ptr ()
-> (forall e. (Extends a e, ToCStruct e, Show e) => e -> b)
-> IO b
peekChainHead @a (BaseOutStructure -> StructureType
type' (BaseOutStructure
baseOut :: BaseOutStructure))
                         (Ptr BaseOutStructure -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr @BaseOutStructure @() Ptr BaseOutStructure
p)
      ((forall e. (Extends a e, ToCStruct e, Show e) => e -> IO b)
 -> IO (IO b))
-> (forall e. (Extends a e, ToCStruct e, Show e) => e -> IO b)
-> IO (IO b)
forall a b. (a -> b) -> a -> b
$ \head' :: e
head' -> Ptr BaseOutStructure
-> (forall (es :: [*]).
    (Extendss a es, PokeChain es, Show (Chain es)) =>
    Chain es -> b)
-> IO b
forall (a :: [*] -> *) b.
Extensible a =>
Ptr BaseOutStructure
-> (forall (es :: [*]).
    (Extendss a es, PokeChain es, Show (Chain es)) =>
    Chain es -> b)
-> IO b
peekSomeChain @a (BaseOutStructure -> Ptr BaseOutStructure
next (BaseOutStructure
baseOut :: BaseOutStructure))
                                  (\tail' :: Chain es
tail' -> Chain (e : es) -> b
forall (es :: [*]).
(Extendss a es, PokeChain es, Show (Chain es)) =>
Chain es -> b
c (e
head', Chain es
tail'))

peekChainHead
  :: forall a b
   . Extensible a
  => StructureType
  -> Ptr ()
  -> (forall e . (Extends a e, ToCStruct e, Show e) => e -> b)
  -> IO b
peekChainHead :: StructureType
-> Ptr ()
-> (forall e. (Extends a e, ToCStruct e, Show e) => e -> b)
-> IO b
peekChainHead ty :: StructureType
ty p :: Ptr ()
p c :: forall e. (Extends a e, ToCStruct e, Show e) => e -> b
c = case StructureType
ty of
  TYPE_GRAPHICS_BINDING_OPENGL_WIN32_KHR -> (Typeable GraphicsBindingOpenGLWin32KHR,
 FromCStruct GraphicsBindingOpenGLWin32KHR,
 ToCStruct GraphicsBindingOpenGLWin32KHR,
 Show GraphicsBindingOpenGLWin32KHR) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @GraphicsBindingOpenGLWin32KHR
  TYPE_GRAPHICS_BINDING_OPENGL_XLIB_KHR -> (Typeable GraphicsBindingOpenGLXlibKHR,
 FromCStruct GraphicsBindingOpenGLXlibKHR,
 ToCStruct GraphicsBindingOpenGLXlibKHR,
 Show GraphicsBindingOpenGLXlibKHR) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @GraphicsBindingOpenGLXlibKHR
  TYPE_GRAPHICS_BINDING_OPENGL_XCB_KHR -> (Typeable GraphicsBindingOpenGLXcbKHR,
 FromCStruct GraphicsBindingOpenGLXcbKHR,
 ToCStruct GraphicsBindingOpenGLXcbKHR,
 Show GraphicsBindingOpenGLXcbKHR) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @GraphicsBindingOpenGLXcbKHR
  TYPE_GRAPHICS_BINDING_OPENGL_WAYLAND_KHR -> (Typeable GraphicsBindingOpenGLWaylandKHR,
 FromCStruct GraphicsBindingOpenGLWaylandKHR,
 ToCStruct GraphicsBindingOpenGLWaylandKHR,
 Show GraphicsBindingOpenGLWaylandKHR) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @GraphicsBindingOpenGLWaylandKHR
  TYPE_GRAPHICS_BINDING_D3D11_KHR -> (Typeable GraphicsBindingD3D11KHR,
 FromCStruct GraphicsBindingD3D11KHR,
 ToCStruct GraphicsBindingD3D11KHR, Show GraphicsBindingD3D11KHR) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @GraphicsBindingD3D11KHR
  TYPE_GRAPHICS_BINDING_D3D12_KHR -> (Typeable GraphicsBindingD3D12KHR,
 FromCStruct GraphicsBindingD3D12KHR,
 ToCStruct GraphicsBindingD3D12KHR, Show GraphicsBindingD3D12KHR) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @GraphicsBindingD3D12KHR
  TYPE_GRAPHICS_BINDING_OPENGL_ES_ANDROID_KHR -> (Typeable GraphicsBindingOpenGLESAndroidKHR,
 FromCStruct GraphicsBindingOpenGLESAndroidKHR,
 ToCStruct GraphicsBindingOpenGLESAndroidKHR,
 Show GraphicsBindingOpenGLESAndroidKHR) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @GraphicsBindingOpenGLESAndroidKHR
  TYPE_GRAPHICS_BINDING_VULKAN_KHR -> (Typeable GraphicsBindingVulkanKHR,
 FromCStruct GraphicsBindingVulkanKHR,
 ToCStruct GraphicsBindingVulkanKHR,
 Show GraphicsBindingVulkanKHR) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @GraphicsBindingVulkanKHR
  TYPE_SPACE_VELOCITY -> (Typeable SpaceVelocity, FromCStruct SpaceVelocity,
 ToCStruct SpaceVelocity, Show SpaceVelocity) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @SpaceVelocity
  TYPE_COMPOSITION_LAYER_DEPTH_INFO_KHR -> (Typeable CompositionLayerDepthInfoKHR,
 FromCStruct CompositionLayerDepthInfoKHR,
 ToCStruct CompositionLayerDepthInfoKHR,
 Show CompositionLayerDepthInfoKHR) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @CompositionLayerDepthInfoKHR
  TYPE_INSTANCE_CREATE_INFO_ANDROID_KHR -> (Typeable InstanceCreateInfoAndroidKHR,
 FromCStruct InstanceCreateInfoAndroidKHR,
 ToCStruct InstanceCreateInfoAndroidKHR,
 Show InstanceCreateInfoAndroidKHR) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @InstanceCreateInfoAndroidKHR
  TYPE_DEBUG_UTILS_MESSENGER_CREATE_INFO_EXT -> (Typeable DebugUtilsMessengerCreateInfoEXT,
 FromCStruct DebugUtilsMessengerCreateInfoEXT,
 ToCStruct DebugUtilsMessengerCreateInfoEXT,
 Show DebugUtilsMessengerCreateInfoEXT) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @DebugUtilsMessengerCreateInfoEXT
  TYPE_SESSION_CREATE_INFO_OVERLAY_EXTX -> (Typeable SessionCreateInfoOverlayEXTX,
 FromCStruct SessionCreateInfoOverlayEXTX,
 ToCStruct SessionCreateInfoOverlayEXTX,
 Show SessionCreateInfoOverlayEXTX) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @SessionCreateInfoOverlayEXTX
  TYPE_VIEW_CONFIGURATION_DEPTH_RANGE_EXT -> (Typeable ViewConfigurationDepthRangeEXT,
 FromCStruct ViewConfigurationDepthRangeEXT,
 ToCStruct ViewConfigurationDepthRangeEXT,
 Show ViewConfigurationDepthRangeEXT) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @ViewConfigurationDepthRangeEXT
  TYPE_VIEW_CONFIGURATION_VIEW_FOV_EPIC -> (Typeable ViewConfigurationViewFovEPIC,
 FromCStruct ViewConfigurationViewFovEPIC,
 ToCStruct ViewConfigurationViewFovEPIC,
 Show ViewConfigurationViewFovEPIC) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @ViewConfigurationViewFovEPIC
  TYPE_INTERACTION_PROFILE_ANALOG_THRESHOLD_VALVE -> (Typeable InteractionProfileAnalogThresholdVALVE,
 FromCStruct InteractionProfileAnalogThresholdVALVE,
 ToCStruct InteractionProfileAnalogThresholdVALVE,
 Show InteractionProfileAnalogThresholdVALVE) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @InteractionProfileAnalogThresholdVALVE
  TYPE_BINDING_MODIFICATIONS_KHR -> (Typeable BindingModificationsKHR,
 FromCStruct BindingModificationsKHR,
 ToCStruct BindingModificationsKHR, Show BindingModificationsKHR) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @BindingModificationsKHR
  TYPE_SYSTEM_EYE_GAZE_INTERACTION_PROPERTIES_EXT -> (Typeable SystemEyeGazeInteractionPropertiesEXT,
 FromCStruct SystemEyeGazeInteractionPropertiesEXT,
 ToCStruct SystemEyeGazeInteractionPropertiesEXT,
 Show SystemEyeGazeInteractionPropertiesEXT) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @SystemEyeGazeInteractionPropertiesEXT
  TYPE_EYE_GAZE_SAMPLE_TIME_EXT -> (Typeable EyeGazeSampleTimeEXT, FromCStruct EyeGazeSampleTimeEXT,
 ToCStruct EyeGazeSampleTimeEXT, Show EyeGazeSampleTimeEXT) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @EyeGazeSampleTimeEXT
  TYPE_GRAPHICS_BINDING_EGL_MNDX -> (Typeable GraphicsBindingEGLMNDX,
 FromCStruct GraphicsBindingEGLMNDX,
 ToCStruct GraphicsBindingEGLMNDX, Show GraphicsBindingEGLMNDX) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @GraphicsBindingEGLMNDX
  TYPE_SYSTEM_HAND_TRACKING_PROPERTIES_EXT -> (Typeable SystemHandTrackingPropertiesEXT,
 FromCStruct SystemHandTrackingPropertiesEXT,
 ToCStruct SystemHandTrackingPropertiesEXT,
 Show SystemHandTrackingPropertiesEXT) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @SystemHandTrackingPropertiesEXT
  TYPE_HAND_JOINT_VELOCITIES_EXT -> (Typeable HandJointVelocitiesEXT,
 FromCStruct HandJointVelocitiesEXT,
 ToCStruct HandJointVelocitiesEXT, Show HandJointVelocitiesEXT) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @HandJointVelocitiesEXT
  TYPE_SYSTEM_HAND_TRACKING_MESH_PROPERTIES_MSFT -> (Typeable SystemHandTrackingMeshPropertiesMSFT,
 FromCStruct SystemHandTrackingMeshPropertiesMSFT,
 ToCStruct SystemHandTrackingMeshPropertiesMSFT,
 Show SystemHandTrackingMeshPropertiesMSFT) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @SystemHandTrackingMeshPropertiesMSFT
  TYPE_HAND_POSE_TYPE_INFO_MSFT -> (Typeable HandPoseTypeInfoMSFT, FromCStruct HandPoseTypeInfoMSFT,
 ToCStruct HandPoseTypeInfoMSFT, Show HandPoseTypeInfoMSFT) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @HandPoseTypeInfoMSFT
  TYPE_SECONDARY_VIEW_CONFIGURATION_SESSION_BEGIN_INFO_MSFT -> (Typeable SecondaryViewConfigurationSessionBeginInfoMSFT,
 FromCStruct SecondaryViewConfigurationSessionBeginInfoMSFT,
 ToCStruct SecondaryViewConfigurationSessionBeginInfoMSFT,
 Show SecondaryViewConfigurationSessionBeginInfoMSFT) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @SecondaryViewConfigurationSessionBeginInfoMSFT
  TYPE_SECONDARY_VIEW_CONFIGURATION_FRAME_STATE_MSFT -> (Typeable SecondaryViewConfigurationFrameStateMSFT,
 FromCStruct SecondaryViewConfigurationFrameStateMSFT,
 ToCStruct SecondaryViewConfigurationFrameStateMSFT,
 Show SecondaryViewConfigurationFrameStateMSFT) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @SecondaryViewConfigurationFrameStateMSFT
  TYPE_SECONDARY_VIEW_CONFIGURATION_FRAME_END_INFO_MSFT -> (Typeable SecondaryViewConfigurationFrameEndInfoMSFT,
 FromCStruct SecondaryViewConfigurationFrameEndInfoMSFT,
 ToCStruct SecondaryViewConfigurationFrameEndInfoMSFT,
 Show SecondaryViewConfigurationFrameEndInfoMSFT) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @SecondaryViewConfigurationFrameEndInfoMSFT
  TYPE_SECONDARY_VIEW_CONFIGURATION_SWAPCHAIN_CREATE_INFO_MSFT -> (Typeable SecondaryViewConfigurationSwapchainCreateInfoMSFT,
 FromCStruct SecondaryViewConfigurationSwapchainCreateInfoMSFT,
 ToCStruct SecondaryViewConfigurationSwapchainCreateInfoMSFT,
 Show SecondaryViewConfigurationSwapchainCreateInfoMSFT) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @SecondaryViewConfigurationSwapchainCreateInfoMSFT
  TYPE_HOLOGRAPHIC_WINDOW_ATTACHMENT_MSFT -> (Typeable HolographicWindowAttachmentMSFT,
 FromCStruct HolographicWindowAttachmentMSFT,
 ToCStruct HolographicWindowAttachmentMSFT,
 Show HolographicWindowAttachmentMSFT) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @HolographicWindowAttachmentMSFT
  TYPE_COMPOSITION_LAYER_COLOR_SCALE_BIAS_KHR -> (Typeable CompositionLayerColorScaleBiasKHR,
 FromCStruct CompositionLayerColorScaleBiasKHR,
 ToCStruct CompositionLayerColorScaleBiasKHR,
 Show CompositionLayerColorScaleBiasKHR) =>
IO b
forall e. (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
go @CompositionLayerColorScaleBiasKHR
  t :: StructureType
t -> IOException -> IO b
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO b) -> IOException -> IO b
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 "peekChainHead" ("Unrecognized struct type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> StructureType -> String
forall a. Show a => a -> String
show StructureType
t) Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
 where
  go :: forall e . (Typeable e, FromCStruct e, ToCStruct e, Show e) => IO b
  go :: IO b
go =
    let r :: Maybe (IO b)
r = Proxy e -> (Extends a e => IO b) -> Maybe (IO b)
forall (a :: [*] -> *) e b (proxy :: * -> *).
(Extensible a, Typeable e) =>
proxy e -> (Extends a e => b) -> Maybe b
extends @a @e Proxy e
forall k (t :: k). Proxy t
Proxy ((Extends a e => IO b) -> Maybe (IO b))
-> (Extends a e => IO b) -> Maybe (IO b)
forall a b. (a -> b) -> a -> b
$ do
          e
head' <- Ptr e -> IO e
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @e (Ptr () -> Ptr e
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
p)
          b -> IO b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> IO b) -> b -> IO b
forall a b. (a -> b) -> a -> b
$ e -> b
forall e. (Extends a e, ToCStruct e, Show e) => e -> b
c e
head'
    in  IO b -> Maybe (IO b) -> IO b
forall a. a -> Maybe a -> a
fromMaybe
          (IOException -> IO b
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO b) -> IOException -> IO b
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
            "peekChainHead"
            (  "Illegal struct extension of "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Extensible a => String
forall (a :: [*] -> *). Extensible a => String
extensibleTypeName @a
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> " with "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> StructureType -> String
forall a. Show a => a -> String
show StructureType
ty
            )
            Maybe CInt
forall a. Maybe a
Nothing
            Maybe String
forall a. Maybe a
Nothing
          )
          Maybe (IO b)
r

class Extensible (a :: [Type] -> Type) where
  extensibleTypeName :: String
  -- ^ For error reporting an invalid extension
  getNext :: a es -> Chain es
  setNext :: a ds -> Chain es -> a es
  extends :: forall e b proxy. Typeable e => proxy e -> (Extends a e => b) -> Maybe b

type family Chain (xs :: [a]) = (r :: a) | r -> xs where
  Chain '[]    = ()
  Chain (x:xs) = (x, Chain xs)

-- | A pattern synonym to separate the head of a struct chain from the
-- tail, use in conjunction with ':&' to extract several members.
--
-- @
-- Head{..} ::& () <- returningNoTail a b c
-- -- Equivalent to
-- Head{..} <- returningNoTail @'[] a b c
-- @
--
-- @
-- Head{..} ::& Foo{..} :& Bar{..} :& () <- returningWithTail a b c
-- @
--
-- @
-- myFun (Head{..} :&& Foo{..} :& ())
-- @
pattern (::&) :: Extensible a => a es' -> Chain es -> a es
pattern a $b::& :: a es' -> Chain es -> a es
$m::& :: forall r (a :: [*] -> *) (es :: [*]).
Extensible a =>
a es
-> (forall (es' :: [*]). a es' -> Chain es -> r)
-> (Void# -> r)
-> r
::& es <- (\a -> (a, getNext a) -> (a, es))
  where a :: a es'
a ::& es :: Chain es
es = a es' -> Chain es -> a es
forall (a :: [*] -> *) (ds :: [*]) (es :: [*]).
Extensible a =>
a ds -> Chain es -> a es
setNext a es'
a Chain es
es
infix 6 ::&
{-# complete (::&) :: GraphicsBindingOpenGLWin32KHR #-}
{-# complete (::&) :: GraphicsBindingOpenGLXlibKHR #-}
{-# complete (::&) :: GraphicsBindingOpenGLXcbKHR #-}
{-# complete (::&) :: GraphicsBindingOpenGLWaylandKHR #-}
{-# complete (::&) :: GraphicsBindingD3D11KHR #-}
{-# complete (::&) :: GraphicsBindingD3D12KHR #-}
{-# complete (::&) :: GraphicsBindingOpenGLESAndroidKHR #-}
{-# complete (::&) :: GraphicsBindingVulkanKHR #-}
{-# complete (::&) :: SpaceVelocity #-}
{-# complete (::&) :: CompositionLayerDepthInfoKHR #-}
{-# complete (::&) :: InstanceCreateInfoAndroidKHR #-}
{-# complete (::&) :: DebugUtilsMessengerCreateInfoEXT #-}
{-# complete (::&) :: SessionCreateInfoOverlayEXTX #-}
{-# complete (::&) :: ViewConfigurationDepthRangeEXT #-}
{-# complete (::&) :: ViewConfigurationViewFovEPIC #-}
{-# complete (::&) :: InteractionProfileAnalogThresholdVALVE #-}
{-# complete (::&) :: BindingModificationsKHR #-}
{-# complete (::&) :: SystemEyeGazeInteractionPropertiesEXT #-}
{-# complete (::&) :: EyeGazeSampleTimeEXT #-}
{-# complete (::&) :: GraphicsBindingEGLMNDX #-}
{-# complete (::&) :: SystemHandTrackingPropertiesEXT #-}
{-# complete (::&) :: HandJointVelocitiesEXT #-}
{-# complete (::&) :: SystemHandTrackingMeshPropertiesMSFT #-}
{-# complete (::&) :: HandPoseTypeInfoMSFT #-}
{-# complete (::&) :: SecondaryViewConfigurationSessionBeginInfoMSFT #-}
{-# complete (::&) :: SecondaryViewConfigurationFrameStateMSFT #-}
{-# complete (::&) :: SecondaryViewConfigurationFrameEndInfoMSFT #-}
{-# complete (::&) :: SecondaryViewConfigurationSwapchainCreateInfoMSFT #-}
{-# complete (::&) :: HolographicWindowAttachmentMSFT #-}
{-# complete (::&) :: CompositionLayerColorScaleBiasKHR #-}

-- | View the head and tail of a 'Chain', see '::&'
--
-- Equivalent to @(,)@
pattern (:&) :: e -> Chain es -> Chain (e:es)
pattern e $b:& :: e -> Chain es -> Chain (e : es)
$m:& :: forall r e (es :: [*]).
Chain (e : es) -> (e -> Chain es -> r) -> (Void# -> r) -> r
:& es = (e, es)
infixr 7 :&
{-# complete (:&) #-}

type family Extendss (p :: [Type] -> Type) (xs :: [Type]) :: Constraint where
  Extendss p '[]      = ()
  Extendss p (x : xs) = (Extends p x, Extendss p xs)

class PokeChain es where
  withChain :: Chain es -> (Ptr (Chain es) -> IO a) -> IO a
  withZeroChain :: (Ptr (Chain es) -> IO a) -> IO a

instance PokeChain '[] where
  withChain :: Chain '[] -> (Ptr (Chain '[]) -> IO a) -> IO a
withChain () f :: Ptr (Chain '[]) -> IO a
f = Ptr (Chain '[]) -> IO a
f Ptr (Chain '[])
forall a. Ptr a
nullPtr
  withZeroChain :: (Ptr (Chain '[]) -> IO a) -> IO a
withZeroChain f :: Ptr (Chain '[]) -> IO a
f = Ptr (Chain '[]) -> IO a
f Ptr (Chain '[])
forall a. Ptr a
nullPtr

instance (ToCStruct e, PokeChain es) => PokeChain (e:es) where
  withChain :: Chain (e : es) -> (Ptr (Chain (e : es)) -> IO a) -> IO a
withChain (e, es) f :: Ptr (Chain (e : es)) -> IO a
f = ContT a IO a -> IO a
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT a IO a -> IO a) -> ContT a IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    Ptr (Chain es)
t <- ((Ptr (Chain es) -> IO a) -> IO a) -> ContT a 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 a) -> IO a) -> ContT a IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO a) -> IO a)
-> ContT a IO (Ptr (Chain es))
forall a b. (a -> b) -> a -> b
$ Chain es -> (Ptr (Chain es) -> IO a) -> IO a
forall (es :: [*]) a.
PokeChain es =>
Chain es -> (Ptr (Chain es) -> IO a) -> IO a
withChain Chain es
es
    Ptr e
h <- ((Ptr e -> IO a) -> IO a) -> ContT a IO (Ptr e)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr e -> IO a) -> IO a) -> ContT a IO (Ptr e))
-> ((Ptr e -> IO a) -> IO a) -> ContT a IO (Ptr e)
forall a b. (a -> b) -> a -> b
$ e -> (Ptr e -> IO a) -> IO a
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct e
e
    IO () -> ContT a IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT a IO ()) -> IO () -> ContT a IO ()
forall a b. (a -> b) -> a -> b
$ Ptr e -> Ptr (Chain es) -> IO ()
forall a b. Ptr a -> Ptr b -> IO ()
linkChain Ptr e
h Ptr (Chain es)
t
    IO a -> ContT a IO a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> ContT a IO a) -> IO a -> ContT a IO a
forall a b. (a -> b) -> a -> b
$ Ptr (Chain (e : es)) -> IO a
f (Ptr e -> Ptr (e, Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr e
h)
  withZeroChain :: (Ptr (Chain (e : es)) -> IO a) -> IO a
withZeroChain f :: Ptr (Chain (e : es)) -> IO a
f = ContT a IO a -> IO a
forall (m :: * -> *) r. Monad m => ContT r m r -> m r
evalContT (ContT a IO a -> IO a) -> ContT a IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    Ptr (Chain es)
t <- ((Ptr (Chain es) -> IO a) -> IO a) -> ContT a 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 a) -> IO a) -> ContT a IO (Ptr (Chain es)))
-> ((Ptr (Chain es) -> IO a) -> IO a)
-> ContT a IO (Ptr (Chain es))
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
    Ptr e
h <- ((Ptr e -> IO a) -> IO a) -> ContT a IO (Ptr e)
forall k (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr e -> IO a) -> IO a) -> ContT a IO (Ptr e))
-> ((Ptr e -> IO a) -> IO a) -> ContT a IO (Ptr e)
forall a b. (a -> b) -> a -> b
$ forall b. ToCStruct e => (Ptr e -> IO b) -> IO b
forall a b. ToCStruct a => (Ptr a -> IO b) -> IO b
withZeroCStruct @e
    IO () -> ContT a IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ContT a IO ()) -> IO () -> ContT a IO ()
forall a b. (a -> b) -> a -> b
$ Ptr e -> Ptr (Chain es) -> IO ()
forall a b. Ptr a -> Ptr b -> IO ()
linkChain Ptr e
h Ptr (Chain es)
t
    IO a -> ContT a IO a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> ContT a IO a) -> IO a -> ContT a IO a
forall a b. (a -> b) -> a -> b
$ Ptr (Chain (e : es)) -> IO a
f (Ptr e -> Ptr (e, Chain es)
forall a b. Ptr a -> Ptr b
castPtr Ptr e
h)

class PeekChain es where
  peekChain :: Ptr (Chain es) -> IO (Chain es)

instance PeekChain '[] where
  peekChain :: Ptr (Chain '[]) -> IO (Chain '[])
peekChain _ = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance (FromCStruct e, PeekChain es) => PeekChain (e:es) where
  peekChain :: Ptr (Chain (e : es)) -> IO (Chain (e : es))
peekChain p :: Ptr (Chain (e : es))
p = do
    e
h <- Ptr e -> IO e
forall a. FromCStruct a => Ptr a -> IO a
peekCStruct @e (Ptr (e, Chain es) -> Ptr e
forall a b. Ptr a -> Ptr b
castPtr Ptr (e, Chain es)
Ptr (Chain (e : es))
p)
    Ptr (Chain es)
tPtr <- Ptr (Ptr (Chain es)) -> IO (Ptr (Chain es))
forall a. Storable a => Ptr a -> IO a
peek (Ptr (e, Chain es)
Ptr (Chain (e : es))
p Ptr (e, Chain es) -> Int -> Ptr (Ptr (Chain es))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8)
    Chain es
t <- Ptr (Chain es) -> IO (Chain es)
forall (es :: [*]). PeekChain es => Ptr (Chain es) -> IO (Chain es)
peekChain Ptr (Chain es)
tPtr
    (e, Chain es) -> IO (e, Chain es)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (e
h, Chain es
t)

linkChain :: Ptr a -> Ptr b -> IO ()
linkChain :: Ptr a -> Ptr b -> IO ()
linkChain head' :: Ptr a
head' tail' :: Ptr b
tail' = Ptr (Ptr b) -> Ptr b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr a
head' Ptr a -> Int -> Ptr (Ptr b)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) Ptr b
tail'

data SomeChild (a :: Type) where
  SomeChild :: forall a b . (Inherits a b, Typeable b, ToCStruct b, Show b) => b -> SomeChild a
deriving instance Show (SomeChild a)

type family Inherits (a :: Type) (b :: Type) :: Constraint where
  Inherits SwapchainImageBaseHeader SwapchainImageD3D12KHR = ()
  Inherits SwapchainImageBaseHeader SwapchainImageD3D11KHR = ()
  Inherits SwapchainImageBaseHeader SwapchainImageVulkanKHR = ()
  Inherits SwapchainImageBaseHeader SwapchainImageOpenGLESKHR = ()
  Inherits SwapchainImageBaseHeader SwapchainImageOpenGLKHR = ()
  Inherits (CompositionLayerBaseHeader '[]) CompositionLayerEquirect2KHR = ()
  Inherits (CompositionLayerBaseHeader '[]) CompositionLayerEquirectKHR = ()
  Inherits (CompositionLayerBaseHeader '[]) CompositionLayerCubeKHR = ()
  Inherits (CompositionLayerBaseHeader '[]) CompositionLayerCylinderKHR = ()
  Inherits (CompositionLayerBaseHeader '[]) CompositionLayerQuad = ()
  Inherits (CompositionLayerBaseHeader '[]) CompositionLayerProjection = ()
  Inherits HapticBaseHeader HapticVibration = ()
  Inherits EventDataBaseHeader EventDataDisplayRefreshRateChangedFB = ()
  Inherits EventDataBaseHeader EventDataMainSessionVisibilityChangedEXTX = ()
  Inherits EventDataBaseHeader EventDataInteractionProfileChanged = ()
  Inherits EventDataBaseHeader EventDataVisibilityMaskChangedKHR = ()
  Inherits EventDataBaseHeader EventDataPerfSettingsEXT = ()
  Inherits EventDataBaseHeader EventDataReferenceSpaceChangePending = ()
  Inherits EventDataBaseHeader EventDataSessionStateChanged = ()
  Inherits EventDataBaseHeader EventDataInstanceLossPending = ()
  Inherits EventDataBaseHeader EventDataEventsLost = ()
  Inherits LoaderInitInfoBaseHeaderKHR LoaderInitInfoAndroidKHR = ()
  Inherits parent child =
    TypeError (ShowType parent :<>: Text " is not inherited by " :<>: ShowType child)

class Inheritable (a :: Type) where
  peekSomeCChild :: Ptr (SomeChild a) -> IO (SomeChild a)

withSomeChild :: SomeChild a -> (Ptr (SomeChild a) -> IO b) -> IO b
withSomeChild :: SomeChild a -> (Ptr (SomeChild a) -> IO b) -> IO b
withSomeChild (SomeChild c :: b
c) f :: Ptr (SomeChild a) -> IO b
f = b -> (Ptr b -> IO b) -> IO b
forall a b. ToCStruct a => a -> (Ptr a -> IO b) -> IO b
withCStruct b
c (Ptr (SomeChild a) -> IO b
f (Ptr (SomeChild a) -> IO b)
-> (Ptr b -> Ptr (SomeChild a)) -> Ptr b -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr b -> Ptr (SomeChild a)
forall a b. Inherits a b => Ptr b -> Ptr (SomeChild a)
lowerChildPointer)

lowerChildPointer :: Inherits a b => Ptr b -> Ptr (SomeChild a)
lowerChildPointer :: Ptr b -> Ptr (SomeChild a)
lowerChildPointer = Ptr b -> Ptr (SomeChild a)
forall a b. Ptr a -> Ptr b
castPtr