Added some more fields to the type level. genvulkan generates invalid…

… code now due to missing deps.

genvulkan/src/VkXml/Sections/Types.hs

@@ -55,7 +55,7 @@ data VkTypeAttrs
   , parent        :: Maybe VkTypeName
   , returnedonly  :: Bool
   , comment       :: Text
-  , structextends :: Maybe VkTypeName
+  , structextends :: [VkTypeName]
   } deriving Show
 
 data VkTypeCategory
@@ -138,9 +138,10 @@ data VkType
 --   * If failed to parse tag "types", throw an exception
 parseTypes :: VkXmlParser m => Sink Event m (Maybe VkTypes)
 parseTypes = parseTagForceAttrs "types" (lift $ attr "comment")
-  $ \secComment -> do
-    tps <- parseSections parseVkType
-    return $ VkTypes (fromMaybe mempty secComment) tps
+  $ \secComment ->
+    VkTypes (fromMaybe mempty secComment)
+       <$> parseSections parseVkType
+
 
 
 parseAttrVkTypeCategory :: ReaderT ParseLoc AttrParser VkTypeCategory
@@ -179,8 +180,12 @@ parseAttrVkTypeReturnedonly = do
 parseAttrVkTypeComment :: ReaderT ParseLoc AttrParser Text
 parseAttrVkTypeComment = lift (fromMaybe mempty <$> attr "comment")
 
-parseAttrVkTypeStructextends :: ReaderT ParseLoc AttrParser (Maybe VkTypeName)
-parseAttrVkTypeStructextends = lift $ fmap VkTypeName <$> attr "structextends"
+parseAttrVkTypeStructextends :: ReaderT ParseLoc AttrParser [VkTypeName]
+parseAttrVkTypeStructextends
+  = lift
+  $ fmap VkTypeName
+  . maybe [] (T.split (','==))
+  <$> attr "structextends"
 
 
 parseVkTypeAttrs :: ReaderT ParseLoc AttrParser VkTypeAttrs

genvulkan/src/Write/Types/Struct.hs

@@ -12,7 +12,7 @@ module Write.Types.Struct
   ) where
 
 
-import           Control.Monad                        (when)
+import           Control.Monad                        (when, forM_)
 import           Data.Char                            (toUpper)
 import           Data.Map                             (Map)
 import qualified Data.Map                             as Map
@@ -70,6 +70,8 @@ genStructOrUnion isUnion VkTypeComposite
     writeFullImport "GHC.Prim"
     writeFullImport "Graphics.Vulkan.Marshal"
     writeFullImport "Graphics.Vulkan.Marshal.Internal"
+    forM_ (structextends attrs) $ \(VkTypeName n) ->
+      writeImport $ DIThing n DITNo
 
     let ds = parseDecls [text|
           data $tnametxt = $tnametxt# Addr# ByteArray#
@@ -104,7 +106,10 @@ genStructOrUnion isUnion VkTypeComposite
             {-# INLINE unsafeFromByteArrayOffset #-}
 
           instance VulkanMarshal $tnametxt where
-            type StructFields $tnametxt = $fieldNamesTxt
+            type StructFields  $tnametxt = $fieldNamesTxt
+            type CUnionType    $tnametxt = $isUnionTxt
+            type ReturnedOnly  $tnametxt = $returnedonlyTxt
+            type StructExtends $tnametxt = $structextendsTxt
           |]
 
 
@@ -126,6 +131,10 @@ genStructOrUnion isUnion VkTypeComposite
     writeExport tnameDeclared
     return classDefs
   where
+    returnedonlyTxt = T.pack . ('\'':) . show $ returnedonly attrs
+    isUnionTxt = T.pack . ('\'':) . show $ category attrs == VkTypeCatUnion
+    structextendsTxt
+      = "'[" <> T.intercalate "," (unVkTypeName <$> structextends attrs) <> "]"
     fieldNamesTxt = T.pack . ('\'':) . show
                   $ map (\VkTypeMember{ name = VkMemberName n} -> n ) $ items tmems
     tnameDeclared = DIThing tnametxt DITAll

vulkan-api/src-gen/Graphics/Vulkan/Core.hsc

@@ -2933,6 +2933,9 @@ instance VulkanMarshal VkBufferMemoryBarrier where
              '["sType", "pNext", "srcAccessMask", "dstAccessMask", -- ' closing tick for hsc2hs
                "srcQueueFamilyIndex", "dstQueueFamilyIndex", "buffer", "offset",
                "size"]
+        type CUnionType VkBufferMemoryBarrier = 'False -- ' closing tick for hsc2hs
+        type ReturnedOnly VkBufferMemoryBarrier = 'False -- ' closing tick for hsc2hs
+        type StructExtends VkBufferMemoryBarrier = '[] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-} HasVkSType VkBufferMemoryBarrier where
         type VkSTypeMType VkBufferMemoryBarrier = VkStructureType
@@ -3430,6 +3433,9 @@ instance VulkanMarshalPrim VkDispatchIndirectCommand where
 
 instance VulkanMarshal VkDispatchIndirectCommand where
         type StructFields VkDispatchIndirectCommand = '["x", "y", "z"] -- ' closing tick for hsc2hs
+        type CUnionType VkDispatchIndirectCommand = 'False -- ' closing tick for hsc2hs
+        type ReturnedOnly VkDispatchIndirectCommand = 'False -- ' closing tick for hsc2hs
+        type StructExtends VkDispatchIndirectCommand = '[] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-} HasVkX VkDispatchIndirectCommand where
         type VkXMType VkDispatchIndirectCommand = Word32
@@ -3632,6 +3638,9 @@ instance VulkanMarshal VkDrawIndexedIndirectCommand where
         type StructFields VkDrawIndexedIndirectCommand =
              '["indexCount", "instanceCount", "firstIndex", "vertexOffset", -- ' closing tick for hsc2hs
                "firstInstance"]
+        type CUnionType VkDrawIndexedIndirectCommand = 'False -- ' closing tick for hsc2hs
+        type ReturnedOnly VkDrawIndexedIndirectCommand = 'False -- ' closing tick for hsc2hs
+        type StructExtends VkDrawIndexedIndirectCommand = '[] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-}
          HasVkIndexCount VkDrawIndexedIndirectCommand where
@@ -3950,6 +3959,9 @@ instance VulkanMarshalPrim VkDrawIndirectCommand where
 instance VulkanMarshal VkDrawIndirectCommand where
         type StructFields VkDrawIndirectCommand =
              '["vertexCount", "instanceCount", "firstVertex", "firstInstance"] -- ' closing tick for hsc2hs
+        type CUnionType VkDrawIndirectCommand = 'False -- ' closing tick for hsc2hs
+        type ReturnedOnly VkDrawIndirectCommand = 'False -- ' closing tick for hsc2hs
+        type StructExtends VkDrawIndirectCommand = '[] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-} HasVkVertexCount VkDrawIndirectCommand
          where
@@ -4209,6 +4221,9 @@ instance VulkanMarshal VkImageMemoryBarrier where
              '["sType", "pNext", "srcAccessMask", "dstAccessMask", "oldLayout", -- ' closing tick for hsc2hs
                "newLayout", "srcQueueFamilyIndex", "dstQueueFamilyIndex", "image",
                "subresourceRange"]
+        type CUnionType VkImageMemoryBarrier = 'False -- ' closing tick for hsc2hs
+        type ReturnedOnly VkImageMemoryBarrier = 'False -- ' closing tick for hsc2hs
+        type StructExtends VkImageMemoryBarrier = '[] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-} HasVkSType VkImageMemoryBarrier where
         type VkSTypeMType VkImageMemoryBarrier = VkStructureType
@@ -4759,6 +4774,9 @@ instance VulkanMarshalPrim VkMemoryBarrier where
 instance VulkanMarshal VkMemoryBarrier where
         type StructFields VkMemoryBarrier =
              '["sType", "pNext", "srcAccessMask", "dstAccessMask"] -- ' closing tick for hsc2hs
+        type CUnionType VkMemoryBarrier = 'False -- ' closing tick for hsc2hs
+        type ReturnedOnly VkMemoryBarrier = 'False -- ' closing tick for hsc2hs
+        type StructExtends VkMemoryBarrier = '[] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-} HasVkSType VkMemoryBarrier where
         type VkSTypeMType VkMemoryBarrier = VkStructureType

vulkan-api/src-gen/Graphics/Vulkan/Ext/VK_AMD_rasterization_order.hsc

@@ -32,6 +32,7 @@ import           Foreign.C.String                 (CString)
 import           Foreign.Storable                 (Storable (..))
 import           GHC.Prim
 import           GHC.Ptr                          (Ptr (..))
+import           Graphics.Vulkan.Base             (VkPipelineRasterizationStateCreateInfo)
 import           Graphics.Vulkan.Common           (VkRasterizationOrderAMD,
                                                    VkStructureType (..))
 import           Graphics.Vulkan.Marshal
@@ -104,6 +105,13 @@ instance VulkanMarshal
          where
         type StructFields VkPipelineRasterizationStateRasterizationOrderAMD
              = '["sType", "pNext", "rasterizationOrder"] -- ' closing tick for hsc2hs
+        type CUnionType VkPipelineRasterizationStateRasterizationOrderAMD =
+             'False -- ' closing tick for hsc2hs
+        type ReturnedOnly VkPipelineRasterizationStateRasterizationOrderAMD
+             = 'False -- ' closing tick for hsc2hs
+        type StructExtends
+               VkPipelineRasterizationStateRasterizationOrderAMD
+             = '[VkPipelineRasterizationStateCreateInfo] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-}
          HasVkSType VkPipelineRasterizationStateRasterizationOrderAMD where

vulkan-api/src-gen/Graphics/Vulkan/Ext/VK_AMD_shader_info.hsc

@@ -97,6 +97,9 @@ instance VulkanMarshal VkShaderResourceUsageAMD where
         type StructFields VkShaderResourceUsageAMD =
              '["numUsedVgprs", "numUsedSgprs", "ldsSizePerLocalWorkGroup", -- ' closing tick for hsc2hs
                "ldsUsageSizeInBytes", "scratchMemUsageInBytes"]
+        type CUnionType VkShaderResourceUsageAMD = 'False -- ' closing tick for hsc2hs
+        type ReturnedOnly VkShaderResourceUsageAMD = 'True -- ' closing tick for hsc2hs
+        type StructExtends VkShaderResourceUsageAMD = '[] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-}
          HasVkNumUsedVgprs VkShaderResourceUsageAMD where
@@ -404,6 +407,9 @@ instance VulkanMarshal VkShaderStatisticsInfoAMD where
              '["shaderStageMask", "resourceUsage", "numPhysicalVgprs", -- ' closing tick for hsc2hs
                "numPhysicalSgprs", "numAvailableVgprs", "numAvailableSgprs",
                "computeWorkGroupSize"]
+        type CUnionType VkShaderStatisticsInfoAMD = 'False -- ' closing tick for hsc2hs
+        type ReturnedOnly VkShaderStatisticsInfoAMD = 'True -- ' closing tick for hsc2hs
+        type StructExtends VkShaderStatisticsInfoAMD = '[] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-}
          HasVkShaderStageMask VkShaderStatisticsInfoAMD where

vulkan-api/src-gen/Graphics/Vulkan/Ext/VK_AMD_texture_gather_bias_lod.hsc

@@ -44,6 +44,8 @@ import           Graphics.Vulkan.Marshal.Internal
 import           Graphics.Vulkan.StructMembers
 import           System.IO.Unsafe                 (unsafeDupablePerformIO)
 
+import           Graphics.Vulkan.Ext.VK_KHR_get_physical_device_properties2
+
 -- | > typedef struct VkTextureLODGatherFormatPropertiesAMD {
 --   >     VkStructureType sType;
 --   >     void*                            pNext;
@@ -102,6 +104,10 @@ instance VulkanMarshalPrim VkTextureLODGatherFormatPropertiesAMD
 instance VulkanMarshal VkTextureLODGatherFormatPropertiesAMD where
         type StructFields VkTextureLODGatherFormatPropertiesAMD =
              '["sType", "pNext", "supportsTextureGatherLODBiasAMD"] -- ' closing tick for hsc2hs
+        type CUnionType VkTextureLODGatherFormatPropertiesAMD = 'False -- ' closing tick for hsc2hs
+        type ReturnedOnly VkTextureLODGatherFormatPropertiesAMD = 'True -- ' closing tick for hsc2hs
+        type StructExtends VkTextureLODGatherFormatPropertiesAMD =
+             '[VkImageFormatProperties2KHR] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-}
          HasVkSType VkTextureLODGatherFormatPropertiesAMD where

vulkan-api/src-gen/Graphics/Vulkan/Ext/VK_ANDROID_native_buffer.hsc

@@ -90,6 +90,9 @@ instance VulkanMarshalPrim VkNativeBufferANDROID where
 instance VulkanMarshal VkNativeBufferANDROID where
         type StructFields VkNativeBufferANDROID =
              '["sType", "pNext", "handle", "stride", "format", "usage"] -- ' closing tick for hsc2hs
+        type CUnionType VkNativeBufferANDROID = 'False -- ' closing tick for hsc2hs
+        type ReturnedOnly VkNativeBufferANDROID = 'False -- ' closing tick for hsc2hs
+        type StructExtends VkNativeBufferANDROID = '[] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-} HasVkSType VkNativeBufferANDROID where
         type VkSTypeMType VkNativeBufferANDROID = VkStructureType

vulkan-api/src-gen/Graphics/Vulkan/Ext/VK_EXT_blend_operation_advanced.hsc

@@ -65,19 +65,24 @@ module Graphics.Vulkan.Ext.VK_EXT_blend_operation_advanced
         pattern VK_BLEND_OP_GREEN_EXT, pattern VK_BLEND_OP_BLUE_EXT,
         pattern VK_ACCESS_COLOR_ATTACHMENT_READ_NONCOHERENT_BIT_EXT)
        where
-import           Foreign.C.String                 (CString)
-import           Foreign.Storable                 (Storable (..))
+import           Foreign.C.String                                           (CString)
+import           Foreign.Storable                                           (Storable (..))
 import           GHC.Prim
-import           GHC.Ptr                          (Ptr (..))
-import           Graphics.Vulkan.Common           (VkAccessFlagBits (..),
-                                                   VkBlendOp (..),
-                                                   VkBlendOverlapEXT, VkBool32,
-                                                   VkStructureType,
-                                                   VkStructureType (..), Word32)
+import           GHC.Ptr                                                    (Ptr (..))
+import           Graphics.Vulkan.Base                                       (VkPipelineColorBlendStateCreateInfo)
+import           Graphics.Vulkan.Common                                     (VkAccessFlagBits (..),
+                                                                             VkBlendOp (..),
+                                                                             VkBlendOverlapEXT,
+                                                                             VkBool32,
+                                                                             VkStructureType,
+                                                                             VkStructureType (..),
+                                                                             Word32)
+import           Graphics.Vulkan.Ext.VK_KHR_get_physical_device_properties2 (VkPhysicalDeviceFeatures2KHR,
+                                                                             VkPhysicalDeviceProperties2KHR)
 import           Graphics.Vulkan.Marshal
 import           Graphics.Vulkan.Marshal.Internal
 import           Graphics.Vulkan.StructMembers
-import           System.IO.Unsafe                 (unsafeDupablePerformIO)
+import           System.IO.Unsafe                                           (unsafeDupablePerformIO)
 
 -- | > typedef struct VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT {
 --   >     VkStructureType sType;
@@ -144,6 +149,13 @@ instance VulkanMarshal
          where
         type StructFields VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
              = '["sType", "pNext", "advancedBlendCoherentOperations"] -- ' closing tick for hsc2hs
+        type CUnionType VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT =
+             'False -- ' closing tick for hsc2hs
+        type ReturnedOnly VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
+             = 'False -- ' closing tick for hsc2hs
+        type StructExtends
+               VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT
+             = '[VkPhysicalDeviceFeatures2KHR] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-}
          HasVkSType VkPhysicalDeviceBlendOperationAdvancedFeaturesEXT where
@@ -416,6 +428,14 @@ instance VulkanMarshal
                "advancedBlendNonPremultipliedSrcColor",
                "advancedBlendNonPremultipliedDstColor",
                "advancedBlendCorrelatedOverlap", "advancedBlendAllOperations"]
+        type CUnionType VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
+             = 'False -- ' closing tick for hsc2hs
+        type ReturnedOnly
+               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
+             = 'True -- ' closing tick for hsc2hs
+        type StructExtends
+               VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
+             = '[VkPhysicalDeviceProperties2KHR] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-}
          HasVkSType VkPhysicalDeviceBlendOperationAdvancedPropertiesEXT
@@ -967,6 +987,12 @@ instance VulkanMarshal
         type StructFields VkPipelineColorBlendAdvancedStateCreateInfoEXT =
              '["sType", "pNext", "srcPremultiplied", "dstPremultiplied", -- ' closing tick for hsc2hs
                "blendOverlap"]
+        type CUnionType VkPipelineColorBlendAdvancedStateCreateInfoEXT =
+             'False -- ' closing tick for hsc2hs
+        type ReturnedOnly VkPipelineColorBlendAdvancedStateCreateInfoEXT =
+             'False -- ' closing tick for hsc2hs
+        type StructExtends VkPipelineColorBlendAdvancedStateCreateInfoEXT =
+             '[VkPipelineColorBlendStateCreateInfo] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-}
          HasVkSType VkPipelineColorBlendAdvancedStateCreateInfoEXT where

vulkan-api/src-gen/Graphics/Vulkan/Ext/VK_EXT_conservative_rasterization.hsc

@@ -35,17 +35,20 @@ module Graphics.Vulkan.Ext.VK_EXT_conservative_rasterization
         pattern VK_STRUCTURE_TYPE_PHYSICAL_DEVICE_CONSERVATIVE_RASTERIZATION_PROPERTIES_EXT,
         pattern VK_STRUCTURE_TYPE_PIPELINE_RASTERIZATION_CONSERVATIVE_STATE_CREATE_INFO_EXT)
        where
-import           Foreign.C.String                 (CString)
-import           Foreign.Storable                 (Storable (..))
+import           Foreign.C.String                                           (CString)
+import           Foreign.Storable                                           (Storable (..))
 import           GHC.Prim
-import           GHC.Ptr                          (Ptr (..))
-import           Graphics.Vulkan.Common           (VkBool32, VkConservativeRasterizationModeEXT,
-                                                   VkPipelineRasterizationConservativeStateCreateFlagsEXT,
-                                                   VkStructureType (..))
+import           GHC.Ptr                                                    (Ptr (..))
+import           Graphics.Vulkan.Base                                       (VkPipelineRasterizationStateCreateInfo)
+import           Graphics.Vulkan.Common                                     (VkBool32,
+                                                                             VkConservativeRasterizationModeEXT,
+                                                                             VkPipelineRasterizationConservativeStateCreateFlagsEXT,
+                                                                             VkStructureType (..))
+import           Graphics.Vulkan.Ext.VK_KHR_get_physical_device_properties2 (VkPhysicalDeviceProperties2KHR)
 import           Graphics.Vulkan.Marshal
 import           Graphics.Vulkan.Marshal.Internal
 import           Graphics.Vulkan.StructMembers
-import           System.IO.Unsafe                 (unsafeDupablePerformIO)
+import           System.IO.Unsafe                                           (unsafeDupablePerformIO)
 
 -- | > typedef struct VkPhysicalDeviceConservativeRasterizationPropertiesEXT {
 --   >     VkStructureType sType;
@@ -132,6 +135,15 @@ instance VulkanMarshal
                "degenerateTrianglesRasterized", "degenerateLinesRasterized",
                "fullyCoveredFragmentShaderInputVariable",
                "conservativeRasterizationPostDepthCoverage"]
+        type CUnionType
+               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
+             = 'False -- ' closing tick for hsc2hs
+        type ReturnedOnly
+               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
+             = 'False -- ' closing tick for hsc2hs
+        type StructExtends
+               VkPhysicalDeviceConservativeRasterizationPropertiesEXT
+             = '[VkPhysicalDeviceProperties2KHR] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-}
          HasVkSType VkPhysicalDeviceConservativeRasterizationPropertiesEXT
@@ -954,6 +966,15 @@ instance VulkanMarshal
              =
              '["sType", "pNext", "flags", "conservativeRasterizationMode", -- ' closing tick for hsc2hs
                "extraPrimitiveOverestimationSize"]
+        type CUnionType
+               VkPipelineRasterizationConservativeStateCreateInfoEXT
+             = 'False -- ' closing tick for hsc2hs
+        type ReturnedOnly
+               VkPipelineRasterizationConservativeStateCreateInfoEXT
+             = 'False -- ' closing tick for hsc2hs
+        type StructExtends
+               VkPipelineRasterizationConservativeStateCreateInfoEXT
+             = '[VkPipelineRasterizationStateCreateInfo] -- ' closing tick for hsc2hs
 
 instance {-# OVERLAPPING #-}
          HasVkSType VkPipelineRasterizationConservativeStateCreateInfoEXT