-- GENERATED by C->Haskell Compiler, version 0.28.3 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.SpirV.Reflect.FFI.Internal where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import Data.Coerce (Coercible, coerce)
import Data.List (sortOn)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Data.Word (Word32)
import Foreign.C.String (CString)
import Foreign.C.Types (CULong)
import Foreign.Marshal.Utils (maybePeek)
import Foreign.Ptr (Ptr, castPtr, plusPtr, nullPtr)
import Foreign.Storable (peek)
import GHC.Ptr qualified as GHC

import Data.SpirV.Reflect.BlockVariable (BlockVariable)
import Data.SpirV.Reflect.BlockVariable qualified as BlockVariable
import Data.SpirV.Reflect.DescriptorBinding (DescriptorBinding)
import Data.SpirV.Reflect.DescriptorBinding qualified as DescriptorBinding
import Data.SpirV.Reflect.DescriptorSet (DescriptorSet)
import Data.SpirV.Reflect.DescriptorSet qualified as DescriptorSet
import Data.SpirV.Reflect.Enums qualified as Enums
import Data.SpirV.Reflect.InterfaceVariable (InterfaceVariable)
import Data.SpirV.Reflect.InterfaceVariable qualified as InterfaceVariable
import Data.SpirV.Reflect.Module (Module)
import Data.SpirV.Reflect.Module qualified as Module
import Data.SpirV.Reflect.Traits qualified as Traits
import Data.SpirV.Reflect.TypeDescription (TypeDescription)
import Data.SpirV.Reflect.TypeDescription qualified as TypeDescription



-- * Loader interface

type ShaderModulePtr = C2HSImp.Ptr (())
{-# LINE 40 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


data Result = SpvReflectResultSuccess
            | SpvReflectResultNotReady
            | SpvReflectResultErrorParseFailed
            | SpvReflectResultErrorAllocFailed
            | SpvReflectResultErrorRangeExceeded
            | SpvReflectResultErrorNullPointer
            | SpvReflectResultErrorInternalError
            | SpvReflectResultErrorCountMismatch
            | SpvReflectResultErrorElementNotFound
            | SpvReflectResultErrorSpirvInvalidCodeSize
            | SpvReflectResultErrorSpirvInvalidMagicNumber
            | SpvReflectResultErrorSpirvUnexpectedEof
            | SpvReflectResultErrorSpirvInvalidIdReference
            | SpvReflectResultErrorSpirvSetNumberOverflow
            | SpvReflectResultErrorSpirvInvalidStorageClass
            | SpvReflectResultErrorSpirvRecursion
            | SpvReflectResultErrorSpirvInvalidInstruction
            | SpvReflectResultErrorSpirvUnexpectedBlockData
            | SpvReflectResultErrorSpirvInvalidBlockMemberReference
            | SpvReflectResultErrorSpirvInvalidEntryPoint
            | SpvReflectResultErrorSpirvInvalidExecutionMode
  deriving (Enum,Eq,Ord,Show)

{-# LINE 46 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


createShaderModule :: (CULong) -> (Ptr ()) -> (ShaderModulePtr) -> IO ((Result))
createShaderModule a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  createShaderModule'_ a1' a2' a3' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 54 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


data ModuleFlags = SpvReflectModuleFlagNone
                 | SpvReflectModuleFlagNoCopy
  deriving (Eq,Ord,Show)
instance Enum ModuleFlags where
  succ SpvReflectModuleFlagNone = SpvReflectModuleFlagNoCopy
  succ SpvReflectModuleFlagNoCopy = error "ModuleFlags.succ: SpvReflectModuleFlagNoCopy has no successor"

  pred SpvReflectModuleFlagNoCopy = SpvReflectModuleFlagNone
  pred SpvReflectModuleFlagNone = error "ModuleFlags.pred: SpvReflectModuleFlagNone has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from SpvReflectModuleFlagNoCopy

  fromEnum :: ModuleFlags -> Int
fromEnum ModuleFlags
SpvReflectModuleFlagNone = Int
0
  fromEnum ModuleFlags
SpvReflectModuleFlagNoCopy = Int
1

  toEnum :: Int -> ModuleFlags
toEnum Int
0 = ModuleFlags
SpvReflectModuleFlagNone
  toEnum Int
1 = ModuleFlags
SpvReflectModuleFlagNoCopy
  toEnum Int
unmatched = forall a. HasCallStack => String -> a
error (String
"ModuleFlags.toEnum: Cannot match " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 60 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


createShaderModule2 :: (ModuleFlags) -> (CULong) -> (Ptr ()) -> (ShaderModulePtr) -> IO ((Result))
createShaderModule2 a1 a2 a3 a4 =
  let {a1' = (fromIntegral . fromEnum) a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  let {a4' = id a4} in 
  createShaderModule2'_ a1' a2' a3' a4' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 69 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


destroyShaderModule :: (ShaderModulePtr) -> IO ()
destroyShaderModule a1 =
  let {a1' = id a1} in 
  destroyShaderModule'_ a1' >>
  return ()

{-# LINE 75 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


-- TODO: inflateEntryPoints :: ShaderModulePtr -> IO [EntryPoint]

-- * Module

shaderModuleSize :: Int
shaderModuleSize = 1200
{-# LINE 82 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


inflateModule :: ShaderModulePtr -> IO Module
inflateModule :: TypeDescriptionPtr -> IO Module
inflateModule TypeDescriptionPtr
smp = do
  let sm :: Ptr b
sm = forall a b. Ptr a -> Ptr b
castPtr TypeDescriptionPtr
smp

  Generator
generator <- forall a b. (Integral a, Enum b) => IO a -> IO b
inflateEnum forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
0 :: IO C2HSImp.CInt}) forall {b}. Ptr b
sm

  Text
entry_point_name <- IO (Ptr CChar) -> IO Text
inflateText forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
8 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) forall {b}. Ptr b
sm

  Int
entry_point_id <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
16 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
sm

  -- TODO: enums
  Int
source_language <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
32 :: IO C2HSImp.CInt}) forall {b}. Ptr b
sm

  Int
source_language_version <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
36 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
sm

  -- XXX: Uses value(s) from first entry point

  -- TODO: flags
  Int
spirv_execution_model <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
72 :: IO C2HSImp.CInt}) forall {b}. Ptr b
sm

  -- TODO: flags
  Int
shader_stage <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
76 :: IO C2HSImp.CInt}) forall {b}. Ptr b
sm

  Vector DescriptorBinding
descriptor_bindings <-
    forall i p a.
Integral i =>
IO i -> IO (Ptr p) -> Int -> (Ptr p -> IO a) -> IO (Vector a)
inflateVector
      ((\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
80 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
sm)
      ((\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
88 :: IO (C2HSImp.Ptr ())}) forall {b}. Ptr b
sm)
      Int
592
{-# LINE 118 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}

      inflateDescriptorBinding

  Vector DescriptorSet
descriptor_sets <-
    forall i p a.
Integral i =>
IO i -> IO (Ptr p) -> Int -> (Ptr p -> IO a) -> IO (Vector a)
inflateVector
      ((\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
96 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
sm)
      ((\Ptr Any
ptr -> do {forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr Any
ptr forall a b. Ptr a -> Int -> Ptr b
`C2HSImp.plusPtr` Int
104 :: IO (C2HSImp.Ptr ())}) forall {b}. Ptr b
sm)
      Int
16
{-# LINE 125 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}

      inflateDescriptorSet

  Vector InterfaceVariable
interface_variables <-
    forall i p a.
Integral i =>
IO i -> IO (Ptr p) -> Int -> (Ptr p -> IO a) -> IO (Vector a)
inflateVector
      ((\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
1160 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
sm)
      ((\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
1168 :: IO (C2HSImp.Ptr ())}) forall {b}. Ptr b
sm)
      Int
368
{-# LINE 132 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}

      inflateInterfaceVariable

  let
    ivLocation :: InterfaceVariable -> Word32
ivLocation InterfaceVariable.InterfaceVariable{Word32
$sel:location:InterfaceVariable :: InterfaceVariable -> Word32
location :: Word32
location} =
      Word32
location

    pickIvs :: (InterfaceVariable -> Bool) -> Vector InterfaceVariable
pickIvs InterfaceVariable -> Bool
query =
      forall a. [a] -> Vector a
Vector.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn InterfaceVariable -> Word32
ivLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter InterfaceVariable -> Bool
query forall a b. (a -> b) -> a -> b
$
        forall a. Vector a -> [a]
Vector.toList Vector InterfaceVariable
interface_variables

    input_variables :: Vector InterfaceVariable
input_variables =
      (InterfaceVariable -> Bool) -> Vector InterfaceVariable
pickIvs forall a b. (a -> b) -> a -> b
$
        (forall a. Eq a => a -> a -> Bool
== StorageClass
Enums.StorageClassInput) forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterfaceVariable -> StorageClass
InterfaceVariable.storage_class

    output_variables :: Vector InterfaceVariable
output_variables =
      (InterfaceVariable -> Bool) -> Vector InterfaceVariable
pickIvs forall a b. (a -> b) -> a -> b
$
        (forall a. Eq a => a -> a -> Bool
== StorageClass
Enums.StorageClassOutput) forall b c a. (b -> c) -> (a -> b) -> a -> c
. InterfaceVariable -> StorageClass
InterfaceVariable.storage_class

  Vector BlockVariable
push_constants <-
    forall i p a.
Integral i =>
IO i -> IO (Ptr p) -> Int -> (Ptr p -> IO a) -> IO (Vector a)
inflateVector
      ((\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
1176 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
sm)
      ((\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
1184 :: IO (C2HSImp.Ptr ())}) forall {b}. Ptr b
sm)
      Int
352
{-# LINE 155 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}

      inflateBlockVariable

  pure Module.Module{Int
Generator
Text
Vector DescriptorSet
Vector DescriptorBinding
Vector BlockVariable
Vector InterfaceVariable
$sel:generator:Module :: Generator
$sel:entry_point_name:Module :: Text
$sel:entry_point_id:Module :: Int
$sel:source_language:Module :: Int
$sel:source_language_version:Module :: Int
$sel:spirv_execution_model:Module :: Int
$sel:shader_stage:Module :: Int
$sel:descriptor_bindings:Module :: Vector DescriptorBinding
$sel:descriptor_sets:Module :: Vector DescriptorSet
$sel:input_variables:Module :: Vector InterfaceVariable
$sel:output_variables:Module :: Vector InterfaceVariable
$sel:push_constants:Module :: Vector BlockVariable
push_constants :: Vector BlockVariable
output_variables :: Vector InterfaceVariable
input_variables :: Vector InterfaceVariable
descriptor_sets :: Vector DescriptorSet
descriptor_bindings :: Vector DescriptorBinding
shader_stage :: Int
spirv_execution_model :: Int
source_language_version :: Int
source_language :: Int
entry_point_id :: Int
entry_point_name :: Text
generator :: Generator
..}

inflateVector :: Integral i => IO i -> IO (Ptr p) -> Int -> (Ptr p -> IO a) -> IO (Vector a)
inflateVector :: forall i p a.
Integral i =>
IO i -> IO (Ptr p) -> Int -> (Ptr p -> IO a) -> IO (Vector a)
inflateVector IO i
getCount IO (Ptr p)
getItems Int
itemSize Ptr p -> IO a
inflate = do
  i
count <- IO i
getCount
  Ptr p
itemsPtr <- IO (Ptr p)
getItems
  forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
Vector.generateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral i
count) \Int
pos -> do
    Ptr p -> IO a
inflate forall a b. (a -> b) -> a -> b
$ Ptr p
itemsPtr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
itemSize forall a. Num a => a -> a -> a
* Int
pos)

type DescriptorBindingPtr = C2HSImp.Ptr (())
{-# LINE 167 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


inflateDescriptorBinding :: DescriptorBindingPtr -> IO DescriptorBinding
inflateDescriptorBinding :: TypeDescriptionPtr -> IO DescriptorBinding
inflateDescriptorBinding TypeDescriptionPtr
db = do
  Maybe Word32
spirv_id <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
0 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
db

  Text
name <- IO (Ptr CChar) -> IO Text
inflateText forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
8 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) TypeDescriptionPtr
db

  Word32
binding <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
16 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
db

  Word32
input_attachment_index <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
20 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
db

  Word32
set <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
24 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
db

  DescriptorType
descriptor_type <- forall a b. (Integral a, Enum b) => IO a -> IO b
inflateEnum forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
28 :: IO C2HSImp.CInt}) TypeDescriptionPtr
db

  ResourceFlags
resource_type <- forall a b. (Integral a, Coercible Word32 b) => IO a -> IO b
inflateFlags32 forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
32 :: IO C2HSImp.CInt}) TypeDescriptionPtr
db

  Image
image <-
    forall struct. Ptr struct -> Int -> IO Image
inflateImageTraits
      TypeDescriptionPtr
db
      (Int
36)
{-# LINE 195 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


  Maybe BlockVariable
block <-
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
64 :: IO (C2HSImp.Ptr ())}) TypeDescriptionPtr
db forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek TypeDescriptionPtr -> IO BlockVariable
inflateBlockVariable

  Array
array <-
    forall struct. Ptr struct -> Int -> IO Array
inflateArrayTraits
      TypeDescriptionPtr
db
      (Int
416)
{-# LINE 204 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


  Maybe Word32
count <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
548 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
db

  Word32
accessed <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
552 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
db

  Word32
uav_counter_id <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
556 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
db

  Maybe DescriptorBinding
uav_counter_binding <-
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
560 :: IO (DescriptorBindingPtr)}) TypeDescriptionPtr
db forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek TypeDescriptionPtr -> IO DescriptorBinding
inflateDescriptorBinding

  Maybe TypeDescription
type_description <-
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
568 :: IO (C2HSImp.Ptr ())}) TypeDescriptionPtr
db forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek TypeDescriptionPtr -> IO TypeDescription
inflateTypeDescription

  let word_offset :: WordOffset
word_offset = DescriptorBinding.WordOffset{Word32
$sel:binding:WordOffset :: Word32
$sel:set:WordOffset :: Word32
set :: Word32
binding :: Word32
..}

  DecorationFlagBits
decoration_flags <- forall a b. (Integral a, Coercible Word32 b) => IO a -> IO b
inflateFlags32 forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
584 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
db

  pure DescriptorBinding.DescriptorBinding{Maybe Word32
Maybe DescriptorBinding
Maybe BlockVariable
Maybe TypeDescription
Word32
WordOffset
Array
Image
ResourceFlags
DescriptorType
DecorationFlagBits
Text
$sel:spirv_id:DescriptorBinding :: Maybe Word32
$sel:name:DescriptorBinding :: Text
$sel:binding:DescriptorBinding :: Word32
$sel:input_attachment_index:DescriptorBinding :: Word32
$sel:set:DescriptorBinding :: Word32
$sel:descriptor_type:DescriptorBinding :: DescriptorType
$sel:resource_type:DescriptorBinding :: ResourceFlags
$sel:image:DescriptorBinding :: Image
$sel:block:DescriptorBinding :: Maybe BlockVariable
$sel:array:DescriptorBinding :: Array
$sel:count:DescriptorBinding :: Maybe Word32
$sel:accessed:DescriptorBinding :: Word32
$sel:uav_counter_id:DescriptorBinding :: Word32
$sel:uav_counter_binding:DescriptorBinding :: Maybe DescriptorBinding
$sel:type_description:DescriptorBinding :: Maybe TypeDescription
$sel:word_offset:DescriptorBinding :: WordOffset
$sel:decoration_flags:DescriptorBinding :: DecorationFlagBits
decoration_flags :: DecorationFlagBits
word_offset :: WordOffset
type_description :: Maybe TypeDescription
uav_counter_binding :: Maybe DescriptorBinding
uav_counter_id :: Word32
accessed :: Word32
count :: Maybe Word32
array :: Array
block :: Maybe BlockVariable
image :: Image
resource_type :: ResourceFlags
descriptor_type :: DescriptorType
set :: Word32
input_attachment_index :: Word32
binding :: Word32
name :: Text
spirv_id :: Maybe Word32
..}

type BlockVariablePtr = C2HSImp.Ptr (())
{-# LINE 230 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


inflateBlockVariable :: BlockVariablePtr -> IO BlockVariable
inflateBlockVariable :: TypeDescriptionPtr -> IO BlockVariable
inflateBlockVariable TypeDescriptionPtr
bv = do
  Maybe Word32
spirv_id <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
0 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
bv

  Maybe Text
name <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Ptr CChar) -> IO Text
inflateText forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
8 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) TypeDescriptionPtr
bv

  Word32
offset <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
16 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
bv

  Word32
absolute_offset <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
20 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
bv

  Word32
size <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
24 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
bv

  Word32
padded_size <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
28 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
bv

  DecorationFlagBits
decorations <- forall a b. (Integral a, Coercible Word32 b) => IO a -> IO b
inflateFlags32 forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
32 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
bv

  Numeric
numeric <-
    forall struct. Ptr struct -> Int -> IO Numeric
inflateNumericTraits
      TypeDescriptionPtr
bv
      (Int
36)
{-# LINE 258 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


  Array
array <-
    forall struct. Ptr struct -> Int -> IO Array
inflateArrayTraits
      TypeDescriptionPtr
bv
      (Int
60)
{-# LINE 263 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


  Vector BlockVariable
members <-
    forall i p a.
Integral i =>
IO i -> IO (Ptr p) -> Int -> (Ptr p -> IO a) -> IO (Vector a)
inflateVector
      ((\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
328 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
bv)
      ((\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
336 :: IO (BlockVariablePtr)}) TypeDescriptionPtr
bv)
      Int
352
{-# LINE 269 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}

      inflateBlockVariable

  Maybe TypeDescription
type_description <-
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
336 :: IO (BlockVariablePtr)}) TypeDescriptionPtr
bv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek TypeDescriptionPtr -> IO TypeDescription
inflateTypeDescription

  pure BlockVariable.BlockVariable{Maybe Word32
Maybe TypeDescription
Maybe Text
Word32
Numeric
Array
DecorationFlagBits
Vector BlockVariable
$sel:spirv_id:BlockVariable :: Maybe Word32
$sel:name:BlockVariable :: Maybe Text
$sel:offset:BlockVariable :: Word32
$sel:absolute_offset:BlockVariable :: Word32
$sel:size:BlockVariable :: Word32
$sel:padded_size:BlockVariable :: Word32
$sel:decorations:BlockVariable :: DecorationFlagBits
$sel:numeric:BlockVariable :: Numeric
$sel:array:BlockVariable :: Array
$sel:members:BlockVariable :: Vector BlockVariable
$sel:type_description:BlockVariable :: Maybe TypeDescription
type_description :: Maybe TypeDescription
members :: Vector BlockVariable
array :: Array
numeric :: Numeric
decorations :: DecorationFlagBits
padded_size :: Word32
size :: Word32
absolute_offset :: Word32
offset :: Word32
name :: Maybe Text
spirv_id :: Maybe Word32
..}

type TypeDescriptionPtr = C2HSImp.Ptr (())
{-# LINE 278 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


inflateTypeDescription :: TypeDescriptionPtr -> IO TypeDescription
inflateTypeDescription :: TypeDescriptionPtr -> IO TypeDescription
inflateTypeDescription TypeDescriptionPtr
td = do
  Maybe Word32
id_ <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
0 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
td

  Maybe Op
op <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Enum b) => IO a -> IO b
inflateEnum forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
4 :: IO C2HSImp.CInt}) TypeDescriptionPtr
td

  Maybe Text
type_name <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Ptr CChar) -> IO Text
inflateText forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
8 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) TypeDescriptionPtr
td

  Maybe Text
struct_member_name <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Ptr CChar) -> IO Text
inflateText forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
16 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) TypeDescriptionPtr
td

  StorageClass
storage_class <- forall a b. (Integral a, Enum b) => IO a -> IO b
inflateEnum forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
24 :: IO C2HSImp.CInt}) TypeDescriptionPtr
td

  TypeFlagBits
type_flags <- forall a b. (Integral a, Coercible Word32 b) => IO a -> IO b
inflateFlags32 forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
28 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
td

  Numeric
numeric <-
    forall struct. Ptr struct -> Int -> IO Numeric
inflateNumericTraits
      TypeDescriptionPtr
td
      (Int
36)
{-# LINE 303 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


  Image
image <-
    forall struct. Ptr struct -> Int -> IO Image
inflateImageTraits
      TypeDescriptionPtr
td
      (Int
60)
{-# LINE 308 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


  Array
array <-
    forall struct. Ptr struct -> Int -> IO Array
inflateArrayTraits
      TypeDescriptionPtr
td
      (Int
84)
{-# LINE 313 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


  let traits :: Maybe Traits
traits = forall a. a -> Maybe a
Just TypeDescription.Traits{Numeric
Array
Image
$sel:numeric:Traits :: Numeric
$sel:image:Traits :: Image
$sel:array:Traits :: Array
array :: Array
image :: Image
numeric :: Numeric
..}

  Vector TypeDescription
members <-
    forall i p a.
Integral i =>
IO i -> IO (Ptr p) -> Int -> (Ptr p -> IO a) -> IO (Vector a)
inflateVector
      ((\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
348 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
td)
      ((\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
352 :: IO (TypeDescriptionPtr)}) TypeDescriptionPtr
td)
      Int
360
{-# LINE 321 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}

      inflateTypeDescription

  pure TypeDescription.TypeDescription{$sel:id:TypeDescription :: Maybe Word32
id=Maybe Word32
id_, Maybe Traits
Maybe Op
Maybe Text
TypeFlagBits
StorageClass
Vector TypeDescription
$sel:op:TypeDescription :: Maybe Op
$sel:type_name:TypeDescription :: Maybe Text
$sel:struct_member_name:TypeDescription :: Maybe Text
$sel:storage_class:TypeDescription :: StorageClass
$sel:type_flags:TypeDescription :: TypeFlagBits
$sel:traits:TypeDescription :: Maybe Traits
$sel:members:TypeDescription :: Vector TypeDescription
members :: Vector TypeDescription
traits :: Maybe Traits
type_flags :: TypeFlagBits
storage_class :: StorageClass
struct_member_name :: Maybe Text
type_name :: Maybe Text
op :: Maybe Op
..}

type DescriptorSetPtr = C2HSImp.Ptr (())
{-# LINE 326 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


inflateDescriptorSet :: DescriptorSetPtr -> IO DescriptorSet
inflateDescriptorSet :: TypeDescriptionPtr -> IO DescriptorSet
inflateDescriptorSet TypeDescriptionPtr
ds = do
  Word32
set <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
0 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
ds

  Ptr TypeDescriptionPtr
bindingsPtr <- (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
8 :: IO (C2HSImp.Ptr (DescriptorBindingPtr))}) TypeDescriptionPtr
ds
  Vector DescriptorBinding
bindings <-
    forall i p a.
Integral i =>
IO i -> IO (Ptr p) -> Int -> (Ptr p -> IO a) -> IO (Vector a)
inflateVector
      ((\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
4 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
ds)
      (forall a. Storable a => Ptr a -> IO a
peek Ptr TypeDescriptionPtr
bindingsPtr)
      Int
592
{-# LINE 338 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}

      inflateDescriptorBinding

  pure DescriptorSet.DescriptorSet{Word32
Vector DescriptorBinding
$sel:set:DescriptorSet :: Word32
$sel:bindings:DescriptorSet :: Vector DescriptorBinding
bindings :: Vector DescriptorBinding
set :: Word32
..}

type InterfaceVariablePtr = C2HSImp.Ptr (())
{-# LINE 343 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


inflateInterfaceVariable :: InterfaceVariablePtr -> IO InterfaceVariable
inflateInterfaceVariable :: TypeDescriptionPtr -> IO InterfaceVariable
inflateInterfaceVariable TypeDescriptionPtr
iv = do
  Maybe Word32
spirv_id <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
0 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
iv

  Maybe Text
name <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Ptr CChar) -> IO Text
inflateText forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
8 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) TypeDescriptionPtr
iv

  Word32
location <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
16 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
iv

  StorageClass
storage_class <- forall a b. (Integral a, Enum b) => IO a -> IO b
inflateEnum forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
20 :: IO C2HSImp.CInt}) TypeDescriptionPtr
iv

  Maybe Text
semantic <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Ptr CChar) -> IO Text
inflateText forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
24 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) TypeDescriptionPtr
iv

  DecorationFlagBits
decoration_flags <- forall a b. (Integral a, Coercible Word32 b) => IO a -> IO b
inflateFlags32 forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
32 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
iv

  BuiltIn
built_in <- forall a b. (Integral a, Enum b) => IO a -> IO b
inflateEnum forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
36 :: IO C2HSImp.CInt}) TypeDescriptionPtr
iv

  Numeric
numeric <-
    forall struct. Ptr struct -> Int -> IO Numeric
inflateNumericTraits
      TypeDescriptionPtr
iv
      (Int
40)
{-# LINE 371 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


  Array
array <-
    forall struct. Ptr struct -> Int -> IO Array
inflateArrayTraits
      TypeDescriptionPtr
iv
      (Int
64)
{-# LINE 376 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


  Vector InterfaceVariable
members <-
    forall i p a.
Integral i =>
IO i -> IO (Ptr p) -> Int -> (Ptr p -> IO a) -> IO (Vector a)
inflateVector
      ((\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
328 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
iv)
      ((\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
336 :: IO (InterfaceVariablePtr)}) TypeDescriptionPtr
iv)
      Int
368
{-# LINE 382 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}

      inflateInterfaceVariable

  Format
format <- forall a b. (Integral a, Enum b) => IO a -> IO b
inflateEnum forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
344 :: IO C2HSImp.CInt}) TypeDescriptionPtr
iv

  Maybe TypeDescription
type_description <-
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
352 :: IO (TypeDescriptionPtr)}) TypeDescriptionPtr
iv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek TypeDescriptionPtr -> IO TypeDescription
inflateTypeDescription

  Word32
wo_location <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\TypeDescriptionPtr
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff TypeDescriptionPtr
ptr Int
360 :: IO C2HSImp.CUInt}) TypeDescriptionPtr
iv
  let word_offset :: WordOffset
word_offset = InterfaceVariable.WordOffset{$sel:location:WordOffset :: Word32
location=Word32
wo_location}

  pure InterfaceVariable.InterfaceVariable{Maybe Word32
Maybe TypeDescription
Maybe Text
Word32
WordOffset
Numeric
Array
StorageClass
BuiltIn
Format
DecorationFlagBits
Vector InterfaceVariable
$sel:spirv_id:InterfaceVariable :: Maybe Word32
$sel:name:InterfaceVariable :: Maybe Text
$sel:semantic:InterfaceVariable :: Maybe Text
$sel:decoration_flags:InterfaceVariable :: DecorationFlagBits
$sel:built_in:InterfaceVariable :: BuiltIn
$sel:numeric:InterfaceVariable :: Numeric
$sel:array:InterfaceVariable :: Array
$sel:members:InterfaceVariable :: Vector InterfaceVariable
$sel:format:InterfaceVariable :: Format
$sel:type_description:InterfaceVariable :: Maybe TypeDescription
$sel:word_offset:InterfaceVariable :: WordOffset
word_offset :: WordOffset
type_description :: Maybe TypeDescription
format :: Format
members :: Vector InterfaceVariable
array :: Array
numeric :: Numeric
built_in :: BuiltIn
decoration_flags :: DecorationFlagBits
semantic :: Maybe Text
storage_class :: StorageClass
location :: Word32
name :: Maybe Text
spirv_id :: Maybe Word32
$sel:storage_class:InterfaceVariable :: StorageClass
$sel:location:InterfaceVariable :: Word32
..}

-- * Traits

type ImageTraitsPtr = C2HSImp.Ptr (())
{-# LINE 400 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


inflateImageTraits :: Ptr struct -> Int -> IO Traits.Image
inflateImageTraits :: forall struct. Ptr struct -> Int -> IO Image
inflateImageTraits Ptr struct
src Int
offset = do
  let it :: Ptr b
it = forall a b. Ptr a -> Ptr b
castPtr Ptr struct
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset

  Dim
dim <- forall a b. (Integral a, Enum b) => IO a -> IO b
inflateEnum forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
0 :: IO C2HSImp.CInt}) forall {b}. Ptr b
it

  Word32
depth <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
4 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
it

  Word32
arrayed <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
8 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
it

  Word32
ms <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
12 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
it

  Word32
sampled <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
16 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
it

  ImageFormat
image_format <- forall a b. (Integral a, Enum b) => IO a -> IO b
inflateEnum forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
20 :: IO C2HSImp.CInt}) forall {b}. Ptr b
it

  pure Traits.Image{Word32
ImageFormat
Dim
$sel:dim:Image :: Dim
$sel:depth:Image :: Word32
$sel:arrayed:Image :: Word32
$sel:ms:Image :: Word32
$sel:sampled:Image :: Word32
$sel:image_format:Image :: ImageFormat
image_format :: ImageFormat
sampled :: Word32
ms :: Word32
arrayed :: Word32
depth :: Word32
dim :: Dim
..}

type NumericTraitsPtr = C2HSImp.Ptr (())
{-# LINE 426 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


inflateNumericTraits :: Ptr struct -> Int -> IO Traits.Numeric
inflateNumericTraits :: forall struct. Ptr struct -> Int -> IO Numeric
inflateNumericTraits Ptr struct
src Int
offset = do
  let nt :: Ptr b
nt = forall a b. Ptr a -> Ptr b
castPtr Ptr struct
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset

  Word32
width <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
0 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
nt
  Word32
signedness <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
4 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
nt
  let scalar :: Scalar
scalar = Traits.Scalar{Word32
$sel:width:Scalar :: Word32
$sel:signedness:Scalar :: Word32
signedness :: Word32
width :: Word32
..}

  Word32
component_count <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
8 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
nt
  let vector :: Vector
vector = Traits.Vector{Word32
$sel:component_count:Vector :: Word32
component_count :: Word32
..}

  Word32
column_count <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
12 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
nt
  Word32
row_count <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
16 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
nt
  Word32
stride <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
20 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
nt
  let matrix :: Matrix
matrix = Traits.Matrix{Word32
$sel:column_count:Matrix :: Word32
$sel:row_count:Matrix :: Word32
$sel:stride:Matrix :: Word32
stride :: Word32
row_count :: Word32
column_count :: Word32
..}

  pure Traits.Numeric{Scalar
Vector
Matrix
$sel:scalar:Numeric :: Scalar
$sel:vector:Numeric :: Vector
$sel:matrix:Numeric :: Matrix
matrix :: Matrix
vector :: Vector
scalar :: Scalar
..}

type ArrayTraitsPtr = C2HSImp.Ptr (())
{-# LINE 452 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}


inflateArrayTraits :: Ptr struct -> Int -> IO Traits.Array
inflateArrayTraits :: forall struct. Ptr struct -> Int -> IO Array
inflateArrayTraits Ptr struct
src Int
offset = do
  let at :: Ptr b
at = forall a b. Ptr a -> Ptr b
castPtr Ptr struct
src forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset

  Word32
dims_count <- forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
0 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
at

  Vector Word32
dims <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
Vector.convert forall a b. (a -> b) -> a -> b
$ forall i p a.
Integral i =>
IO i -> IO (Ptr p) -> Int -> (Ptr p -> IO a) -> IO (Vector a)
inflateVector
    ((\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
0 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
at)
    ((\Ptr Any
ptr -> do {forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Ptr Any
ptr forall a b. Ptr a -> Int -> Ptr b
`C2HSImp.plusPtr` Int
4 :: IO (C2HSImp.Ptr C2HSImp.CUInt)}) forall {b}. Ptr b
at)
    Int
4
{-# LINE 464 "lib/Data/SpirV/Reflect/FFI/Internal.chs" #-}

    (fmap fromIntegral . peek)

  Maybe Word32
stride <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral forall a b. (a -> b) -> a -> b
$
    (\Ptr Any
ptr -> do {forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr Any
ptr Int
260 :: IO C2HSImp.CUInt}) forall {b}. Ptr b
at

  pure Traits.Array{Maybe Word32
Word32
Vector Word32
$sel:dims_count:Array :: Word32
$sel:dims:Array :: Vector Word32
$sel:stride:Array :: Maybe Word32
stride :: Maybe Word32
dims :: Vector Word32
dims_count :: Word32
..}

-- * Atomic types

inflateIntegral :: (Integral a, Num b) => IO a -> IO b
inflateIntegral :: forall a b. (Integral a, Num b) => IO a -> IO b
inflateIntegral IO a
getIntegral =
  IO a
getIntegral forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

inflateEnum :: (Integral a, Enum b) => IO a -> IO b
inflateEnum :: forall a b. (Integral a, Enum b) => IO a -> IO b
inflateEnum IO a
getEnum =
  IO a
getEnum forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

inflateFlags32 :: forall a b . (Integral a, Coercible Word32 b) => IO a -> IO b
inflateFlags32 :: forall a b. (Integral a, Coercible Word32 b) => IO a -> IO b
inflateFlags32 IO a
gitBits =
  IO a
gitBits forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce @Word32 @b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

inflateText :: IO CString -> IO Text
inflateText :: IO (Ptr CChar) -> IO Text
inflateText IO (Ptr CChar)
getPtr =
  IO (Ptr CChar)
getPtr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr CChar
ptr ->
    if forall {b}. Ptr b
nullPtr forall a. Eq a => a -> a -> Bool
== Ptr CChar
ptr then
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    else
      case Ptr CChar
ptr of
        GHC.Ptr Addr#
addr ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Addr# -> Text
Text.unpackCString# Addr#
addr

foreign import ccall unsafe "Data/SpirV/Reflect/FFI/Internal.chs.h spvReflectCreateShaderModule"
  createShaderModule'_ :: (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> ((ShaderModulePtr) -> (IO C2HSImp.CInt))))

foreign import ccall unsafe "Data/SpirV/Reflect/FFI/Internal.chs.h spvReflectCreateShaderModule2"
  createShaderModule2'_ :: (C2HSImp.CUInt -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> ((ShaderModulePtr) -> (IO C2HSImp.CInt)))))

foreign import ccall unsafe "Data/SpirV/Reflect/FFI/Internal.chs.h spvReflectDestroyShaderModule"
  destroyShaderModule'_ :: ((ShaderModulePtr) -> (IO ()))