{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Gpu.Vulkan.Pipeline.VertexInputState.SizeAlignment.TH (
	instanceSizeAlignmentListTuple,
	instanceSizeAlignmentListUntilTuple ) where

import Language.Haskell.TH
import Foreign.Storable.PeekPoke
import Gpu.Vulkan.Pipeline.VertexInputState.SizeAlignment.Internal
import Data.Bool

instanceSizeAlignmentListTuple :: Int -> DecsQ
instanceSizeAlignmentListTuple :: Int -> DecsQ
instanceSizeAlignmentListTuple Int
n = Int -> Q [TypeQ]
newTypes Int
n Q [TypeQ] -> ([TypeQ] -> DecsQ) -> DecsQ
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[TypeQ]
ts -> do
	let	tpl :: TypeQ
tpl = [TypeQ] -> TypeQ
tupT [TypeQ]
ts
	(Name -> [Type] -> Q Bool
isInstance ''SizeAlignmentList ([Type] -> Q Bool) -> (Type -> [Type]) -> Type -> Q Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: []) (Type -> Q Bool) -> TypeQ -> Q Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TypeQ
tpl) Q Bool -> (Bool -> DecsQ) -> DecsQ
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecsQ -> DecsQ -> Bool -> DecsQ
forall a. a -> a -> Bool -> a
bool
		((Dec -> [Dec] -> [Dec]
forall a. a -> [a] -> [a]
: []) (Dec -> [Dec]) -> Q Dec -> DecsQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q [Type] -> TypeQ -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m [Type] -> m Type -> [m Dec] -> m Dec
instanceD
			([TypeQ] -> Q [Type]
forall (m :: * -> *). Quote m => [m Type] -> m [Type]
cxt ([TypeQ] -> Q [Type]) -> [TypeQ] -> Q [Type]
forall a b. (a -> b) -> a -> b
$ (Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT ''Sizable TypeQ -> TypeQ -> TypeQ
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT`) (TypeQ -> TypeQ) -> [TypeQ] -> [TypeQ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeQ]
ts)
			(Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT ''SizeAlignmentList TypeQ -> TypeQ -> TypeQ
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` TypeQ
tpl) [])
		([Dec] -> DecsQ
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])

tupT :: [TypeQ] -> TypeQ
tupT :: [TypeQ] -> TypeQ
tupT [TypeQ]
ts = (TypeQ -> TypeQ -> TypeQ) -> TypeQ -> [TypeQ] -> TypeQ
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl TypeQ -> TypeQ -> TypeQ
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Int -> TypeQ
forall (m :: * -> *). Quote m => Int -> m Type
tupleT (Int -> TypeQ) -> Int -> TypeQ
forall a b. (a -> b) -> a -> b
$ [TypeQ] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeQ]
ts) [TypeQ]
ts

newTypes :: Int -> Q [TypeQ]
newTypes :: Int -> Q [TypeQ]
newTypes = ((Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
varT (Name -> TypeQ) -> [Name] -> [TypeQ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Name] -> [TypeQ]) -> Q [Name] -> Q [TypeQ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Q [Name] -> Q [TypeQ]) -> (Int -> Q [Name]) -> Int -> Q [TypeQ]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Q [Name]
newNames

newNames :: Int -> Q [Name]
newNames :: Int -> Q [Name]
newNames Int
n = String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName (String -> Q Name) -> [String] -> Q [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
n ((Char -> String -> String
forall a. a -> [a] -> [a]
: String
"") (Char -> String) -> String -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char
'a' .. Char
'z'])

instanceSizeAlignmentListUntilTuple :: Int -> DecsQ
instanceSizeAlignmentListUntilTuple :: Int -> DecsQ
instanceSizeAlignmentListUntilTuple Int
n =
	String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName String
"t" Q Name -> (Name -> DecsQ) -> DecsQ
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Name
t -> Int -> Q [TypeQ]
newTypes Int
n Q [TypeQ] -> ([TypeQ] -> DecsQ) -> DecsQ
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[TypeQ]
ts -> do
		let	tpl :: TypeQ
tpl = [TypeQ] -> TypeQ
tupT [TypeQ]
ts
		(Name -> [Type] -> Q Bool
isInstance ''SizeAlignmentListUntil ([Type] -> Q Bool) -> (Type -> [Type]) -> Type -> Q Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> [Type] -> [Type]
forall a. a -> [a] -> [a]
: []) (Type -> Q Bool) -> TypeQ -> Q Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TypeQ
tpl) Q Bool -> (Bool -> DecsQ) -> DecsQ
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecsQ -> DecsQ -> Bool -> DecsQ
forall a. a -> a -> Bool -> a
bool
			((Dec -> [Dec] -> [Dec]
forall a. a -> [a] -> [a]
: []) (Dec -> [Dec]) -> Q Dec -> DecsQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q [Type] -> TypeQ -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m [Type] -> m Type -> [m Dec] -> m Dec
instanceD
				([TypeQ] -> Q [Type]
forall (m :: * -> *). Quote m => [m Type] -> m [Type]
cxt [Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT ''MapSizableUntil TypeQ -> TypeQ -> TypeQ
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
t TypeQ -> TypeQ -> TypeQ
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` TypeQ
tpl])
--					varT t `appT` promotedListT ts])
				(Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT ''SizeAlignmentListUntil TypeQ -> TypeQ -> TypeQ
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT`
					Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
t TypeQ -> TypeQ -> TypeQ
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` TypeQ
tpl) [])
			([Dec] -> DecsQ
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])