{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE DataKinds, ConstraintKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses, AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-orphans #-}

module Gpu.Vulkan.Pipeline.VertexInputState.SizeAlignment (
	wholeSizeAlignment, offsetOf,
	module Gpu.Vulkan.Pipeline.VertexInputState.SizeAlignment.Internal, Offset ) where

import GHC.Generics
import Foreign.Storable.PeekPoke
import Data.Kind

import Gpu.Vulkan.Pipeline.VertexInputState.SizeAlignment.Internal
import Gpu.Vulkan.Pipeline.VertexInputState.SizeAlignment.TH

import Gpu.Vulkan.Pipeline.VertexInputState.Data.Type.TypeValMap
import Gpu.Vulkan.Pipeline.VertexInputState.GHC.Generics.TypeFam

concat <$> instanceSizeAlignmentListTuple `mapM` filter (/= 1) [0 .. 15]
concat <$> instanceSizeAlignmentListUntilTuple `mapM` filter (/= 1) [0 .. 15]

wholeSizeAlignment :: forall a . MapTypeVal2 Sizable (Flatten (Rep a)) => SizeAlignment
wholeSizeAlignment :: forall a. MapTypeVal2 Sizable (Flatten (Rep a)) => SizeAlignment
wholeSizeAlignment = let sas :: [SizeAlignment]
sas = forall a. MapTypeVal2 Sizable (Flatten (Rep a)) => [SizeAlignment]
sizeAlignmentListNew @a in
	([SizeAlignment] -> Offset
calcWholeSize [SizeAlignment]
sas, [SizeAlignment] -> Offset
calcWholeAlignment [SizeAlignment]
sas)

sizeAlignmentListNew :: forall a . MapTypeVal2 Sizable (Flatten (Rep a)) => [SizeAlignment]
sizeAlignmentListNew :: forall a. MapTypeVal2 Sizable (Flatten (Rep a)) => [SizeAlignment]
sizeAlignmentListNew = forall (as :: [*]). MapTypeVal2 Sizable as => [SizeAlignment]
sizeAlignmentTypeList @(Flatten (Rep a))

sizeAlignmentTypeList ::
	forall (as :: [Type]) . MapTypeVal2 Sizable as => [SizeAlignment]
sizeAlignmentTypeList :: forall (as :: [*]). MapTypeVal2 Sizable as => [SizeAlignment]
sizeAlignmentTypeList = forall (c :: * -> Constraint) (as :: [*]) b.
MapTypeVal2 c as =>
(forall a. c a => a -> b) -> [b]
mapTypeVal2 @Sizable @as (\(a
_ :: a) -> (forall a. Sizable a => Offset
sizeOf' @a, forall a. Sizable a => Offset
alignment' @a))

calcWholeAlignment :: [SizeAlignment] -> Alignment
calcWholeAlignment :: [SizeAlignment] -> Offset
calcWholeAlignment = (Offset -> Offset -> Offset) -> Offset -> [Offset] -> Offset
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Offset -> Offset -> Offset
forall a. Integral a => a -> a -> a
lcm Offset
1 ([Offset] -> Offset)
-> ([SizeAlignment] -> [Offset]) -> [SizeAlignment] -> Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SizeAlignment -> Offset
forall a b. (a, b) -> b
snd (SizeAlignment -> Offset) -> [SizeAlignment] -> [Offset]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

calcWholeSize :: [SizeAlignment] -> Size
calcWholeSize :: [SizeAlignment] -> Offset
calcWholeSize = (Offset -> SizeAlignment -> Offset)
-> Offset -> [SizeAlignment] -> Offset
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Offset -> SizeAlignment -> Offset
next Offset
0 ([SizeAlignment] -> Offset)
-> ([SizeAlignment] -> [SizeAlignment])
-> [SizeAlignment]
-> Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SizeAlignment] -> [SizeAlignment]
rotateAlignmentL

type Offset = Int

offsetOf :: forall t ts . SizeAlignmentListUntil t ts => Maybe Offset
offsetOf :: forall t ts. SizeAlignmentListUntil t ts => Maybe Offset
offsetOf = [SizeAlignment] -> Offset
calcOffset ([SizeAlignment] -> Offset)
-> Maybe [SizeAlignment] -> Maybe Offset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t a. SizeAlignmentListUntil t a => Maybe [SizeAlignment]
sizeAlignmentListUntil @t @ts

calcOffset :: [SizeAlignment] -> Offset
calcOffset :: [SizeAlignment] -> Offset
calcOffset = (Offset -> SizeAlignment -> Offset)
-> Offset -> [SizeAlignment] -> Offset
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Offset -> SizeAlignment -> Offset
next Offset
0 ([SizeAlignment] -> Offset)
-> ([SizeAlignment] -> [SizeAlignment])
-> [SizeAlignment]
-> Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SizeAlignment] -> [SizeAlignment]
shiftAlignmentL

next :: Offset -> SizeAlignment -> Offset
next :: Offset -> SizeAlignment -> Offset
next Offset
os (Offset
sz, Offset
algn) = ((Offset
os Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
sz Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
- Offset
1) Offset -> Offset -> Offset
forall a. Integral a => a -> a -> a
`div` Offset
algn Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
1) Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
* Offset
algn

shiftAlignmentL :: [SizeAlignment] -> [SizeAlignment]
shiftAlignmentL :: [SizeAlignment] -> [SizeAlignment]
shiftAlignmentL [] = [Char] -> [SizeAlignment]
forall a. HasCallStack => [Char] -> a
error [Char]
"empty size and alignment list"
shiftAlignmentL [SizeAlignment]
sas = [Offset] -> [Offset] -> [SizeAlignment]
forall a b. [a] -> [b] -> [(a, b)]
zip [Offset]
ss [Offset]
as where ([Offset]
ss, Offset
_ : [Offset]
as) = [SizeAlignment] -> ([Offset], [Offset])
forall a b. [(a, b)] -> ([a], [b])
unzip [SizeAlignment]
sas

rotateAlignmentL :: [SizeAlignment] -> [SizeAlignment]
rotateAlignmentL :: [SizeAlignment] -> [SizeAlignment]
rotateAlignmentL [] = [Char] -> [SizeAlignment]
forall a. HasCallStack => [Char] -> a
error [Char]
"empty size and alignment list"
rotateAlignmentL [SizeAlignment]
sas = [Offset] -> [Offset] -> [SizeAlignment]
forall a b. [a] -> [b] -> [(a, b)]
zip [Offset]
ss ([Offset]
as [Offset] -> [Offset] -> [Offset]
forall a. [a] -> [a] -> [a]
++ [Offset
a]) where ([Offset]
ss, Offset
a : [Offset]
as) = [SizeAlignment] -> ([Offset], [Offset])
forall a b. [(a, b)] -> ([a], [b])
unzip [SizeAlignment]
sas