{-# LANGUAGE AllowAmbiguousTypes #-}

module Engine.Vulkan.Format
  ( HasVkFormat(..)
  , genericVkFormat

  , formatSize
  ) where

import RIO
import GHC.Generics
import Geomancy

import Data.Kind (Constraint, Type)
import Geomancy.IVec3 qualified as IVec3
import Geomancy.UVec3 qualified as UVec3
import Geomancy.Vec3 qualified as Vec3
import Vulkan.Core10 qualified as Vk

class HasVkFormat a where
  getVkFormat :: [Vk.Format]

  default getVkFormat
    :: GVkFormat (Rep a)
    => [Vk.Format]
  getVkFormat = forall a. GVkFormat (Rep a) => [Format]
genericVkFormat @a

instance HasVkFormat () where
  getVkFormat :: [Format]
getVkFormat = []

instance HasVkFormat Float where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32_SFLOAT]

instance HasVkFormat Vec2 where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32G32_SFLOAT]

instance HasVkFormat Vec3 where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32G32B32A32_SFLOAT]

instance HasVkFormat Vec3.Packed where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32G32B32_SFLOAT]

instance HasVkFormat Vec4 where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32G32B32A32_SFLOAT]

instance HasVkFormat Quaternion where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32G32B32A32_SFLOAT]

instance HasVkFormat Mat4 where
  getVkFormat :: [Format]
getVkFormat =
    [ Format
Vk.FORMAT_R32G32B32A32_SFLOAT
    , Format
Vk.FORMAT_R32G32B32A32_SFLOAT
    , Format
Vk.FORMAT_R32G32B32A32_SFLOAT
    , Format
Vk.FORMAT_R32G32B32A32_SFLOAT
    ]

instance HasVkFormat Transform where
  getVkFormat :: [Format]
getVkFormat = forall a. HasVkFormat a => [Format]
getVkFormat @Mat4

instance HasVkFormat Int32 where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32_SINT]

instance HasVkFormat IVec2 where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32G32_SINT]

instance HasVkFormat IVec3 where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32G32B32_SINT]

instance HasVkFormat IVec3.Packed where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32G32B32_SINT]

instance HasVkFormat IVec4 where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32G32B32A32_SINT]

instance HasVkFormat Word32 where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32_UINT]

instance HasVkFormat UVec2 where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32G32_UINT]

instance HasVkFormat UVec3 where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32G32B32A32_UINT]

instance HasVkFormat UVec3.Packed where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32G32B32_UINT]

instance HasVkFormat UVec4 where
  getVkFormat :: [Format]
getVkFormat = [Format
Vk.FORMAT_R32G32B32A32_UINT]

instance HasVkFormat v => HasVkFormat (Point v) where
  getVkFormat :: [Format]
getVkFormat = forall a. HasVkFormat a => [Format]
getVkFormat @v

genericVkFormat
  :: forall a
  .  GVkFormat (Rep a)
  => [Vk.Format]
genericVkFormat :: forall a. GVkFormat (Rep a) => [Format]
genericVkFormat = forall (f :: * -> *) (proxy :: (* -> *) -> *).
GVkFormat f =>
proxy f -> [Format]
gVkFormat (forall {k} (t :: k). Proxy t
Proxy @(Rep a))

type GVkFormat :: (Type -> Type) -> Constraint
class GVkFormat f where
  gVkFormat :: proxy f -> [Vk.Format]

instance GVkFormat f => GVkFormat (M1 c cb f) where
  gVkFormat :: forall (proxy :: (* -> *) -> *). proxy (M1 c cb f) -> [Format]
gVkFormat proxy (M1 c cb f)
_m1 = forall (f :: * -> *) (proxy :: (* -> *) -> *).
GVkFormat f =>
proxy f -> [Format]
gVkFormat (forall {k} (t :: k). Proxy t
Proxy @f)

instance (GVkFormat l, GVkFormat r) => GVkFormat (l :*: r) where
  gVkFormat :: forall (proxy :: (* -> *) -> *). proxy (l :*: r) -> [Format]
gVkFormat proxy (l :*: r)
_lr = forall (f :: * -> *) (proxy :: (* -> *) -> *).
GVkFormat f =>
proxy f -> [Format]
gVkFormat (forall {k} (t :: k). Proxy t
Proxy @l) forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) (proxy :: (* -> *) -> *).
GVkFormat f =>
proxy f -> [Format]
gVkFormat (forall {k} (t :: k). Proxy t
Proxy @r)

instance HasVkFormat a => GVkFormat (K1 r a) where
  gVkFormat :: forall (proxy :: (* -> *) -> *). proxy (K1 r a) -> [Format]
gVkFormat proxy (K1 r a)
_k1 = forall a. HasVkFormat a => [Format]
getVkFormat @a

formatSize :: Integral a => Vk.Format -> a
formatSize :: forall a. Integral a => Format -> a
formatSize = \case
  Format
Vk.FORMAT_R32G32B32A32_SFLOAT -> a
16
  Format
Vk.FORMAT_R32G32B32_SFLOAT    -> a
12
  Format
Vk.FORMAT_R32G32_SFLOAT       -> a
8
  Format
Vk.FORMAT_R32_SFLOAT          -> a
4

  Format
Vk.FORMAT_R32G32B32A32_UINT -> a
16
  Format
Vk.FORMAT_R32G32B32_UINT    -> a
12
  Format
Vk.FORMAT_R32G32_UINT       -> a
8
  Format
Vk.FORMAT_R32_UINT          -> a
4

  Format
Vk.FORMAT_R32G32B32A32_SINT -> a
16
  Format
Vk.FORMAT_R32G32B32_SINT    -> a
12
  Format
Vk.FORMAT_R32G32_SINT       -> a
8
  Format
Vk.FORMAT_R32_SINT          -> a
4

  Format
format ->
    forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Format size unknown: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Format
format