{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGe PatternSynonyms #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Sparse.Buffer.Internal where

import Data.TypeLevel.Tuple.Uncurry
import Data.HeteroParList (pattern (:**))
import Data.HeteroParList qualified as HPList

import Gpu.Vulkan.Device qualified as Device
import Gpu.Vulkan.Buffer.Type qualified as Buffer
import Gpu.Vulkan.Sparse.Internal

import Gpu.Vulkan.Sparse.Buffer.Middle qualified as M

data MemoryBindInfo sb bnm objs sais = MemoryBindInfo {
	forall sb (bnm :: Symbol) (objs :: [O])
       (sais :: [(*, [(*, ImageBufferArg)], Nat)]).
MemoryBindInfo sb bnm objs sais -> B sb bnm objs
memoryBindInfoBuffer :: Buffer.B sb bnm objs,
	forall sb (bnm :: Symbol) (objs :: [O])
       (sais :: [(*, [(*, ImageBufferArg)], Nat)]).
MemoryBindInfo sb bnm objs sais -> PL (U3 MemoryBind) sais
memoryBindInfoBinds :: HPList.PL (U3 MemoryBind) sais }

memoryBindInfoToMiddle :: MemoryBindsToMiddle sais =>
	Device.D sd -> MemoryBindInfo sb bnm objs sais -> IO M.MemoryBindInfo
memoryBindInfoToMiddle :: forall (sais :: [(*, [(*, ImageBufferArg)], Nat)]) sd sb
       (bnm :: Symbol) (objs :: [O]).
MemoryBindsToMiddle sais =>
D sd -> MemoryBindInfo sb bnm objs sais -> IO MemoryBindInfo
memoryBindInfoToMiddle D sd
dv MemoryBindInfo {
	memoryBindInfoBuffer :: forall sb (bnm :: Symbol) (objs :: [O])
       (sais :: [(*, [(*, ImageBufferArg)], Nat)]).
MemoryBindInfo sb bnm objs sais -> B sb bnm objs
memoryBindInfoBuffer = Buffer.B PL Length objs
_ B
b,
	memoryBindInfoBinds :: forall sb (bnm :: Symbol) (objs :: [O])
       (sais :: [(*, [(*, ImageBufferArg)], Nat)]).
MemoryBindInfo sb bnm objs sais -> PL (U3 MemoryBind) sais
memoryBindInfoBinds = PL (U3 MemoryBind) sais
bs
	} = do
	mbs <- D sd -> PL (U3 MemoryBind) sais -> IO [MemoryBind]
forall (sais :: [(*, [(*, ImageBufferArg)], Nat)]) sd.
MemoryBindsToMiddle sais =>
D sd -> PL (U3 MemoryBind) sais -> IO [MemoryBind]
forall sd. D sd -> PL (U3 MemoryBind) sais -> IO [MemoryBind]
memoryBindsToMiddle D sd
dv PL (U3 MemoryBind) sais
bs
	pure M.MemoryBindInfo {
		M.memoryBindInfoBuffer = b,
		M.memoryBindInfoBinds = mbs }

class MemoryBindInfosToMiddle mbias where
	memoryBindInfosToMiddle ::
		Device.D sd ->
		HPList.PL (U4 MemoryBindInfo) mbias -> IO [M.MemoryBindInfo]

instance MemoryBindInfosToMiddle '[] where
	memoryBindInfosToMiddle :: forall sd.
D sd -> PL (U4 MemoryBindInfo) '[] -> IO [MemoryBindInfo]
memoryBindInfosToMiddle D sd
_ PL (U4 MemoryBindInfo) '[]
HPList.Nil = [MemoryBindInfo] -> IO [MemoryBindInfo]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

instance (MemoryBindsToMiddle sais, MemoryBindInfosToMiddle mbias) =>
	MemoryBindInfosToMiddle ('(sb, bnm, objs, sais) ': mbias) where
	memoryBindInfosToMiddle :: forall sd.
D sd
-> PL (U4 MemoryBindInfo) ('(sb, bnm, objs, sais) : mbias)
-> IO [MemoryBindInfo]
memoryBindInfosToMiddle D sd
dv (U4 MemoryBindInfo s1 s2 s3 s4
mbi :** PL (U4 MemoryBindInfo) ss1
mbis) = (:)
		(MemoryBindInfo -> [MemoryBindInfo] -> [MemoryBindInfo])
-> IO MemoryBindInfo -> IO ([MemoryBindInfo] -> [MemoryBindInfo])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D sd -> MemoryBindInfo s1 s2 s3 s4 -> IO MemoryBindInfo
forall (sais :: [(*, [(*, ImageBufferArg)], Nat)]) sd sb
       (bnm :: Symbol) (objs :: [O]).
MemoryBindsToMiddle sais =>
D sd -> MemoryBindInfo sb bnm objs sais -> IO MemoryBindInfo
memoryBindInfoToMiddle D sd
dv MemoryBindInfo s1 s2 s3 s4
mbi
		IO ([MemoryBindInfo] -> [MemoryBindInfo])
-> IO [MemoryBindInfo] -> IO [MemoryBindInfo]
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> D sd -> PL (U4 MemoryBindInfo) ss1 -> IO [MemoryBindInfo]
forall (mbias :: [(*, Symbol, [O],
                   [(*, [(*, ImageBufferArg)], Nat)])])
       sd.
MemoryBindInfosToMiddle mbias =>
D sd -> PL (U4 MemoryBindInfo) mbias -> IO [MemoryBindInfo]
forall sd.
D sd -> PL (U4 MemoryBindInfo) ss1 -> IO [MemoryBindInfo]
memoryBindInfosToMiddle D sd
dv PL (U4 MemoryBindInfo) ss1
mbis

{-
memoryBindInfosToMiddle ::
	HPList.ToListWithCM' MemoryBindsToMiddle I3_4 mbias =>
	Device.D sd -> HPList.PL (U4 MemoryBindInfo) mbias -> IO [M.MemoryBindInfo]
memoryBindInfosToMiddle dv = toListWithCM' (\U4 mbi -> memoryBindInfoToMiddle dv mbi)
-}