{-# LINE 1 "src/Gpu/Vulkan/BufferView/Middle/Internal.hsc" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.BufferView.Middle.Internal (
	B(..), CreateInfo(..), CreateFlags, create, destroy ) where

import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Storable
import Foreign.Storable.PeekPoke
import Foreign.C.Enum
import Data.TypeLevel.Maybe qualified as TMaybe
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.Word
import Data.Bits

import Gpu.Vulkan.Enum
import Gpu.Vulkan.Exception.Middle.Internal
import Gpu.Vulkan.Exception.Enum

import Gpu.Vulkan.AllocationCallbacks.Middle.Internal
	qualified as AllocationCallbacks
import qualified Gpu.Vulkan.Device.Middle.Internal as Device
import qualified Gpu.Vulkan.BufferView.Core as C
import qualified Gpu.Vulkan.Buffer.Middle.Internal as Buffer



enum "CreateFlags" ''Word32
{-# LINE 36 "src/Gpu/Vulkan/BufferView/Middle/Internal.hsc" #-}
	[''Show, ''Storable, ''Eq, ''Bits] [("CreateFlagsZero", 0)]

data CreateInfo mn = CreateInfo {
	forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext :: TMaybe.M mn,
	forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags
createInfoFlags :: CreateFlags,
	forall (mn :: Maybe (*)). CreateInfo mn -> B
createInfoBuffer :: Buffer.B,
	forall (mn :: Maybe (*)). CreateInfo mn -> Format
createInfoFormat :: Format,
	forall (mn :: Maybe (*)). CreateInfo mn -> Size
createInfoOffset :: Device.Size,
	forall (mn :: Maybe (*)). CreateInfo mn -> Size
createInfoRange :: Device.Size }

deriving instance Show (TMaybe.M mn) => Show (CreateInfo mn)

createInfoToCore' :: WithPoked (TMaybe.M mn) => CreateInfo mn -> (Ptr C.CreateInfo -> IO a) -> IO ()
createInfoToCore' :: forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore' CreateInfo {
	createInfoNext :: forall (mn :: Maybe (*)). CreateInfo mn -> M mn
createInfoNext = M mn
mnxt,
	createInfoFlags :: forall (mn :: Maybe (*)). CreateInfo mn -> CreateFlags
createInfoFlags = CreateFlags Word32
flgs,
	createInfoBuffer :: forall (mn :: Maybe (*)). CreateInfo mn -> B
createInfoBuffer = Buffer.B B
bf,
	createInfoFormat :: forall (mn :: Maybe (*)). CreateInfo mn -> Format
createInfoFormat = Format Word32
fmt,
	createInfoOffset :: forall (mn :: Maybe (*)). CreateInfo mn -> Size
createInfoOffset = Device.Size Word64
os,
	createInfoRange :: forall (mn :: Maybe (*)). CreateInfo mn -> Size
createInfoRange = Device.Size Word64
rng
	} Ptr CreateInfo -> IO a
f = M mn -> (forall s. PtrS s (M mn) -> IO ()) -> IO ()
forall a b.
WithPoked a =>
a -> (forall s. PtrS s a -> IO b) -> IO b
forall b. M mn -> (forall s. PtrS s (M mn) -> IO b) -> IO b
withPoked' M mn
mnxt \PtrS s (M mn)
pnxt -> PtrS s (M mn) -> (Ptr (M mn) -> IO a) -> IO ()
forall s a b. PtrS s a -> (Ptr a -> IO b) -> IO ()
withPtrS PtrS s (M mn)
pnxt \(Ptr (M mn) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr -> Ptr ()
pnxt') ->
	CreateInfo -> (Ptr CreateInfo -> IO a) -> IO a
forall a b. Pokable a => a -> (Ptr a -> IO b) -> IO b
withPoked C.CreateInfo {
			createInfoSType :: ()
C.createInfoSType = (),
			createInfoPNext :: Ptr ()
C.createInfoPNext = Ptr ()
pnxt',
			createInfoFlags :: Word32
C.createInfoFlags = Word32
flgs,
			createInfoBuffer :: B
C.createInfoBuffer = B
bf,
			createInfoFormat :: Word32
C.createInfoFormat = Word32
fmt,
			createInfoOffset :: Word64
C.createInfoOffset = Word64
os,
			createInfoRange :: Word64
C.createInfoRange = Word64
rng } Ptr CreateInfo -> IO a
f

newtype B = B C.B deriving Int -> B -> ShowS
[B] -> ShowS
B -> String
(Int -> B -> ShowS) -> (B -> String) -> ([B] -> ShowS) -> Show B
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> B -> ShowS
showsPrec :: Int -> B -> ShowS
$cshow :: B -> String
show :: B -> String
$cshowList :: [B] -> ShowS
showList :: [B] -> ShowS
Show

create :: WithPoked (TMaybe.M mn) =>
	Device.D -> CreateInfo mn -> TPMaybe.M AllocationCallbacks.A mc -> IO B
create :: forall (mn :: Maybe (*)) (mc :: Maybe (*)).
WithPoked (M mn) =>
D -> CreateInfo mn -> M A mc -> IO B
create (Device.D D
dvc) CreateInfo mn
ci M A mc
mac = B -> B
B (B -> B) -> IO B -> IO B
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr B -> IO B) -> IO B
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca \Ptr B
pb -> do
	CreateInfo mn -> (Ptr CreateInfo -> IO ()) -> IO ()
forall (mn :: Maybe (*)) a.
WithPoked (M mn) =>
CreateInfo mn -> (Ptr CreateInfo -> IO a) -> IO ()
createInfoToCore' CreateInfo mn
ci \Ptr CreateInfo
pci -> M A mc -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A mc
mac \Ptr A
pac -> do
		r <- D -> Ptr CreateInfo -> Ptr A -> Ptr B -> IO Int32
C.create D
dvc Ptr CreateInfo
pci Ptr A
pac Ptr B
pb
		throwUnlessSuccess $ Result r
	Ptr B -> IO B
forall a. Storable a => Ptr a -> IO a
peek Ptr B
pb

destroy :: Device.D -> B -> TPMaybe.M AllocationCallbacks.A md -> IO ()
destroy :: forall (md :: Maybe (*)). D -> B -> M A md -> IO ()
destroy (Device.D D
dvc) (B B
b) M A md
mac =
	M A md -> (Ptr A -> IO ()) -> IO ()
forall (ma :: Maybe (*)) b. M A ma -> (Ptr A -> IO b) -> IO ()
AllocationCallbacks.mToCore M A md
mac ((Ptr A -> IO ()) -> IO ()) -> (Ptr A -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ D -> B -> Ptr A -> IO ()
C.destroy D
dvc B
b