{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE ScopedTypeVariables, RankNTypes, TypeApplications #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures, TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses, AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Memory.Bind (

	-- * BIND AND REBIND

	Bindable, Rebindable, BindAll(..), RebindAll(..)

	) where

import Control.Monad

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

import Gpu.Vulkan.Device.Type qualified as Device
import Gpu.Vulkan.Device.Middle qualified as Device.M
import Gpu.Vulkan.Memory.ImageBuffer

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

import Gpu.Vulkan.Image.Type qualified as Image
import Gpu.Vulkan.Image.Middle qualified as Image.M

import Gpu.Vulkan.Memory.Type

import Gpu.Vulkan.Object qualified as VObj

import Debug

class (BindAll ibargs ibargs, Alignments ibargs) => Bindable ibargs
instance (BindAll ibargs ibargs , Alignments ibargs) => Bindable ibargs

class BindAll ibargs mibargs where
	bindAll :: Device.D sd -> HeteroParList.PL (U2 ImageBuffer) ibargs ->
		M sm mibargs -> Device.M.Size ->
		IO (HeteroParList.PL (U2 (ImageBufferBinded sm)) ibargs)

instance BindAll '[] mibargs where bindAll :: forall sd sm.
D sd
-> PL (U2 ImageBuffer) '[]
-> M sm mibargs
-> Size
-> IO (PL (U2 (ImageBufferBinded sm)) '[])
bindAll D sd
_ PL (U2 ImageBuffer) '[]
_ M sm mibargs
_ Size
_ = PL (U2 (ImageBufferBinded sm)) '[]
-> IO (PL (U2 (ImageBufferBinded sm)) '[])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PL (U2 (ImageBufferBinded sm)) '[]
forall {k} (t :: k -> *). PL t '[]
HeteroParList.Nil

instance BindAll ibargs mibargs =>
	BindAll ('(si, ('ImageArg nm fmt)) ': ibargs) mibargs where
	bindAll :: forall sd sm.
D sd
-> PL (U2 ImageBuffer) ('(si, 'ImageArg nm fmt) : ibargs)
-> M sm mibargs
-> Size
-> IO
     (PL (U2 (ImageBufferBinded sm)) ('(si, 'ImageArg nm fmt) : ibargs))
bindAll dv :: D sd
dv@(Device.D D
mdv) (U2 ii :: ImageBuffer s1 s2
ii@(Image (Image.I I
i)) :** PL (U2 ImageBuffer) ss1
ibs) M sm mibargs
m Size
ost = do
		(_, mm) <- M sm mibargs -> IO (PL (U2 ImageBuffer) mibargs, M)
forall s (ibargs :: [(*, ImageBufferArg)]).
M s ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
readM M sm mibargs
m
		(ost', sz) <- adjustOffsetSize dv ii ost
		when debug . putStrLn $ "Gpu.Vulkan.Memory.Bind.BindAll (ImageArg): (ost', sz) = " ++ show (ost', sz)
		Image.M.bindMemory mdv i mm ost'
		(U2 (ImageBinded $ Image.Binded i) :**)
			<$> bindAll dv ibs m (ost' + sz)

instance (VObj.SizeAlignmentList objs, BindAll ibargs mibargs) =>
	BindAll ('(sb, ('BufferArg nm objs)) ': ibargs) mibargs where
	bindAll :: forall sd sm.
D sd
-> PL (U2 ImageBuffer) ('(sb, 'BufferArg nm objs) : ibargs)
-> M sm mibargs
-> Size
-> IO
     (PL
        (U2 (ImageBufferBinded sm)) ('(sb, 'BufferArg nm objs) : ibargs))
bindAll dv :: D sd
dv@(Device.D D
mdv)
		(U2 bb :: ImageBuffer s1 s2
bb@(Buffer (Buffer.B PL Length objs
lns B
b)) :** PL (U2 ImageBuffer) ss1
ibs) M sm mibargs
m Size
ost  = do
		(_, mm) <- M sm mibargs -> IO (PL (U2 ImageBuffer) mibargs, M)
forall s (ibargs :: [(*, ImageBufferArg)]).
M s ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
readM M sm mibargs
m
		(ost', sz) <- adjustOffsetSize dv bb ost
		let	ost'' = Size -> Size -> Size
adjust (forall (objs :: [O]). SizeAlignmentList objs => Size
VObj.sizeAlignmentListWholeAlignment @objs) Size
ost'
		when debug . putStrLn $ "Gpu.Vulkan.Memory.Bind.BindAll (BufferArg): " ++ show (ost', sz)
		when debug . putStrLn $ "Gpu.Vulkan.Memory.Bind.BindAll (BufferArg): ost'' = " ++ show ost''
		Buffer.M.bindMemory mdv b mm ost''
		(U2 (BufferBinded $ Buffer.Binded lns b) :**)
			<$> bindAll dv ibs m (ost'' + sz)

instance BindAll ibargs mibargs =>
	BindAll ('(sb, 'RawArg) ': ibargs) mibargs where
	bindAll :: forall sd sm.
D sd
-> PL (U2 ImageBuffer) ('(sb, 'RawArg) : ibargs)
-> M sm mibargs
-> Size
-> IO (PL (U2 (ImageBufferBinded sm)) ('(sb, 'RawArg) : ibargs))
bindAll D sd
dv (U2 bb :: ImageBuffer s1 s2
bb@(Raw Size
a Size
s) :** PL (U2 ImageBuffer) ss1
ibs) M sm mibargs
m Size
ost  = do
		(ost', sz) <- D sd -> ImageBuffer s1 s2 -> Size -> IO (Size, Size)
forall sd sib (ibarg :: ImageBufferArg).
D sd -> ImageBuffer sib ibarg -> Size -> IO (Size, Size)
adjustOffsetSize D sd
dv ImageBuffer s1 s2
bb Size
ost
		when debug . putStrLn $ "Gpu.Vulkan.Memory.Bind.BindAll (RawArg): " ++ show (ost', sz)
		(U2 (RawBinded a s) :**) <$> bindAll dv ibs m (ost' + sz)

class (RebindAll ibargs ibargs, Alignments ibargs) => Rebindable ibargs
instance (RebindAll ibargs ibargs, Alignments ibargs) => Rebindable ibargs

class RebindAll ibargs mibargs where
	rebindAll :: Device.D sd ->
		HeteroParList.PL (U2 (ImageBufferBinded sm)) ibargs ->
		M sm mibargs -> Device.M.Size -> IO ()

instance RebindAll '[] mibargs where rebindAll :: forall sd sm.
D sd
-> PL (U2 (ImageBufferBinded sm)) '[]
-> M sm mibargs
-> Size
-> IO ()
rebindAll D sd
_ PL (U2 (ImageBufferBinded sm)) '[]
_ M sm mibargs
_ Size
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance RebindAll ibargs mibargs =>
	RebindAll ('(si, 'ImageArg nm fmt) ': ibargs) mibargs where
	rebindAll :: forall sd sm.
D sd
-> PL
     (U2 (ImageBufferBinded sm)) ('(si, 'ImageArg nm fmt) : ibargs)
-> M sm mibargs
-> Size
-> IO ()
rebindAll dv :: D sd
dv@(Device.D D
mdv)
		(U2 ii :: ImageBufferBinded sm s1 s2
ii@(ImageBinded (Image.Binded I
i)) :** PL (U2 (ImageBufferBinded sm)) ss1
ibs) M sm mibargs
m Size
ost = do
		(_, mm) <- M sm mibargs -> IO (PL (U2 ImageBuffer) mibargs, M)
forall s (ibargs :: [(*, ImageBufferArg)]).
M s ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
readM M sm mibargs
m
		(ost', sz) <- adjustOffsetSizeBinded dv ii ost
		Image.M.bindMemory mdv i mm ost'
		rebindAll dv ibs m $ ost' + sz

instance RebindAll ibargs mibargs =>
	RebindAll ('(sb, 'BufferArg nm objs) ': ibargs) mibargs where
	rebindAll :: forall sd sm.
D sd
-> PL
     (U2 (ImageBufferBinded sm)) ('(sb, 'BufferArg nm objs) : ibargs)
-> M sm mibargs
-> Size
-> IO ()
rebindAll dv :: D sd
dv@(Device.D D
mdv)
		(U2 bb :: ImageBufferBinded sm s1 s2
bb@(BufferBinded (Buffer.Binded PL Length objs
_lns B
b)) :** PL (U2 (ImageBufferBinded sm)) ss1
ibs) M sm mibargs
m Size
ost = do
		(_, mm) <- M sm mibargs -> IO (PL (U2 ImageBuffer) mibargs, M)
forall s (ibargs :: [(*, ImageBufferArg)]).
M s ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
readM M sm mibargs
m
		(ost', sz) <- adjustOffsetSizeBinded dv bb ost
		Buffer.M.bindMemory mdv b mm ost'
		rebindAll dv ibs m $ ost' + sz

instance RebindAll ibargs mibargs =>
	RebindAll ('(sb, 'RawArg) ': ibargs) mibargs where
	rebindAll :: forall sd sm.
D sd
-> PL (U2 (ImageBufferBinded sm)) ('(sb, 'RawArg) : ibargs)
-> M sm mibargs
-> Size
-> IO ()
rebindAll D sd
dv (U2 ImageBufferBinded sm s1 s2
bb :** PL (U2 (ImageBufferBinded sm)) ss1
ibs) M sm mibargs
m Size
ost = do
		(ost', sz) <- D sd -> ImageBufferBinded sm s1 s2 -> Size -> IO (Size, Size)
forall sd sm sib (ibarg :: ImageBufferArg).
D sd -> ImageBufferBinded sm sib ibarg -> Size -> IO (Size, Size)
adjustOffsetSizeBinded D sd
dv ImageBufferBinded sm s1 s2
bb Size
ost
		rebindAll dv ibs m $ ost' + sz