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

module Gpu.Vulkan.AllocationCallbacks.Type (

	-- * A

	A(..), ToMiddle(..),

	-- * Functions

	Functions(..), apply

	) where

import Foreign.Ptr
import Data.Kind
import Data.TypeLevel.ParMaybe qualified as TPMaybe
import Data.TypeLevel.Tuple.Uncurry

import Gpu.Vulkan.AllocationCallbacks.Middle qualified as M

newtype A s a = A (M.A a)  deriving Int -> A s a -> ShowS
[A s a] -> ShowS
A s a -> String
(Int -> A s a -> ShowS)
-> (A s a -> String) -> ([A s a] -> ShowS) -> Show (A s a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s a. Int -> A s a -> ShowS
forall s a. [A s a] -> ShowS
forall s a. A s a -> String
$cshowsPrec :: forall s a. Int -> A s a -> ShowS
showsPrec :: Int -> A s a -> ShowS
$cshow :: forall s a. A s a -> String
show :: A s a -> String
$cshowList :: forall s a. [A s a] -> ShowS
showList :: [A s a] -> ShowS
Show

class ToMiddle msa where
	type Snd msa :: Maybe Type
	toMiddle :: TPMaybe.M (U2 A) msa -> TPMaybe.M M.A (Snd msa)

instance ToMiddle 'Nothing where
	type Snd 'Nothing = 'Nothing
	toMiddle :: M (U2 A) 'Nothing -> M A (Snd 'Nothing)
toMiddle M (U2 A) 'Nothing
TPMaybe.N = M A 'Nothing
M A (Snd 'Nothing)
forall {k} (t :: k -> *). M t 'Nothing
TPMaybe.N

instance ToMiddle ('Just '(s, a)) where
	type Snd ('Just '(s, a)) = 'Just a
	toMiddle :: M (U2 A) ('Just '(s, a)) -> M A (Snd ('Just '(s, a)))
toMiddle (TPMaybe.J (U2 (A A s2
a))) = A s2 -> M A ('Just s2)
forall {k} (t :: k -> *) (a :: k). t a -> M t ('Just a)
TPMaybe.J A s2
a

newtype Functions s a = Functions { forall s a. Functions s a -> Functions a
toMiddleFunctions :: M.Functions a }
	deriving Int -> Functions s a -> ShowS
[Functions s a] -> ShowS
Functions s a -> String
(Int -> Functions s a -> ShowS)
-> (Functions s a -> String)
-> ([Functions s a] -> ShowS)
-> Show (Functions s a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s a. Int -> Functions s a -> ShowS
forall s a. [Functions s a] -> ShowS
forall s a. Functions s a -> String
$cshowsPrec :: forall s a. Int -> Functions s a -> ShowS
showsPrec :: Int -> Functions s a -> ShowS
$cshow :: forall s a. Functions s a -> String
show :: Functions s a -> String
$cshowList :: forall s a. [Functions s a] -> ShowS
showList :: [Functions s a] -> ShowS
Show

apply :: Functions s a -> Ptr a -> A s a
Functions Functions a
f apply :: forall s a. Functions s a -> Ptr a -> A s a
`apply` Ptr a
p = A a -> A s a
forall s a. A a -> A s a
A (A a -> A s a) -> A a -> A s a
forall a b. (a -> b) -> a -> b
$ Functions a
f Functions a -> Ptr a -> A a
forall a. Functions a -> Ptr a -> A a
`M.apply` Ptr a
p