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

module Gpu.Vulkan.Memory.OffsetSize (

	-- * OFFSET SIZE

	offsetSize, OffsetSize,

	) where

import Prelude hiding (map, read)
import GHC.TypeLits
import Gpu.Vulkan.Object qualified as VObj
import Data.TypeLevel.Tuple.Uncurry
import qualified Data.HeteroParList as HeteroParList
import Data.HeteroParList (pattern (:**))

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

import Gpu.Vulkan.Memory.Type
import Gpu.Vulkan.Memory.ImageBuffer

offsetSize :: forall nm obj ibargs i sd sm . OffsetSize nm obj ibargs i =>
	Device.D sd -> M sm ibargs -> Device.M.Size ->
	IO (Device.M.Size, Device.M.Size)
offsetSize :: forall (nm :: Symbol) (obj :: O) (ibargs :: [(*, ImageBufferArg)])
       (i :: Nat) sd sm.
OffsetSize nm obj ibargs i =>
D sd -> M sm ibargs -> Size -> IO (Size, Size)
offsetSize D sd
dvc M sm ibargs
m Size
ost =
	M sm ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
forall s (ibargs :: [(*, ImageBufferArg)]).
M s ibargs -> IO (PL (U2 ImageBuffer) ibargs, M)
readM M sm ibargs
m IO (PL (U2 ImageBuffer) ibargs, M)
-> ((PL (U2 ImageBuffer) ibargs, M) -> IO (Size, Size))
-> IO (Size, Size)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(PL (U2 ImageBuffer) ibargs
ibs, M
_mm) -> forall (nm :: Symbol) (obj :: O) (ibargs :: [(*, ImageBufferArg)])
       (i :: Nat) sd.
OffsetSize nm obj ibargs i =>
D sd -> PL (U2 ImageBuffer) ibargs -> Size -> IO (Size, Size)
offsetSize' @nm @obj @ibargs @i D sd
dvc PL (U2 ImageBuffer) ibargs
ibs Size
ost

class ObjectLength nm obj ibargs =>
	OffsetSize (nm :: Symbol) (obj :: VObj.O) ibargs (i :: Nat) where
	offsetSize' ::
		Device.D sd -> HeteroParList.PL (U2 ImageBuffer) ibargs ->
		Device.M.Size -> IO (Device.M.Size, Device.M.Size)

instance (VObj.OffsetRange obj objs i, VObj.LengthOf obj objs) =>
	OffsetSize nm obj ('(sib, 'BufferArg nm objs) ': ibargs) i where
	offsetSize' :: forall sd.
D sd
-> PL (U2 ImageBuffer) ('(sib, 'BufferArg nm objs) : ibargs)
-> Size
-> IO (Size, Size)
offsetSize' D sd
dvc ((U2 ib :: ImageBuffer s1 s2
ib@(Buffer (Buffer.B PL Length objs
lns B
_))) :** PL (U2 ImageBuffer) ss1
_ibs) Size
ost =
		(((Size, Size) -> (Size, Size))
-> IO (Size, Size) -> IO (Size, Size)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
dvc ImageBuffer s1 s2
ib Size
ost) \(Size
ost', Size
_sz) ->
		forall (obj :: O) (objs :: [O]) (i :: Nat).
OffsetRange obj objs i =>
Size -> PL Length objs -> (Size, Size)
VObj.offsetSize @obj @_ @i Size
ost' PL Length objs
lns

instance {-# OVERLAPPABLE #-}
	OffsetSize nm obj ibargs i =>
	OffsetSize nm obj ('(sib, ib) ': ibargs) i where
	offsetSize' :: forall sd.
D sd
-> PL (U2 ImageBuffer) ('(sib, ib) : ibargs)
-> Size
-> IO (Size, Size)
offsetSize' D sd
dvc (U2 ImageBuffer s1 s2
ib :** PL (U2 ImageBuffer) ss1
ibs) Size
ost =
		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
dvc ImageBuffer s1 s2
ib Size
ost IO (Size, Size)
-> ((Size, Size) -> IO (Size, Size)) -> IO (Size, Size)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
		forall (nm :: Symbol) (obj :: O) (ibargs :: [(*, ImageBufferArg)])
       (i :: Nat) sd.
OffsetSize nm obj ibargs i =>
D sd -> PL (U2 ImageBuffer) ibargs -> Size -> IO (Size, Size)
offsetSize' @nm @obj @_ @i D sd
dvc PL (U2 ImageBuffer) ss1
ibs (Size -> IO (Size, Size))
-> ((Size, Size) -> Size) -> (Size, Size) -> IO (Size, Size)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Size -> Size -> Size) -> (Size, Size) -> Size
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Size -> Size -> Size
forall a. Num a => a -> a -> a
(+)